{-| Contains all the functionality of the app.
TODO: Should split out into BnbStaking sub-modules: Main, Binance, Csv
-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ViewPatterns #-}
module Lib
( run
-- * CSV Data
, ExportData(..)
, convertReward
, MyZonedTime(..)
-- * Binance.org API
, getAllRewards
, makeRequest
, Endpoint(..)
, RewardResponse(..)
, Reward(..)
) where
import Control.Monad ( forM )
import Data.Aeson ( (.:)
, FromJSON(..)
, withObject
)
import Data.Csv ( DefaultOrdered
, ToField(..)
, ToNamedRecord
, encodeDefaultOrderedByName
)
import Data.List ( sortOn )
import Data.Maybe ( fromMaybe )
import Data.Scientific ( FPFormat(..)
, Scientific
, formatScientific
)
import Data.Time ( UTCTime
, ZonedTime(..)
, defaultTimeLocale
, formatTime
, parseTimeM
, utcToLocalZonedTime
)
import GHC.Generics ( Generic )
import Network.HTTP.Req ( (/:)
, (=:)
, GET(..)
, MonadHttp
, NoReqBody(..)
, Scheme(Https)
, Url
, defaultHttpConfig
, https
, jsonResponse
, req
, responseBody
, runReq
)
import System.Environment ( getArgs )
import System.IO ( hPutStrLn
, stderr
)
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Text as T
-- | Run the executable - parsing args, making queries, & printing the
-- results.
run :: IO ()
run = getArgs >>= \case
[pubKey] ->
runReq defaultHttpConfig (getAllRewards $ T.pack pubKey)
>>= mapM convertReward
>>= LBS.putStr
. encodeDefaultOrderedByName
_ -> hPutStrLn
stderr
"bnb-staking-csvs: expected 1 argument - <DELEGATOR_PUBKEY>"
-- CSV Data
-- | Datatype representing a single row in the CSV export.
data ExportData = ExportData
{ time :: MyZonedTime
-- ^ The time of the reward.
, amount :: T.Text
-- ^ The reward amount.
, currency :: T.Text
-- ^ Always @BNB@, but sometimes a useful column for CSV imports.
, delegator :: T.Text
-- ^ The address that was rewarded.
, validator :: T.Text
-- ^ The validator's name.
, validatorAddress :: T.Text
-- ^ The address the delegator is validating to.
, height :: Integer
-- ^ The height of the reward's block.
}
deriving (Show, Read, Generic)
instance ToNamedRecord ExportData
instance DefaultOrdered ExportData
-- | Render a 'Reward' into our target export data by converting to
-- localtime(respecting DST), & formatting the amount column to 8 decimal
-- places.
convertReward :: Reward -> IO ExportData
convertReward Reward {..} = do
localRewardTime <- utcToLocalZonedTime rRewardTime
return $ ExportData
{ time = MyZonedTime localRewardTime
, amount = T.pack $ formatScientific Fixed (Just 8) rReward
, currency = "BNB"
, delegator = rDelegator
, validator = rValidatorName
, validatorAddress = rValidatorAddress
, height = rHeight
}
-- | Wrapper type to support custom 'ToField' instance.
newtype MyZonedTime = MyZonedTime { fromMyZonedTime :: ZonedTime } deriving (Show, Read)
instance ToField MyZonedTime where
toField (MyZonedTime zt) =
toField $ formatTime defaultTimeLocale "%FT%T%Q%Ez" zt
-- Binance.org API
-- | Fetch all rewards for the given Delegator PubKey.
getAllRewards :: MonadHttp m => T.Text -> m [Reward]
getAllRewards pubKey = do
let pageSize = 50
jPageSize = Just pageSize
initialResp <- makeRequest $ GetRewards pubKey jPageSize Nothing
let rewardCount = rrTotal initialResp
remainingRewards <- if rewardCount < pageSize
then return []
else
fmap concat
. forM [pageSize, pageSize * 2 .. rewardCount]
$ \(Just -> offset) ->
rrRewards <$> makeRequest (GetRewards pubKey jPageSize offset)
return . sortResults $ rrRewards initialResp <> remainingRewards
where
sortResults :: [Reward] -> [Reward]
sortResults = sortOn 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 e = case e of
GetRewards _ mbLimit mbOffset -> responseBody <$> req
GET
url
NoReqBody
jsonResponse
(("limit" =: fromMaybe 20 mbLimit) <> ("offset" =: fromMaybe 0 mbOffset)
)
where
url :: Url 'Https
url = case e of
GetRewards pubKey _ _ ->
baseUrl
/: "staking"
/: "chains"
/: "bsc"
/: "delegators"
/: pubKey
/: "rewards"
baseUrl :: Url 'Https
baseUrl = https "api.binance.org" /: "v1"
-- | Response of requesting a delegator's rewards.
data RewardResponse = RewardResponse
{ rrTotal :: Integer
-- ^ Total number of rewards.
, rrRewards :: [Reward]
-- ^ Rewards in this page.
}
deriving (Show, Read, Eq, Generic)
instance FromJSON RewardResponse where
parseJSON = withObject "RewardResponse" $ \o -> do
rrTotal <- o .: "total"
rrRewards <- o .: "rewardDetails"
return $ RewardResponse { .. }
-- | A single staking reward.
data Reward = Reward
{ rValidatorName :: T.Text
, rValidatorAddress :: T.Text
, rDelegator :: T.Text
, rChainId :: T.Text
-- ^ Always @bsc@ at the moment - no testnet rewards supported.
, rHeight :: Integer
, rReward :: Scientific
, rRewardTime :: UTCTime
}
deriving (Show, Read, Eq, Generic)
instance FromJSON Reward where
parseJSON = withObject "Reward" $ \o -> do
rValidatorName <- o .: "valName"
rValidatorAddress <- o .: "validator"
rDelegator <- o .: "delegator"
rChainId <- o .: "chainId"
rHeight <- o .: "height"
rReward <- o .: "reward"
rRewardTime <- o .: "rewardTime" >>= parseTimeM True
defaultTimeLocale
"%FT%T%Q%Ez"
return $ Reward { .. }