module Codeforces.Config
( UserConfig(..)
, AuthQuery(..)
, generateRequestParams
) where
import Codeforces.Types
import qualified Crypto.Hash.SHA512 as SHA512
import Data.Aeson
import qualified Data.ByteString.Base16 as Base16
import Data.ByteString.Char8 ( ByteString )
import qualified Data.ByteString.Char8 as BC
import Data.Text ( Text )
import qualified Data.Text.Encoding as T
import Data.Time.Clock.POSIX
import Network.HTTP.Simple
import Network.HTTP.Types ( renderQuery )
import System.Random
data UserConfig = UserConfig
{ UserConfig -> Handle
cfgHandle :: Handle
, UserConfig -> Text
cfgKey :: Text
, UserConfig -> Text
cfgSecret :: Text
}
deriving Int -> UserConfig -> ShowS
[UserConfig] -> ShowS
UserConfig -> String
(Int -> UserConfig -> ShowS)
-> (UserConfig -> String)
-> ([UserConfig] -> ShowS)
-> Show UserConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserConfig] -> ShowS
$cshowList :: [UserConfig] -> ShowS
show :: UserConfig -> String
$cshow :: UserConfig -> String
showsPrec :: Int -> UserConfig -> ShowS
$cshowsPrec :: Int -> UserConfig -> ShowS
Show
instance FromJSON UserConfig where
parseJSON :: Value -> Parser UserConfig
parseJSON = String
-> (Object -> Parser UserConfig) -> Value -> Parser UserConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Config" ((Object -> Parser UserConfig) -> Value -> Parser UserConfig)
-> (Object -> Parser UserConfig) -> Value -> Parser UserConfig
forall a b. (a -> b) -> a -> b
$ \Object
v ->
Handle -> Text -> Text -> UserConfig
UserConfig (Handle -> Text -> Text -> UserConfig)
-> Parser Handle -> Parser (Text -> Text -> UserConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Handle
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"handle") Parser (Text -> Text -> UserConfig)
-> Parser Text -> Parser (Text -> UserConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"key") Parser (Text -> UserConfig) -> Parser Text -> Parser UserConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"secret")
instance ToJSON UserConfig where
toJSON :: UserConfig -> Value
toJSON UserConfig {Text
Handle
cfgSecret :: Text
cfgKey :: Text
cfgHandle :: Handle
cfgSecret :: UserConfig -> Text
cfgKey :: UserConfig -> Text
cfgHandle :: UserConfig -> Handle
..} =
[Pair] -> Value
object [Text
"handle" Text -> Handle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Handle
cfgHandle, Text
"key" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
cfgKey, Text
"secret" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
cfgSecret]
data AuthQuery = AuthQuery
{ AuthQuery -> Query
aqOriginalQuery :: Query
, AuthQuery -> String
aqMethodName :: String
, AuthQuery -> Text
aqKey :: Text
, AuthQuery -> Text
aqSecret :: Text
, AuthQuery -> POSIXTime
aqTime :: POSIXTime
, AuthQuery -> Int
aqRand :: Int
}
generateRequestParams :: UserConfig -> String -> Query -> IO Query
generateRequestParams :: UserConfig -> String -> Query -> IO Query
generateRequestParams UserConfig {Text
Handle
cfgSecret :: Text
cfgKey :: Text
cfgHandle :: Handle
cfgSecret :: UserConfig -> Text
cfgKey :: UserConfig -> Text
cfgHandle :: UserConfig -> Handle
..} String
path Query
query = do
(Int
rand :: Int) <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
100000, Int
999999)
POSIXTime
time <- IO POSIXTime
getPOSIXTime
let authQuery :: AuthQuery
authQuery = AuthQuery :: Query -> String -> Text -> Text -> POSIXTime -> Int -> AuthQuery
AuthQuery { aqOriginalQuery :: Query
aqOriginalQuery = Query
query
, aqMethodName :: String
aqMethodName = String
path
, aqKey :: Text
aqKey = Text
cfgKey
, aqSecret :: Text
aqSecret = Text
cfgSecret
, aqTime :: POSIXTime
aqTime = POSIXTime
time
, aqRand :: Int
aqRand = Int
rand
}
let apiSig :: ByteString
apiSig = (String -> ByteString
BC.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Int
rand ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> AuthQuery -> ByteString
generateHash AuthQuery
authQuery
Query -> IO Query
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Query -> IO Query) -> Query -> IO Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[Query
query, Text -> POSIXTime -> Query
keyAndTimeParams Text
cfgKey POSIXTime
time, [(ByteString
"apiSig", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
apiSig)]]
generateHash :: AuthQuery -> ByteString
generateHash :: AuthQuery -> ByteString
generateHash AuthQuery {Int
String
Query
Text
POSIXTime
aqRand :: Int
aqTime :: POSIXTime
aqSecret :: Text
aqKey :: Text
aqMethodName :: String
aqOriginalQuery :: Query
aqRand :: AuthQuery -> Int
aqTime :: AuthQuery -> POSIXTime
aqSecret :: AuthQuery -> Text
aqKey :: AuthQuery -> Text
aqMethodName :: AuthQuery -> String
aqOriginalQuery :: AuthQuery -> Query
..} = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
SHA512.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat
[ String -> ByteString
BC.pack (Int -> String
forall a. Show a => a -> String
show Int
aqRand)
, String -> ByteString
BC.pack String
aqMethodName
, Bool -> Query -> ByteString
renderQuery Bool
True (Query -> ByteString) -> Query -> ByteString
forall a b. (a -> b) -> a -> b
$ Query
aqOriginalQuery Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ Text -> POSIXTime -> Query
keyAndTimeParams Text
aqKey POSIXTime
aqTime
, ByteString
"#"
, Text -> ByteString
T.encodeUtf8 Text
aqSecret
]
keyAndTimeParams :: Text -> POSIXTime -> Query
keyAndTimeParams :: Text -> POSIXTime -> Query
keyAndTimeParams Text
key POSIXTime
time =
(ByteString -> Maybe ByteString)
-> (ByteString, ByteString) -> (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
((ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> [(ByteString, ByteString)] -> Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString
"apiKey", Text -> ByteString
T.encodeUtf8 Text
key), (ByteString
"time", POSIXTime -> ByteString
posixToByteString POSIXTime
time)]
posixToByteString :: POSIXTime -> ByteString
posixToByteString :: POSIXTime -> ByteString
posixToByteString = String -> ByteString
BC.pack (String -> ByteString)
-> (POSIXTime -> String) -> POSIXTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String
forall a. Show a => a -> String
show :: Int -> String) (Int -> String) -> (POSIXTime -> Int) -> POSIXTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round