diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,18 @@ # CHANGELOG +## master + + +## v0.2.0.0 + +* Add a `--cointracking` flag to format the data for use with CoinTracking's + Bulk Import feature. +* Add an `--output-file` CLI argument to make the executable write to a file + instead of print to stdout. +* Use the `cmdargs` package to parse CLI arguments. +* Split library into `Console.BnbStaking` module hierarchy. + + ## v0.1.0.0 * Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,6 +9,7 @@ ```sh stack run -- +stack run -- --help ``` [get-stack]: https://docs.haskellstack.org/en/stable/README/ diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,8 @@ module Main where -import Lib +import Console.BnbStaking.Main ( getArgs + , run + ) main :: IO () -main = run +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 @@ -5,15 +5,21 @@ -- see: https://github.com/sol/hpack name: bnb-staking-csvs -version: 0.1.0.0 -synopsis: Generate CSV Exports of Your BNB Staking Rewards -description: @bnb-staking-rewards@ is a CLI program that queries the Binance.org API for +version: 0.2.0.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. . - You can install @bnb-staking-rewards@ with Stack: @stack install --resolver - nightly bnb-stakingrewards@. Then run @bnb-staking-rewards - @ to print out your rewards in CSV format. -category: Web + You can install @bnb-staking-csvs@ with Stack: @stack install --resolver + nightly bnb-staking-csvs@. Then run the following to print out your + rewards in CSV format: + . + @ + bnb-staking-csvs \ + @ + . + See @bnb-staking-csvs --help@ for additional options. +category: Web, Finance, Console homepage: https://github.com/prikhi/bnb-staking-csvs#readme bug-reports: https://github.com/prikhi/bnb-staking-csvs/issues author: Pavan Rikhi @@ -32,7 +38,10 @@ library exposed-modules: - Lib + Console.BnbStaking.Api + Console.BnbStaking.CoinTracking + Console.BnbStaking.Csv + Console.BnbStaking.Main other-modules: Paths_bnb_staking_csvs hs-source-dirs: @@ -52,6 +61,8 @@ , base >=4.7 && <5 , bytestring <1 , cassava <1 + , cmdargs >=0.10 && <1 + , cointracking-imports <1 , req ==3.* , scientific <1 , text ==1.* diff --git a/src/Console/BnbStaking/Api.hs b/src/Console/BnbStaking/Api.hs new file mode 100644 --- /dev/null +++ b/src/Console/BnbStaking/Api.hs @@ -0,0 +1,136 @@ +{-# 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 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 { .. } diff --git a/src/Console/BnbStaking/CoinTracking.hs b/src/Console/BnbStaking/CoinTracking.hs new file mode 100644 --- /dev/null +++ b/src/Console/BnbStaking/CoinTracking.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE RecordWildCards #-} +{- | Generate & write/print CoinTracking Bulk Import files. + +-} +module Console.BnbStaking.CoinTracking + ( makeCoinTrackingImport + , writeOrPrintImportData + , makeImportData + , bnb + ) where + +import Control.Monad ( (>=>) ) +import Data.Time ( utcToLocalZonedTime ) +import Web.CoinTracking.Imports ( Amount(..) + , CTImportData(..) + , CTTransactionType(Staking) + , Currency(..) + , coinTrackingCsvImport + , writeImportDataToFile + ) + +import Console.BnbStaking.Api ( Reward(..) ) + +import qualified Data.ByteString.Lazy.Char8 as LBC +import qualified Data.Text as T + + +-- | Generate the Bulk Import file for CoinTracking & write to destination +-- or print to stdout if destinatin is @"-"@. +makeCoinTrackingImport + :: FilePath + -- ^ Destination. @xls@ or @xlsx@ extensions generate the Excel import, + -- any other extension will generate the CSV import. + -> String + -- ^ Account's PubKey + -> [Reward] + -> IO () +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 + + +-- | Turn an account pubkey & reward into a 'CTImportData', localizing the +-- reward time. +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 + } + +-- | Binance Coin currency with the @BNB@ ticker & 8 decimals of precision. +bnb :: Currency +bnb = Currency 8 "BNB" diff --git a/src/Console/BnbStaking/Csv.hs b/src/Console/BnbStaking/Csv.hs new file mode 100644 --- /dev/null +++ b/src/Console/BnbStaking/Csv.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE RecordWildCards #-} +{- | CSV serialization of BNB Staking Rewards. +-} +module Console.BnbStaking.Csv + ( makeCsvContents + , ExportData(..) + , convertReward + , 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 Console.BnbStaking.Api ( Reward(..) ) + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T + + +-- | Build the CSV contents for the given rewards, including the header +-- row. +makeCsvContents :: [Reward] -> IO LBS.ByteString +makeCsvContents = fmap encodeDefaultOrderedByName . mapM convertReward + +-- | 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) + +-- | Render with @%FT%T%Q%Ez@ formatting string. +instance ToField MyZonedTime where + toField (MyZonedTime zt) = + toField $ formatTime defaultTimeLocale "%FT%T%Q%Ez" zt diff --git a/src/Console/BnbStaking/Main.hs b/src/Console/BnbStaking/Main.hs new file mode 100644 --- /dev/null +++ b/src/Console/BnbStaking/Main.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE RecordWildCards #-} +{- | CLI application harness. + +-} +module Console.BnbStaking.Main + ( run + , getArgs + , Args(..) + ) where +import Data.Maybe ( fromMaybe ) +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 ( getAllRewards ) +import Console.BnbStaking.CoinTracking + ( makeCoinTrackingImport ) +import Console.BnbStaking.Csv ( makeCsvContents ) +import Paths_bnb_staking_csvs ( version ) + +import qualified Data.ByteString.Lazy.Char8 as LBC +import qualified Data.Text 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 outputFile = fromMaybe "-" argOutputFile + if argCoinTracking + then makeCoinTrackingImport outputFile argPubKey rewards + else do + output <- makeCsvContents rewards + if outputFile == "-" + then LBC.putStr output + else LBC.writeFile outputFile output + + +-- | CLI arguments supported by the executable. +data Args = Args + { argPubKey :: String + -- ^ BinanceChain account's pubkey. + , 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. + } + 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 + &= 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" + } + &= summary + ( "bnb-staking-csvs v" + <> showVersion version + <> ", Pavan Rikhi 2021" + ) + &= program "bnb-staking-csvs" + &= helpArg [name "h"] + &= help "Generate CSV Exports of you BinanceChain Staking Rewards." diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 --- a/src/Lib.hs +++ /dev/null @@ -1,226 +0,0 @@ -{-| 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 - " - - --- 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 { .. }