diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# CHANGELOG + +## v0.1.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Pavan Rikhi (c) 2021 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Pavan Rikhi nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,57 @@ +# bnb-staking-csvs + +[![bnb-staking-csvs Build Status](https://github.com/prikhi/bnb-staking-csvs/actions/workflows/main.yml/badge.svg)](https://github.com/prikhi/bnb-staking-csvs/actions/workflows/main.yml) + + +Generate CSV exports of your staking rewards on BinanceChain. + +Requires [`stack`][get-stack]: + +```sh +stack run -- +``` + +[get-stack]: https://docs.haskellstack.org/en/stable/README/ + + +## Install + +You can install the CLI exe by running `stack install`. This lets you call the +executable directly instead of through stack: + +```sh +$ stack install +$ export PATH="${HOME}/.local/bin/:${PATH}" +$ bnb-staking-csvs bnb1hwzqet2vusraqvxfxgr6zhupd8kpgz5hpl2wf2 | head -n 4 +time,amount,currency,delegator,validator,validatorAddress,height +2021-04-09T20:00:00-04:00,0.00118792,BNB,bnb1hwzqet2vusraqvxfxgr6zhupd8kpgz5hpl2wf2,BscScan,bva1t42gtf6hawqgpmdpjzmvlzvmlttlqtkvlmgjxt,155843908 +2021-04-10T20:00:00-04:00,0.00095682,BNB,bnb1hwzqet2vusraqvxfxgr6zhupd8kpgz5hpl2wf2,BscScan,bva1t42gtf6hawqgpmdpjzmvlzvmlttlqtkvlmgjxt,156060618 +2021-04-11T20:00:00-04:00,1.74196290,BNB,bnb1hwzqet2vusraqvxfxgr6zhupd8kpgz5hpl2wf2,TW Staking,bva1c6aqe9ndzcn2nsan963z43xg6kgrvzynl97785,156277904 +``` + + +## Build + +You can build the project with stack: + +```sh +stack build +``` + +For development, you can enable fast builds with file-watching, +documentation-building, & test-running: + +```sh +stack test --haddock --fast --file-watch --pedantic +``` + +To build & open the documentation, run + +```sh +stack haddock --open bnb-staking-csvs +``` + + +## LICENSE + +BSD-3 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = run diff --git a/bnb-staking-csvs.cabal b/bnb-staking-csvs.cabal new file mode 100644 --- /dev/null +++ b/bnb-staking-csvs.cabal @@ -0,0 +1,106 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- 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 + 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 +homepage: https://github.com/prikhi/bnb-staking-csvs#readme +bug-reports: https://github.com/prikhi/bnb-staking-csvs/issues +author: Pavan Rikhi +maintainer: pavan.rikhi@gmail.com +copyright: 2021 Pavan Rikhi +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/prikhi/bnb-staking-csvs + +library + exposed-modules: + Lib + other-modules: + Paths_bnb_staking_csvs + hs-source-dirs: + src + default-extensions: + DeriveGeneric + LambdaCase + NamedFieldPuns + OverloadedStrings + TupleSections + TypeApplications + TypeOperators + ViewPatterns + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 + build-depends: + aeson <2 + , base >=4.7 && <5 + , bytestring <1 + , cassava <1 + , req ==3.* + , scientific <1 + , text ==1.* + , time ==1.* + default-language: Haskell2010 + +executable bnb-staking-csvs + main-is: Main.hs + other-modules: + Paths_bnb_staking_csvs + hs-source-dirs: + app + default-extensions: + DeriveGeneric + LambdaCase + NamedFieldPuns + OverloadedStrings + TupleSections + TypeApplications + TypeOperators + ViewPatterns + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T" + build-depends: + base >=4.7 && <5 + , bnb-staking-csvs + default-language: Haskell2010 + +test-suite bnb-staking-csvs-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_bnb_staking_csvs + hs-source-dirs: + tests + default-extensions: + DeriveGeneric + LambdaCase + NamedFieldPuns + OverloadedStrings + TupleSections + TypeApplications + TypeOperators + ViewPatterns + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T" + build-depends: + base >=4.7 && <5 + , bnb-staking-csvs + , hedgehog + , tasty + , tasty-hedgehog + , tasty-hunit + default-language: Haskell2010 diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,226 @@ +{-| 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 { .. } diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,34 @@ +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 + + +main :: IO () +main = defaultMain tests + + +tests :: TestTree +tests = testGroup "Tests" [unitTests, properties] + + +unitTests :: TestTree +unitTests = testGroup "Unit Tests" [testCase "2+2 = 4" testAddition] + where + testAddition :: Assertion + testAddition = (2 + 2) @?= (4 :: Integer) + + +properties :: TestTree +properties = testGroup + "Properties" + [testProperty "Addition is Communative" testAdditionCommunative] + where + testAdditionCommunative :: Property + testAdditionCommunative = property $ do + let genInt = Gen.int $ Range.linear 0 9001 + (a, b) <- forAll $ (,) <$> genInt <*> genInt + (a + b) === (b + a)