--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------

-- | Represents the user's configuration settings.
--
-- The API key must first be generated on
-- <https://codeforces.com/settings/api the Codeforces API page>.
-- An API key consists of two parameters: @key@ and @secret@.
--
-- To use the API key in a request, some parameters need to be generated from
-- this configuration.
--
data UserConfig = UserConfig
    { UserConfig -> Handle
cfgHandle :: Handle   -- ^ Codeforces handle of the user
    , UserConfig -> Text
cfgKey    :: Text     -- ^ First part of the API key
    , UserConfig -> Text
cfgSecret :: Text     -- ^ Second part of the API key
    }
    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]

--------------------------------------------------------------------------------

-- | Contains the data needed to make an authorized GET request.
-- See 'generateRequestParams'.
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' @config path query@ returns a query string with
-- extra query items that are generated to allow for authorized access.
--
-- The parameters are of the form:
-- @
-- ?paramI=valueI&apiKey=<key>&time=<time>&apiSig=<rand><hash>
-- @
--
-- Where
--
-- * @<rand>@ is a random 6-digit integer
-- * @<time>@ is current time since epoch in seconds
-- * @<hash>@ is the SHA-512 hashcode of the UTF-8 encoded string:
--
-- @
-- <rand>/<methodName>?paramI=valueI&apiKey=<key>&time=<time>#<secret>
-- @
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
    ]

-- | A 'Query' consisting the correctly formatted @apiKey@ and POSIX @time@.
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

--------------------------------------------------------------------------------