{-# 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 Data.Text qualified as T


-- | Fetch all rewards for the given Delegator PubKey.
getAllRewards :: (MonadHttp m) => T.Text -> m [Reward]
getAllRewards :: forall (m :: * -> *). MonadHttp m => 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else ([[Reward]] -> [Reward]) -> m [[Reward]] -> m [Reward]
forall a b. (a -> b) -> m a -> m b
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 a. a -> m a
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 :: forall (m :: * -> *) a. MonadHttp m => Endpoint a -> m a
makeRequest Endpoint a
e = case Endpoint a
e of
    GetRewards Text
_ Maybe Integer
mbLimit Maybe Integer
mbOffset ->
        JsonResponse RewardResponse -> a
JsonResponse RewardResponse
-> HttpResponseBody (JsonResponse RewardResponse)
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
$cshowsPrec :: Int -> RewardResponse -> ShowS
showsPrec :: Int -> RewardResponse -> ShowS
$cshow :: RewardResponse -> String
show :: RewardResponse -> String
$cshowList :: [RewardResponse] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS RewardResponse
readsPrec :: Int -> ReadS RewardResponse
$creadList :: ReadS [RewardResponse]
readList :: ReadS [RewardResponse]
$creadPrec :: ReadPrec RewardResponse
readPrec :: ReadPrec RewardResponse
$creadListPrec :: ReadPrec [RewardResponse]
readListPrec :: ReadPrec [RewardResponse]
Read, RewardResponse -> RewardResponse -> Bool
(RewardResponse -> RewardResponse -> Bool)
-> (RewardResponse -> RewardResponse -> Bool) -> Eq RewardResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RewardResponse -> RewardResponse -> Bool
== :: RewardResponse -> RewardResponse -> Bool
$c/= :: RewardResponse -> RewardResponse -> Bool
/= :: 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
$cfrom :: forall x. RewardResponse -> Rep RewardResponse x
from :: forall x. RewardResponse -> Rep RewardResponse x
$cto :: forall x. Rep RewardResponse x -> RewardResponse
to :: forall x. Rep RewardResponse x -> RewardResponse
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 -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
        [Reward]
rrRewards <- Object
o Object -> Key -> Parser [Reward]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rewardDetails"
        RewardResponse -> Parser RewardResponse
forall a. a -> Parser a
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]
rrTotal :: Integer
rrRewards :: [Reward]
rrTotal :: Integer
rrRewards :: [Reward]
..}


-- | 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
$cshowsPrec :: Int -> Reward -> ShowS
showsPrec :: Int -> Reward -> ShowS
$cshow :: Reward -> String
show :: Reward -> String
$cshowList :: [Reward] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Reward
readsPrec :: Int -> ReadS Reward
$creadList :: ReadS [Reward]
readList :: ReadS [Reward]
$creadPrec :: ReadPrec Reward
readPrec :: ReadPrec Reward
$creadListPrec :: ReadPrec [Reward]
readListPrec :: ReadPrec [Reward]
Read, Reward -> Reward -> Bool
(Reward -> Reward -> Bool)
-> (Reward -> Reward -> Bool) -> Eq Reward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reward -> Reward -> Bool
== :: Reward -> Reward -> Bool
$c/= :: Reward -> Reward -> Bool
/= :: 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
$cfrom :: forall x. Reward -> Rep Reward x
from :: forall x. Reward -> Rep Reward x
$cto :: forall x. Rep Reward x -> Reward
to :: forall x. Rep Reward x -> Reward
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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"valName"
        Text
rValidatorAddress <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"validator"
        Text
rDelegator <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delegator"
        Text
rChainId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chainId"
        Integer
rHeight <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
        Scientific
rReward <- Object
o Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reward"
        UTCTime
rRewardTime <-
            Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rewardTime"
                Parser String -> (String -> Parser UTCTime) -> Parser UTCTime
forall a b. Parser a -> (a -> Parser b) -> Parser b
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reward -> Parser Reward) -> Reward -> Parser Reward
forall a b. (a -> b) -> a -> b
$ Reward {Integer
Text
Scientific
UTCTime
rRewardTime :: UTCTime
rValidatorName :: Text
rValidatorAddress :: Text
rDelegator :: Text
rChainId :: Text
rHeight :: Integer
rReward :: Scientific
rValidatorName :: Text
rValidatorAddress :: Text
rDelegator :: Text
rChainId :: Text
rHeight :: Integer
rReward :: Scientific
rRewardTime :: UTCTime
..}