diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ import Distribution.Simple + + main = defaultMain diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,10 @@ module Main where -import Console.BnbStaking.Main ( getArgs - , run - ) +import Console.BnbStaking.Main + ( getArgs + , run + ) + main :: IO () main = getArgs >>= run diff --git a/bnb-staking-csvs.cabal b/bnb-staking-csvs.cabal --- a/bnb-staking-csvs.cabal +++ b/bnb-staking-csvs.cabal @@ -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 diff --git a/src/Console/BnbStaking/Api.hs b/src/Console/BnbStaking/Api.hs --- a/src/Console/BnbStaking/Api.hs +++ b/src/Console/BnbStaking/Api.hs @@ -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 {..} diff --git a/src/Console/BnbStaking/CoinTracking.hs b/src/Console/BnbStaking/CoinTracking.hs --- a/src/Console/BnbStaking/CoinTracking.hs +++ b/src/Console/BnbStaking/CoinTracking.hs @@ -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 diff --git a/src/Console/BnbStaking/Csv.hs b/src/Console/BnbStaking/Csv.hs --- a/src/Console/BnbStaking/Csv.hs +++ b/src/Console/BnbStaking/Csv.hs @@ -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 diff --git a/src/Console/BnbStaking/Main.hs b/src/Console/BnbStaking/Main.hs --- a/src/Console/BnbStaking/Main.hs +++ b/src/Console/BnbStaking/Main.hs @@ -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." diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -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