{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{- | Binance.org API requests & responses.

-}
module Console.BnbStaking.Api
    ( -- * Rewards
      getAllRewards
    , Reward(..)
      -- * Low-Level Requests & Responses
    , Endpoint(..)
    , makeRequest
    , RewardResponse(..)
    ) where

import           Control.Monad                  ( forM )
import           Data.Aeson                     ( (.:)
                                                , FromJSON(..)
                                                , withObject
                                                )
import           Data.List                      ( sortOn )
import           Data.Maybe                     ( fromMaybe )
import           Data.Scientific                ( Scientific )
import           Data.Time                      ( UTCTime
                                                , defaultTimeLocale
                                                , parseTimeM
                                                )
import           GHC.Generics                   ( Generic )
import           Network.HTTP.Req               ( (/:)
                                                , (=:)
                                                , GET(..)
                                                , MonadHttp
                                                , NoReqBody(..)
                                                , Scheme(Https)
                                                , Url
                                                , https
                                                , jsonResponse
                                                , req
                                                , responseBody
                                                )

import qualified Data.Text                     as T


-- | Fetch all rewards for the given Delegator PubKey.
getAllRewards :: MonadHttp m => T.Text -> m [Reward]
getAllRewards :: Text -> m [Reward]
getAllRewards Text
pubKey = do
    let pageSize :: Integer
pageSize  = Integer
50
        jPageSize :: Maybe Integer
jPageSize = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
pageSize
    RewardResponse
initialResp <- Endpoint RewardResponse -> m RewardResponse
forall (m :: * -> *) a. MonadHttp m => Endpoint a -> m a
makeRequest (Endpoint RewardResponse -> m RewardResponse)
-> Endpoint RewardResponse -> m RewardResponse
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Integer -> Maybe Integer -> Endpoint RewardResponse
GetRewards Text
pubKey Maybe Integer
jPageSize Maybe Integer
forall a. Maybe a
Nothing
    let rewardCount :: Integer
rewardCount = RewardResponse -> Integer
rrTotal RewardResponse
initialResp
    [Reward]
remainingRewards <- if Integer
rewardCount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
pageSize
        then [Reward] -> m [Reward]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else
            ([[Reward]] -> [Reward]) -> m [[Reward]] -> m [Reward]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Reward]] -> [Reward]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            (m [[Reward]] -> m [Reward])
-> ((Integer -> m [Reward]) -> m [[Reward]])
-> (Integer -> m [Reward])
-> m [Reward]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> (Integer -> m [Reward]) -> m [[Reward]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Integer
pageSize, Integer
pageSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 .. Integer
rewardCount]
            ((Integer -> m [Reward]) -> m [Reward])
-> (Integer -> m [Reward]) -> m [Reward]
forall a b. (a -> b) -> a -> b
$ \(Integer -> Maybe Integer
forall a. a -> Maybe a
Just -> Maybe Integer
offset) ->
                  RewardResponse -> [Reward]
rrRewards (RewardResponse -> [Reward]) -> m RewardResponse -> m [Reward]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint RewardResponse -> m RewardResponse
forall (m :: * -> *) a. MonadHttp m => Endpoint a -> m a
makeRequest (Text -> Maybe Integer -> Maybe Integer -> Endpoint RewardResponse
GetRewards Text
pubKey Maybe Integer
jPageSize Maybe Integer
offset)
    [Reward] -> m [Reward]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Reward] -> m [Reward])
-> ([Reward] -> [Reward]) -> [Reward] -> m [Reward]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reward] -> [Reward]
sortResults ([Reward] -> m [Reward]) -> [Reward] -> m [Reward]
forall a b. (a -> b) -> a -> b
$ RewardResponse -> [Reward]
rrRewards RewardResponse
initialResp [Reward] -> [Reward] -> [Reward]
forall a. Semigroup a => a -> a -> a
<> [Reward]
remainingRewards
  where
    sortResults :: [Reward] -> [Reward]
    sortResults :: [Reward] -> [Reward]
sortResults = (Reward -> UTCTime) -> [Reward] -> [Reward]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Reward -> UTCTime
rRewardTime


-- | Represents all endpoints of the binance.org api, as well as their
-- respective response data.
data Endpoint a where
    GetRewards ::T.Text -> Maybe Integer -> Maybe Integer -> Endpoint RewardResponse

-- | Make a request to an endpoint.
makeRequest :: MonadHttp m => Endpoint a -> m a
makeRequest :: Endpoint a -> m a
makeRequest Endpoint a
e = case Endpoint a
e of
    GetRewards Text
_ Maybe Integer
mbLimit Maybe Integer
mbOffset -> JsonResponse RewardResponse -> a
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody (JsonResponse RewardResponse -> a)
-> m (JsonResponse RewardResponse) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse RewardResponse)
-> Option 'Https
-> m (JsonResponse RewardResponse)
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
        GET
GET
        Url 'Https
url
        NoReqBody
NoReqBody
        Proxy (JsonResponse RewardResponse)
forall a. Proxy (JsonResponse a)
jsonResponse
        ((Text
"limit" Text -> Integer -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
20 Maybe Integer
mbLimit) Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> (Text
"offset" Text -> Integer -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 Maybe Integer
mbOffset)
        )
  where
    url :: Url 'Https
    url :: Url 'Https
url = case Endpoint a
e of
        GetRewards Text
pubKey Maybe Integer
_ Maybe Integer
_ ->
            Url 'Https
baseUrl
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"staking"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"chains"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"bsc"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"delegators"
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
pubKey
                Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"rewards"
    baseUrl :: Url 'Https
    baseUrl :: Url 'Https
baseUrl = Text -> Url 'Https
https Text
"api.binance.org" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1"


-- | Response of requesting a delegator's rewards.
data RewardResponse = RewardResponse
    { RewardResponse -> Integer
rrTotal   :: Integer
    -- ^ Total number of rewards.
    , RewardResponse -> [Reward]
rrRewards :: [Reward]
    -- ^ Rewards in this page.
    }
    deriving (Int -> RewardResponse -> ShowS
[RewardResponse] -> ShowS
RewardResponse -> String
(Int -> RewardResponse -> ShowS)
-> (RewardResponse -> String)
-> ([RewardResponse] -> ShowS)
-> Show RewardResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardResponse] -> ShowS
$cshowList :: [RewardResponse] -> ShowS
show :: RewardResponse -> String
$cshow :: RewardResponse -> String
showsPrec :: Int -> RewardResponse -> ShowS
$cshowsPrec :: Int -> RewardResponse -> ShowS
Show, ReadPrec [RewardResponse]
ReadPrec RewardResponse
Int -> ReadS RewardResponse
ReadS [RewardResponse]
(Int -> ReadS RewardResponse)
-> ReadS [RewardResponse]
-> ReadPrec RewardResponse
-> ReadPrec [RewardResponse]
-> Read RewardResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RewardResponse]
$creadListPrec :: ReadPrec [RewardResponse]
readPrec :: ReadPrec RewardResponse
$creadPrec :: ReadPrec RewardResponse
readList :: ReadS [RewardResponse]
$creadList :: ReadS [RewardResponse]
readsPrec :: Int -> ReadS RewardResponse
$creadsPrec :: Int -> ReadS RewardResponse
Read, RewardResponse -> RewardResponse -> Bool
(RewardResponse -> RewardResponse -> Bool)
-> (RewardResponse -> RewardResponse -> Bool) -> Eq RewardResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardResponse -> RewardResponse -> Bool
$c/= :: RewardResponse -> RewardResponse -> Bool
== :: RewardResponse -> RewardResponse -> Bool
$c== :: RewardResponse -> RewardResponse -> Bool
Eq, (forall x. RewardResponse -> Rep RewardResponse x)
-> (forall x. Rep RewardResponse x -> RewardResponse)
-> Generic RewardResponse
forall x. Rep RewardResponse x -> RewardResponse
forall x. RewardResponse -> Rep RewardResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardResponse x -> RewardResponse
$cfrom :: forall x. RewardResponse -> Rep RewardResponse x
Generic)

instance FromJSON RewardResponse where
    parseJSON :: Value -> Parser RewardResponse
parseJSON = String
-> (Object -> Parser RewardResponse)
-> Value
-> Parser RewardResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RewardResponse" ((Object -> Parser RewardResponse)
 -> Value -> Parser RewardResponse)
-> (Object -> Parser RewardResponse)
-> Value
-> Parser RewardResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
rrTotal   <- Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total"
        [Reward]
rrRewards <- Object
o Object -> Text -> Parser [Reward]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rewardDetails"
        RewardResponse -> Parser RewardResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (RewardResponse -> Parser RewardResponse)
-> RewardResponse -> Parser RewardResponse
forall a b. (a -> b) -> a -> b
$ RewardResponse :: Integer -> [Reward] -> RewardResponse
RewardResponse { Integer
[Reward]
rrRewards :: [Reward]
rrTotal :: Integer
rrRewards :: [Reward]
rrTotal :: Integer
.. }


-- | A single staking reward.
data Reward = Reward
    { Reward -> Text
rValidatorName    :: T.Text
    , Reward -> Text
rValidatorAddress :: T.Text
    , Reward -> Text
rDelegator        :: T.Text
    , Reward -> Text
rChainId          :: T.Text
    -- ^ Always @bsc@ at the moment - no testnet rewards supported.
    , Reward -> Integer
rHeight           :: Integer
    , Reward -> Scientific
rReward           :: Scientific
    , Reward -> UTCTime
rRewardTime       :: UTCTime
    }
    deriving (Int -> Reward -> ShowS
[Reward] -> ShowS
Reward -> String
(Int -> Reward -> ShowS)
-> (Reward -> String) -> ([Reward] -> ShowS) -> Show Reward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reward] -> ShowS
$cshowList :: [Reward] -> ShowS
show :: Reward -> String
$cshow :: Reward -> String
showsPrec :: Int -> Reward -> ShowS
$cshowsPrec :: Int -> Reward -> ShowS
Show, ReadPrec [Reward]
ReadPrec Reward
Int -> ReadS Reward
ReadS [Reward]
(Int -> ReadS Reward)
-> ReadS [Reward]
-> ReadPrec Reward
-> ReadPrec [Reward]
-> Read Reward
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reward]
$creadListPrec :: ReadPrec [Reward]
readPrec :: ReadPrec Reward
$creadPrec :: ReadPrec Reward
readList :: ReadS [Reward]
$creadList :: ReadS [Reward]
readsPrec :: Int -> ReadS Reward
$creadsPrec :: Int -> ReadS Reward
Read, Reward -> Reward -> Bool
(Reward -> Reward -> Bool)
-> (Reward -> Reward -> Bool) -> Eq Reward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reward -> Reward -> Bool
$c/= :: Reward -> Reward -> Bool
== :: Reward -> Reward -> Bool
$c== :: Reward -> Reward -> Bool
Eq, (forall x. Reward -> Rep Reward x)
-> (forall x. Rep Reward x -> Reward) -> Generic Reward
forall x. Rep Reward x -> Reward
forall x. Reward -> Rep Reward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Reward x -> Reward
$cfrom :: forall x. Reward -> Rep Reward x
Generic)

instance FromJSON Reward where
    parseJSON :: Value -> Parser Reward
parseJSON = String -> (Object -> Parser Reward) -> Value -> Parser Reward
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Reward" ((Object -> Parser Reward) -> Value -> Parser Reward)
-> (Object -> Parser Reward) -> Value -> Parser Reward
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
rValidatorName    <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"valName"
        Text
rValidatorAddress <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"validator"
        Text
rDelegator        <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"delegator"
        Text
rChainId          <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"chainId"
        Integer
rHeight           <- Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"height"
        Scientific
rReward           <- Object
o Object -> Text -> Parser Scientific
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reward"
        UTCTime
rRewardTime       <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rewardTime" Parser String -> (String -> Parser UTCTime) -> Parser UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> TimeLocale -> String -> String -> Parser UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True
                                                              TimeLocale
defaultTimeLocale
                                                              String
"%FT%T%Q%Ez"
        Reward -> Parser Reward
forall (m :: * -> *) a. Monad m => a -> m a
return (Reward -> Parser Reward) -> Reward -> Parser Reward
forall a b. (a -> b) -> a -> b
$ Reward :: Text
-> Text
-> Text
-> Text
-> Integer
-> Scientific
-> UTCTime
-> Reward
Reward { Integer
Scientific
Text
UTCTime
rRewardTime :: UTCTime
rReward :: Scientific
rHeight :: Integer
rChainId :: Text
rDelegator :: Text
rValidatorAddress :: Text
rValidatorName :: Text
rReward :: Scientific
rHeight :: Integer
rChainId :: Text
rDelegator :: Text
rValidatorAddress :: Text
rValidatorName :: Text
rRewardTime :: UTCTime
.. }