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

module Codeforces.Response
    ( ResponseError(..)
    , responseErrorMsg
    , getData
    , getAuthorizedData
    ) where

import           Codeforces.Config
import           Codeforces.Logging

import           Control.Exception              ( try )

import           Data.Aeson
import           Data.Maybe

import           Network.HTTP.Client
import           Network.HTTP.Simple

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

data CodeforcesStatus = Ok | Failed
    deriving Int -> CodeforcesStatus -> ShowS
[CodeforcesStatus] -> ShowS
CodeforcesStatus -> String
(Int -> CodeforcesStatus -> ShowS)
-> (CodeforcesStatus -> String)
-> ([CodeforcesStatus] -> ShowS)
-> Show CodeforcesStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeforcesStatus] -> ShowS
$cshowList :: [CodeforcesStatus] -> ShowS
show :: CodeforcesStatus -> String
$cshow :: CodeforcesStatus -> String
showsPrec :: Int -> CodeforcesStatus -> ShowS
$cshowsPrec :: Int -> CodeforcesStatus -> ShowS
Show

instance FromJSON CodeforcesStatus where
    parseJSON :: Value -> Parser CodeforcesStatus
parseJSON = String
-> (Text -> Parser CodeforcesStatus)
-> Value
-> Parser CodeforcesStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"CodeforcesStatus"
        ((Text -> Parser CodeforcesStatus)
 -> Value -> Parser CodeforcesStatus)
-> (Text -> Parser CodeforcesStatus)
-> Value
-> Parser CodeforcesStatus
forall a b. (a -> b) -> a -> b
$ \Text
t -> CodeforcesStatus -> Parser CodeforcesStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeforcesStatus -> Parser CodeforcesStatus)
-> CodeforcesStatus -> Parser CodeforcesStatus
forall a b. (a -> b) -> a -> b
$ if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"OK" then CodeforcesStatus
Ok else CodeforcesStatus
Failed

-- | Represents the result object or error comment returned by the API.
--
-- Each successful response from the API contains a "status" field, and either
-- a "result" or "comment" when status is "OK" or "FAILED" respectively.
--
-- These two possibilities are represented by @ResponseOk@ and @ResponseFail@.
--
data CodeforcesResponse a = ResponseFail String | ResponseOk a
    deriving Int -> CodeforcesResponse a -> ShowS
[CodeforcesResponse a] -> ShowS
CodeforcesResponse a -> String
(Int -> CodeforcesResponse a -> ShowS)
-> (CodeforcesResponse a -> String)
-> ([CodeforcesResponse a] -> ShowS)
-> Show (CodeforcesResponse a)
forall a. Show a => Int -> CodeforcesResponse a -> ShowS
forall a. Show a => [CodeforcesResponse a] -> ShowS
forall a. Show a => CodeforcesResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeforcesResponse a] -> ShowS
$cshowList :: forall a. Show a => [CodeforcesResponse a] -> ShowS
show :: CodeforcesResponse a -> String
$cshow :: forall a. Show a => CodeforcesResponse a -> String
showsPrec :: Int -> CodeforcesResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CodeforcesResponse a -> ShowS
Show

instance FromJSON a => FromJSON (CodeforcesResponse a) where
    parseJSON :: Value -> Parser (CodeforcesResponse a)
parseJSON = String
-> (Object -> Parser (CodeforcesResponse a))
-> Value
-> Parser (CodeforcesResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CodeforcesResponse" ((Object -> Parser (CodeforcesResponse a))
 -> Value -> Parser (CodeforcesResponse a))
-> (Object -> Parser (CodeforcesResponse a))
-> Value
-> Parser (CodeforcesResponse a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        CodeforcesStatus
st <- Object
o Object -> Text -> Parser CodeforcesStatus
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"status"
        case CodeforcesStatus
st of
            CodeforcesStatus
Ok     -> a -> CodeforcesResponse a
forall a. a -> CodeforcesResponse a
ResponseOk (a -> CodeforcesResponse a)
-> Parser a -> Parser (CodeforcesResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"result"
            CodeforcesStatus
Failed -> String -> CodeforcesResponse a
forall a. String -> CodeforcesResponse a
ResponseFail (String -> CodeforcesResponse a)
-> Parser String -> Parser (CodeforcesResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"comment"

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

-- | An error that could occur during the retrieval and inital parsing of data
-- from the Codeforces API.
data ResponseError
    = ApiFail String
    -- ^ Corresponds to a @ResponseFail@ from the Codeforces API with the fail
    -- comment.
    | JsonError JSONException
    -- ^ Wrapper around 'JSONException', used if the successful JSON response
    -- could not be parsed.
    | HttpError HttpException
    -- ^ Wrapper around 'HttpException', used for situations like a failed
    -- connection.
    deriving Int -> ResponseError -> ShowS
[ResponseError] -> ShowS
ResponseError -> String
(Int -> ResponseError -> ShowS)
-> (ResponseError -> String)
-> ([ResponseError] -> ShowS)
-> Show ResponseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseError] -> ShowS
$cshowList :: [ResponseError] -> ShowS
show :: ResponseError -> String
$cshow :: ResponseError -> String
showsPrec :: Int -> ResponseError -> ShowS
$cshowsPrec :: Int -> ResponseError -> ShowS
Show

-- | Converts a 'ResponseError' to a friendly error message to display, and
-- details that can be logged separately.
responseErrorMsg :: ResponseError -> ErrorLog
responseErrorMsg :: ResponseError -> ErrorLog
responseErrorMsg (ApiFail   String
e) = String -> ErrorLog
mkErrorLog String
e
responseErrorMsg (JsonError JSONException
e) = String
"Couldn't parse result" String -> String -> ErrorLog
<~> JSONException -> String
forall a. Show a => a -> String
show JSONException
e
responseErrorMsg (HttpError HttpException
e) = case HttpException
e of
    HttpExceptionRequest Request
_ HttpExceptionContent
content -> case HttpExceptionContent
content of
        StatusCodeException Response ()
resp ByteString
_ ->
            String -> ErrorLog
mkErrorLog (String -> ErrorLog) -> String -> ErrorLog
forall a b. (a -> b) -> a -> b
$ String
"HTTP " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Response () -> Int
forall a. Response a -> Int
getResponseStatusCode Response ()
resp)
        TooManyRedirects [Response ByteString]
resps -> String
"Too many redirects" String -> String -> ErrorLog
<~> [Response ByteString] -> String
forall a. Show a => a -> String
show [Response ByteString]
resps
        HttpExceptionContent
ConnectionTimeout      -> String -> ErrorLog
mkErrorLog String
"Connection timeout"
        ConnectionFailure SomeException
e2   -> String
"Connection failure" String -> String -> ErrorLog
<~> SomeException -> String
forall a. Show a => a -> String
show SomeException
e2
        HttpExceptionContent
other                  -> String
"HTTP error" String -> String -> ErrorLog
<~> HttpExceptionContent -> String
forall a. Show a => a -> String
show HttpExceptionContent
other
    InvalidUrlException String
url String
reason ->
        String
"Invalid URL" String -> String -> ErrorLog
<~> (String
url String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\nfor " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
reason)

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

-- | Converts a possible 'CodeforcesResponse' into an either type.
codeforcesDecode
    :: FromJSON a
    => Either JSONException (CodeforcesResponse a)
    -> Either ResponseError a
codeforcesDecode :: Either JSONException (CodeforcesResponse a)
-> Either ResponseError a
codeforcesDecode (Left  JSONException
e1  ) = ResponseError -> Either ResponseError a
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError a)
-> ResponseError -> Either ResponseError a
forall a b. (a -> b) -> a -> b
$ JSONException -> ResponseError
JsonError JSONException
e1
codeforcesDecode (Right CodeforcesResponse a
resp) = case CodeforcesResponse a
resp of
    (ResponseFail String
e2 ) -> ResponseError -> Either ResponseError a
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError a)
-> ResponseError -> Either ResponseError a
forall a b. (a -> b) -> a -> b
$ String -> ResponseError
ApiFail String
e2
    (ResponseOk   a
obj) -> a -> Either ResponseError a
forall a b. b -> Either a b
Right a
obj

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

-- | Host name and the API's base URL, without trailing slash.
baseUrl :: String
baseUrl :: String
baseUrl = String
"https://codeforces.com/api"

-- | 'getData' @path query@ is a general function for returning some result data
-- from the Codeforces API.
getData :: FromJSON a => String -> Query -> IO (Either ResponseError a)
getData :: String -> Query -> IO (Either ResponseError a)
getData String
path Query
query = do
    Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String
baseUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path)
    let request :: Request
request = Query -> Request -> Request
setRequestQueryString (Query -> Query
catQuery Query
query) Request
req

    Either
  HttpException
  (Response (Either JSONException (CodeforcesResponse a)))
eresponse <- IO (Response (Either JSONException (CodeforcesResponse a)))
-> IO
     (Either
        HttpException
        (Response (Either JSONException (CodeforcesResponse a))))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response (Either JSONException (CodeforcesResponse a)))
 -> IO
      (Either
         HttpException
         (Response (Either JSONException (CodeforcesResponse a)))))
-> IO (Response (Either JSONException (CodeforcesResponse a)))
-> IO
     (Either
        HttpException
        (Response (Either JSONException (CodeforcesResponse a))))
forall a b. (a -> b) -> a -> b
$ Request
-> IO (Response (Either JSONException (CodeforcesResponse a)))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either JSONException a))
httpJSONEither Request
request
    Either ResponseError a -> IO (Either ResponseError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError a -> IO (Either ResponseError a))
-> Either ResponseError a -> IO (Either ResponseError a)
forall a b. (a -> b) -> a -> b
$ case Either
  HttpException
  (Response (Either JSONException (CodeforcesResponse a)))
eresponse of
        Left  HttpException
e    -> ResponseError -> Either ResponseError a
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError a)
-> ResponseError -> Either ResponseError a
forall a b. (a -> b) -> a -> b
$ HttpException -> ResponseError
HttpError HttpException
e
        Right Response (Either JSONException (CodeforcesResponse a))
resp -> Either JSONException (CodeforcesResponse a)
-> Either ResponseError a
forall a.
FromJSON a =>
Either JSONException (CodeforcesResponse a)
-> Either ResponseError a
codeforcesDecode (Either JSONException (CodeforcesResponse a)
 -> Either ResponseError a)
-> Either JSONException (CodeforcesResponse a)
-> Either ResponseError a
forall a b. (a -> b) -> a -> b
$ Response (Either JSONException (CodeforcesResponse a))
-> Either JSONException (CodeforcesResponse a)
forall a. Response a -> a
getResponseBody Response (Either JSONException (CodeforcesResponse a))
resp

-- | 'getAuthorizedData' @config path query@ requests and returns some result
-- data that requires authorization.
getAuthorizedData
    :: FromJSON a
    => UserConfig
    -> String
    -> Query
    -> IO (Either ResponseError a)
getAuthorizedData :: UserConfig -> String -> Query -> IO (Either ResponseError a)
getAuthorizedData UserConfig
cfg String
p Query
q = UserConfig -> String -> Query -> IO Query
generateRequestParams UserConfig
cfg String
p Query
q IO Query
-> (Query -> IO (Either ResponseError a))
-> IO (Either ResponseError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Query -> IO (Either ResponseError a)
forall a.
FromJSON a =>
String -> Query -> IO (Either ResponseError a)
getData String
p

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

-- | Takes a list of 'QueryItem's and returns those that have a @Just@ parameter
-- value.
--
-- By default, @Nothing@ items in 'Query' are parsed into "&a&b" format. The
-- Codeforces API seems to be inconsistent with how it interprets requests like
-- this. Most notably, the @contest.standings@ endpoint returns an empty list of
-- ranklist rows when @Nothing@ is passed, but all ranklist rows when completely
-- omitted.
--
catQuery :: Query -> Query
catQuery :: Query -> Query
catQuery = ((ByteString, Maybe ByteString) -> Bool) -> Query -> Query
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ByteString -> Bool)
-> ((ByteString, Maybe ByteString) -> Maybe ByteString)
-> (ByteString, Maybe ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Maybe ByteString) -> Maybe ByteString
forall a b. (a, b) -> b
snd)

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