bnb-staking-csvs 0.2.1.0 → 0.2.2.0
raw patch · 9 files changed
+309/−229 lines, 9 filesdep +containersdep ~textsetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: containers
Dependency ranges changed: text
API changes (from Hackage documentation)
+ Console.BnbStaking.Main: [argAggregate] :: Args -> Bool
- Console.BnbStaking.Main: Args :: String -> Maybe String -> Bool -> Maybe Integer -> Args
+ Console.BnbStaking.Main: Args :: String -> Maybe String -> Bool -> Maybe Integer -> Bool -> Args
Files
- CHANGELOG.md +7/−0
- Setup.hs +2/−0
- app/Main.hs +5/−3
- bnb-staking-csvs.cabal +8/−4
- src/Console/BnbStaking/Api.hs +78/−67
- src/Console/BnbStaking/CoinTracking.hs +40/−35
- src/Console/BnbStaking/Csv.hs +46/−37
- src/Console/BnbStaking/Main.hs +113/−74
- tests/Spec.hs +10/−9
CHANGELOG.md view
@@ -3,6 +3,13 @@ ## master ++## v0.2.2.0++* Add `--aggregate` flag for grouping all rewards by day.+* Bump dependency versions(text).++ ## v0.2.1.0 * Add `--year` flag for filtering output.
Setup.hs view
@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain
app/Main.hs view
@@ -1,8 +1,10 @@ module Main where -import Console.BnbStaking.Main ( getArgs- , run- )+import Console.BnbStaking.Main+ ( getArgs+ , run+ )+ main :: IO () main = getArgs >>= run
bnb-staking-csvs.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: bnb-staking-csvs-version: 0.2.1.0+version: 0.2.2.0 synopsis: Generate CSV Exports of Your BNB Staking Rewards. description: @bnb-staking-csvs@ is a CLI program that queries the Binance.org API for all of a delegator's rewards and exports the resulting data to a CSV file.@@ -24,7 +24,7 @@ bug-reports: https://github.com/prikhi/bnb-staking-csvs/issues author: Pavan Rikhi maintainer: pavan.rikhi@gmail.com-copyright: 2021 Pavan Rikhi+copyright: 2021-2024 Pavan Rikhi license: BSD3 license-file: LICENSE build-type: Simple@@ -48,6 +48,7 @@ src default-extensions: DeriveGeneric+ ImportQualifiedPost LambdaCase NamedFieldPuns OverloadedStrings@@ -63,9 +64,10 @@ , cassava <1 , cmdargs >=0.10 && <1 , cointracking-imports <1+ , containers <1 , req ==3.* , scientific <1- , text ==1.*+ , text >=1 && <3 , time ==1.* default-language: Haskell2010 @@ -77,6 +79,7 @@ app default-extensions: DeriveGeneric+ ImportQualifiedPost LambdaCase NamedFieldPuns OverloadedStrings@@ -99,6 +102,7 @@ tests default-extensions: DeriveGeneric+ ImportQualifiedPost LambdaCase NamedFieldPuns OverloadedStrings
src/Console/BnbStaking/Api.hs view
@@ -1,62 +1,65 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-}-{- | Binance.org API requests & responses. --}+-- | Binance.org API requests & responses. module Console.BnbStaking.Api ( -- * Rewards getAllRewards- , Reward(..)+ , Reward (..)+ -- * Low-Level Requests & Responses- , Endpoint(..)+ , Endpoint (..) , makeRequest- , RewardResponse(..)+ , 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 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+import Data.Text qualified as T -- | Fetch all rewards for the given Delegator PubKey.-getAllRewards :: MonadHttp m => T.Text -> m [Reward]+getAllRewards :: (MonadHttp m) => T.Text -> m [Reward] getAllRewards pubKey = do- let pageSize = 50+ 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)+ 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]@@ -66,18 +69,21 @@ -- | 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+ GetRewards :: T.Text -> Maybe Integer -> Maybe Integer -> Endpoint RewardResponse + -- | Make a request to an endpoint.-makeRequest :: MonadHttp m => Endpoint a -> m a+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)- )+ 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@@ -95,42 +101,47 @@ -- | Response of requesting a delegator's rewards. data RewardResponse = RewardResponse- { rrTotal :: Integer+ { 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"+ rrTotal <- o .: "total" rrRewards <- o .: "rewardDetails"- return $ RewardResponse { .. }+ return $ RewardResponse {..} -- | A single staking reward. data Reward = Reward- { rValidatorName :: T.Text+ { rValidatorName :: T.Text , rValidatorAddress :: T.Text- , rDelegator :: T.Text- , rChainId :: T.Text+ , rDelegator :: T.Text+ , rChainId :: T.Text -- ^ Always @bsc@ at the moment - no testnet rewards supported.- , rHeight :: Integer- , rReward :: Scientific- , rRewardTime :: UTCTime+ , rHeight :: Integer+ , rReward :: Scientific+ , rRewardTime :: UTCTime } deriving (Show, Read, Eq, Generic) + instance FromJSON Reward where parseJSON = withObject "Reward" $ \o -> do- rValidatorName <- o .: "valName"+ 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 { .. }+ rDelegator <- o .: "delegator"+ rChainId <- o .: "chainId"+ rHeight <- o .: "height"+ rReward <- o .: "reward"+ rRewardTime <-+ o .: "rewardTime"+ >>= parseTimeM+ True+ defaultTimeLocale+ "%FT%T%Q%Ez"+ return $ Reward {..}
src/Console/BnbStaking/CoinTracking.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE RecordWildCards #-}-{- | Generate & write/print CoinTracking Bulk Import files. --}+-- | Generate & write/print CoinTracking Bulk Import files. module Console.BnbStaking.CoinTracking ( makeCoinTrackingImport , writeOrPrintImportData@@ -9,20 +8,21 @@ , bnb ) where -import Control.Monad ( (>=>) )-import Data.Time ( utcToLocalZonedTime )-import Web.CoinTracking.Imports ( Amount(..)- , CTImportData(..)- , CTTransactionType(Staking)- , Currency(..)- , coinTrackingCsvImport- , writeImportDataToFile- )+import Control.Monad ((>=>))+import Data.Time (utcToLocalZonedTime)+import Web.CoinTracking.Imports+ ( Amount (..)+ , CTImportData (..)+ , CTTransactionType (Staking)+ , Currency (..)+ , coinTrackingCsvImport+ , writeImportDataToFile+ ) -import Console.BnbStaking.Api ( Reward(..) )+import Console.BnbStaking.Api (Reward (..)) -import qualified Data.ByteString.Lazy.Char8 as LBC-import qualified Data.Text as T+import Data.ByteString.Lazy.Char8 qualified as LBC+import Data.Text qualified as T -- | Generate the Bulk Import file for CoinTracking & write to destination@@ -38,11 +38,13 @@ makeCoinTrackingImport dest pubkey = makeImportData pubkey >=> writeOrPrintImportData dest + -- | Write or print the generated import data. writeOrPrintImportData :: FilePath -> [CTImportData] -> IO ()-writeOrPrintImportData dest importData = if dest == "-"- then LBC.putStrLn $ coinTrackingCsvImport importData- else writeImportDataToFile dest importData+writeOrPrintImportData dest importData =+ if dest == "-"+ then LBC.putStrLn $ coinTrackingCsvImport importData+ else writeImportDataToFile dest importData -- | Turn an account pubkey & reward into a 'CTImportData', localizing the@@ -50,24 +52,27 @@ makeImportData :: String -> [Reward] -> IO [CTImportData] makeImportData pubkey = mapM $ \Reward {..} -> do zonedTime <- utcToLocalZonedTime rRewardTime- return CTImportData- { ctidType = Staking- , ctidBuy = Just $ Amount rReward bnb- , ctidSell = Nothing- , ctidFee = Nothing- , ctidExchange = "BNB Wallet"- , ctidGroup = "Staking"- , ctidComment = "Imported From bnb-staking-csvs"- , ctidDate = zonedTime- , ctidTradeId = "BNB-STAKE-"- <> T.pack pubkey- <> "-"- <> rValidatorAddress- <> "-"- <> T.pack (show rHeight)- , ctidBuyValue = Nothing- , ctidSellValue = Nothing- }+ return+ CTImportData+ { ctidType = Staking+ , ctidBuy = Just $ Amount rReward bnb+ , ctidSell = Nothing+ , ctidFee = Nothing+ , ctidExchange = "BNB Wallet"+ , ctidGroup = "Staking"+ , ctidComment = "Imported From bnb-staking-csvs"+ , ctidDate = zonedTime+ , ctidTradeId =+ "BNB-STAKE-"+ <> T.pack pubkey+ <> "-"+ <> rValidatorAddress+ <> "-"+ <> T.pack (show rHeight)+ , ctidBuyValue = Nothing+ , ctidSellValue = Nothing+ }+ -- | Binance Coin currency with the @BNB@ ticker & 8 decimals of precision. bnb :: Currency
src/Console/BnbStaking/Csv.hs view
@@ -1,32 +1,35 @@ {-# LANGUAGE RecordWildCards #-}-{- | CSV serialization of BNB Staking Rewards.--}++-- | CSV serialization of BNB Staking Rewards. module Console.BnbStaking.Csv ( makeCsvContents- , ExportData(..)+ , ExportData (..) , convertReward- , MyZonedTime(..)+ , MyZonedTime (..) ) where -import Data.Csv ( DefaultOrdered- , ToField(..)- , ToNamedRecord- , encodeDefaultOrderedByName- )-import Data.Scientific ( FPFormat(..)- , formatScientific- )-import Data.Time ( ZonedTime(..)- , defaultTimeLocale- , formatTime- , utcToLocalZonedTime- )-import GHC.Generics ( Generic )+import Data.Csv+ ( DefaultOrdered+ , ToField (..)+ , ToNamedRecord+ , encodeDefaultOrderedByName+ )+import Data.Scientific+ ( FPFormat (..)+ , formatScientific+ )+import Data.Time+ ( ZonedTime (..)+ , defaultTimeLocale+ , formatTime+ , utcToLocalZonedTime+ )+import GHC.Generics (Generic) -import Console.BnbStaking.Api ( Reward(..) )+import Console.BnbStaking.Api (Reward (..)) -import qualified Data.ByteString.Lazy as LBS-import qualified Data.Text as T+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T -- | Build the CSV contents for the given rewards, including the header@@ -34,46 +37,52 @@ makeCsvContents :: [Reward] -> IO LBS.ByteString makeCsvContents = fmap encodeDefaultOrderedByName . mapM convertReward + -- | Datatype representing a single row in the CSV export. data ExportData = ExportData- { time :: MyZonedTime+ { time :: MyZonedTime -- ^ The time of the reward.- , amount :: T.Text+ , amount :: T.Text -- ^ The reward amount.- , currency :: T.Text+ , currency :: T.Text -- ^ Always @BNB@, but sometimes a useful column for CSV imports.- , delegator :: T.Text+ , delegator :: T.Text -- ^ The address that was rewarded.- , validator :: T.Text+ , validator :: T.Text -- ^ The validator's name. , validatorAddress :: T.Text -- ^ The address the delegator is validating to.- , height :: Integer+ , 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- }+ 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)+newtype MyZonedTime = MyZonedTime {fromMyZonedTime :: ZonedTime} deriving (Show, Read)+ -- | Render with @%FT%T%Q%Ez@ formatting string. instance ToField MyZonedTime where
src/Console/BnbStaking/Main.hs view
@@ -1,125 +1,164 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-}-{- | CLI application harness. --}+-- | CLI application harness. module Console.BnbStaking.Main ( run , getArgs- , Args(..)+ , Args (..) ) where-import Control.Monad ( filterM )-import Data.Maybe ( fromMaybe )-import Data.Time ( localDay- , toGregorian- , utcToLocalZonedTime- , zonedTimeToLocalTime- )-import Data.Version ( showVersion )-import Network.HTTP.Req ( defaultHttpConfig- , runReq- )-import System.Console.CmdArgs ( (&=)- , Data- , Typeable- , argPos- , cmdArgs- , def- , explicit- , help- , helpArg- , name- , program- , summary- , typ- ) -import Console.BnbStaking.Api ( Reward(rRewardTime)- , getAllRewards- )-import Console.BnbStaking.CoinTracking- ( makeCoinTrackingImport )-import Console.BnbStaking.Csv ( makeCsvContents )-import Paths_bnb_staking_csvs ( version )+import Control.Monad (filterM, foldM, (<=<))+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Time (localDay, toGregorian, utcToLocalZonedTime, zonedTimeToLocalTime)+import Data.Version (showVersion)+import Network.HTTP.Req (defaultHttpConfig, runReq)+import System.Console.CmdArgs+ ( Data+ , Typeable+ , argPos+ , cmdArgs+ , def+ , explicit+ , help+ , helpArg+ , name+ , program+ , summary+ , typ+ , (&=)+ ) -import qualified Data.ByteString.Lazy.Char8 as LBC-import qualified Data.Text as T+import Console.BnbStaking.Api (Reward (..), getAllRewards)+import Console.BnbStaking.CoinTracking (makeCoinTrackingImport)+import Console.BnbStaking.Csv (makeCsvContents)+import Paths_bnb_staking_csvs (version) +import Data.ByteString.Lazy.Char8 qualified as LBC+import Data.List qualified as L+import Data.Map.Strict qualified as M+import Data.Text qualified as T++ -- | Run the executable - parsing args, making queries, & printing the -- results. run :: Args -> IO () run Args {..} = do- rewards <- runReq defaultHttpConfig $ getAllRewards $ T.pack argPubKey+ let aggregator = if argAggregate then aggregateRewards else return+ filterer = maybe return filterByYear argYear+ rewards <-+ filterer <=< aggregator <=< runReq defaultHttpConfig $+ getAllRewards (T.pack argPubKey) let outputFile = fromMaybe "-" argOutputFile if argCoinTracking then makeCoinTrackingImport outputFile argPubKey rewards else do- filteredRewards <- maybe- (return rewards)- (\year -> filterM- (\reward -> do- rewardTime <- utcToLocalZonedTime $ rRewardTime reward- return- . (\(y, _, _) -> y == year)- . toGregorian- . localDay- $ zonedTimeToLocalTime rewardTime- )- rewards- )- argYear- output <- makeCsvContents filteredRewards+ -- TODO: we calculate local zoned day in filterByYear & in+ -- makeCsvContents. Can we do it just once?+ output <- makeCsvContents rewards if outputFile == "-" then LBC.putStr output else LBC.writeFile outputFile output+ where+ aggregateRewards :: [Reward] -> IO [Reward]+ aggregateRewards =+ fmap (mapMaybe (aggregate . snd) . M.toList)+ . foldM+ ( \acc r -> do+ rewardTime <- utcToLocalZonedTime $ rRewardTime r+ return $+ M.insertWith+ (<>)+ (localDay $ zonedTimeToLocalTime rewardTime)+ [r]+ acc+ )+ M.empty+ aggregate :: [Reward] -> Maybe Reward+ aggregate = \case+ [] -> Nothing+ rs ->+ Just $+ Reward+ { rValidatorName =+ "AGGREGATE-"+ <> T.intercalate+ "-"+ (L.sort $ map rValidatorName rs)+ , rValidatorAddress = "AGGREGATE-" <> T.pack (show $ length rs)+ , rDelegator = T.intercalate "-" $ L.sort $ map rDelegator rs+ , rChainId = rChainId $ head rs+ , rHeight = rHeight $ head rs+ , rReward = sum $ map rReward rs+ , rRewardTime = minimum $ map rRewardTime rs+ }+ filterByYear :: Integer -> [Reward] -> IO [Reward]+ filterByYear year = filterM $ \reward -> do+ rewardTime <- utcToLocalZonedTime $ rRewardTime reward+ return+ . (\(y, _, _) -> y == year)+ . toGregorian+ . localDay+ $ zonedTimeToLocalTime rewardTime -- | CLI arguments supported by the executable. data Args = Args- { argPubKey :: String+ { argPubKey :: String -- ^ BinanceChain account's pubkey.- , argOutputFile :: Maybe String+ , argOutputFile :: Maybe String -- ^ Optional output file. 'Nothing' or @'Just' "-"@ will print to -- 'System.IO.stdout'. , argCoinTracking :: Bool -- ^ Flag to enable writing/printing files formatted for CoinTracking -- Bulk Imports.- , argYear :: Maybe Integer+ , argYear :: Maybe Integer -- ^ Year for limiting the output.+ , argAggregate :: Bool+ -- ^ Aggregate rewards into day buckets. } deriving (Show, Read, Eq, Data, Typeable) + -- | Parse the CLI arguments with 'System.Console.CmdArgs'. getArgs :: IO Args getArgs = cmdArgs argSpec + argSpec :: Args argSpec = Args- { argPubKey = def &= argPos 0 &= typ "ACCOUNT_PUBKEY"- , argOutputFile =- Nothing+ { argPubKey = def &= argPos 0 &= typ "ACCOUNT_PUBKEY"+ , argOutputFile =+ Nothing &= help "File to write the export to. Default: stdout" &= explicit &= name "output-file" &= name "o" &= typ "FILE"- , argCoinTracking = False- &= help "Generate a CoinTracking Import file."- &= explicit- &= name "cointracking"- , argYear = Nothing- &= help "Limit to given year"- &= explicit- &= name "y"- &= name "year"- &= typ "YYYY"- }+ , argCoinTracking =+ False+ &= help "Generate a CoinTracking Import file."+ &= explicit+ &= name "cointracking"+ , argYear =+ Nothing+ &= help "Limit to given year"+ &= explicit+ &= name "y"+ &= name "year"+ &= typ "YYYY"+ , argAggregate =+ False+ &= help "Output one aggregate row per day."+ &= explicit+ &= name "aggregate"+ } &= summary- ( "bnb-staking-csvs v"- <> showVersion version- <> ", Pavan Rikhi 2021"- )+ ( "bnb-staking-csvs v"+ <> showVersion version+ <> ", Pavan Rikhi 2021-2024"+ ) &= program "bnb-staking-csvs" &= helpArg [name "h"] &= help "Generate CSV Exports of you BinanceChain Staking Rewards."
tests/Spec.hs view
@@ -1,10 +1,10 @@-import Hedgehog-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.Hedgehog+import Hedgehog+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Hedgehog -import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range main :: IO ()@@ -23,9 +23,10 @@ properties :: TestTree-properties = testGroup- "Properties"- [testProperty "Addition is Communative" testAdditionCommunative]+properties =+ testGroup+ "Properties"+ [testProperty "Addition is Communative" testAdditionCommunative] where testAdditionCommunative :: Property testAdditionCommunative = property $ do