solana-staking-csvs 0.1.2.0 → 0.1.3.0

raw patch · 9 files changed

+455/−315 lines, 9 filesdep +containersdep +exceptionsdep +http-clientsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers, exceptions, http-client, http-types

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• Setup.hs +2/−0
• app/Main.hs +4/−3
• solana-staking-csvs.cabal +11/−4
• src/Console/SolanaStaking/Api.hs +219/−148
• src/Console/SolanaStaking/CoinTracking.hs +46/−37
• src/Console/SolanaStaking/Csv.hs +43/−40
• src/Console/SolanaStaking/Main.hs +110/−74
• tests/Spec.hs +10/−9

@@ -3,6 +3,16 @@ ## master  ++## v0.1.3.0++* Bump dependency versions(text).+* Add `--aggregate` flag to group rewards by day.+* Fetch rewards until no more rewards are returned instead of stopping when+  less than the 5-item page limit is returned.+* Handle breaking API changes when rate limited.++ ## v0.1.2.0  * Add `--year` flag to allow filtering the output by date.

@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain

@@ -1,8 +1,9 @@ module Main where -import           Console.SolanaStaking.Main     ( getArgs-                                                , run-                                                )+import Console.SolanaStaking.Main+    ( getArgs+    , run+    )   main :: IO ()

@@ -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:           solana-staking-csvs-version:        0.1.2.0+version:        0.1.3.0 synopsis:       Generate CSV Exports of your Solana Staking Rewards. description:    @solana-staking-csvs@ is a CLI program that queries the Solana blockchain                 for an account's staking accounts and exports all their staking rewards to@@ -29,7 +29,7 @@ bug-reports:    https://github.com/prikhi/solana-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@@ -54,6 +54,7 @@   default-extensions:       DataKinds       DeriveGeneric+      ImportQualifiedPost       LambdaCase       OverloadedStrings       TupleSections@@ -67,10 +68,14 @@     , cassava <1     , cmdargs >=0.10 && <1     , cointracking-imports <1+    , containers <1+    , exceptions <1+    , http-client <1+    , http-types <1     , mtl ==2.*     , req >=3.4 && <4     , scientific <1-    , text <2+    , text <3     , time <2   default-language: Haskell2010 @@ -83,6 +88,7 @@   default-extensions:       DataKinds       DeriveGeneric+      ImportQualifiedPost       LambdaCase       OverloadedStrings       TupleSections@@ -104,6 +110,7 @@   default-extensions:       DataKinds       DeriveGeneric+      ImportQualifiedPost       LambdaCase       OverloadedStrings       TupleSections

@@ -1,93 +1,102 @@-{-| Solana Beach API requests & responses.--TODO: Extract into a @solana-beach-api@ package.--} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}++{- | Solana Beach API requests & responses.++TODO: Extract into a @solana-beach-api@ package.+-} module Console.SolanaStaking.Api     ( -- * Configuration-      Config(..)+      Config (..)     , mkConfig+       -- * Requests / Responses-    , APIResponse(..)-    , APIError(..)+    , APIResponse (..)+    , APIError (..)     , runApi     , raiseAPIError+       -- ** Get Stake Accounts     , getAccountStakes-    , StakingAccounts(..)-    , StakingAccount(..)+    , StakingAccounts (..)+    , StakingAccount (..)+       -- ** Get Staking Rewards     , getAllStakeRewards     , getYearsStakeRewards     , getStakeRewards-    , StakeReward(..)+    , StakeReward (..)+       -- ** Get Block     , getBlock-    , Block(..)+    , Block (..)+       -- * General API Types-    , Lamports(..)+    , Lamports (..)     , renderLamports     , scientificLamports-    , StakingPubKey(..)+    , StakingPubKey (..)     ) where -import           Control.Concurrent             ( threadDelay )-import           Control.Monad.Except           ( MonadError(throwError)-                                                , runExceptT-                                                )-import           Control.Monad.Reader           ( MonadIO-                                                , MonadReader-                                                , asks-                                                , liftIO-                                                )-import           Data.Aeson                     ( (.:)-                                                , (.:?)-                                                , FromJSON(parseJSON)-                                                , Value(Object)-                                                , withObject-                                                )-import           Data.Bifunctor                 ( second )-import           Data.Scientific                ( FPFormat(Fixed)-                                                , Scientific-                                                , formatScientific-                                                )-import           Data.Text.Encoding             ( encodeUtf8 )-import           Data.Time                      ( toGregorian-                                                , utctDay-                                                )-import           Data.Time.Clock.POSIX          ( POSIXTime-                                                , posixSecondsToUTCTime-                                                )-import           GHC.Generics                   ( Generic )-import           Network.HTTP.Req               ( (/:)-                                                , (/~)-                                                , GET(GET)-                                                , NoReqBody(NoReqBody)-                                                , Option-                                                , Scheme(Https)-                                                , Url-                                                , defaultHttpConfig-                                                , header-                                                , https-                                                , jsonResponse-                                                , queryParam-                                                , renderUrl-                                                , req-                                                , responseBody-                                                , runReq-                                                )-import           System.IO                      ( hPutStrLn-                                                , stderr-                                                )+import Control.Concurrent (threadDelay)+import Control.Exception (throwIO)+import Control.Monad ((>=>))+import Control.Monad.Catch (MonadCatch, try)+import Control.Monad.Except (MonadError (throwError), runExceptT)+import Control.Monad.Reader (MonadIO, MonadReader, asks, liftIO)+import Data.Aeson+    ( FromJSON (parseJSON)+    , Value (Object)+    , eitherDecode+    , withObject+    , (.:)+    , (.:?)+    )+import Data.Bifunctor (second)+import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific)+import Data.Text.Encoding (encodeUtf8)+import Data.Time (toGregorian, utctDay)+import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)+import GHC.Generics (Generic)+import Network.HTTP.Client+    ( HttpException (..)+    , HttpExceptionContent (..)+    , responseStatus+    )+import Network.HTTP.Req+    ( GET (GET)+    , HttpException (..)+    , HttpResponse+    , HttpResponseBody+    , NoReqBody (NoReqBody)+    , Option+    , Scheme (Https)+    , Url+    , defaultHttpConfig+    , header+    , https+    , jsonResponse+    , queryParam+    , renderUrl+    , req+    , responseBody+    , runReq+    , (/:)+    , (/~)+    )+import Network.HTTP.Types (statusCode)+import System.IO (hPutStrLn, stderr)+import Text.Read (readMaybe) -import qualified Data.Text                     as T+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T + -- | Solana Beach API Configuration data Config = Config-    { cApiKey        :: T.Text+    { cApiKey :: T.Text     -- ^ Your API Key.     -- Get one here: https://github.com/solana-beach/api     , cAccountPubKey :: T.Text@@ -96,11 +105,13 @@     }     deriving (Show, Read, Eq) + -- | Create a program config from the API key & the target account's -- pubkey. mkConfig :: String -> String -> Config-mkConfig (T.pack -> cApiKey) (T.pack -> cAccountPubKey) = Config { .. }+mkConfig (T.pack -> cApiKey) (T.pack -> cAccountPubKey) = Config {..} + -- | Base URL to Solana Beach's API baseUrl :: Url 'Https baseUrl = https "api.solanabeach.io" /: "v1"@@ -108,62 +119,71 @@  -- | Get the staking accounts for the 'cAccountPubKey'. getAccountStakes-    :: (MonadIO m, MonadReader Config m) => m (APIResponse StakingAccounts)+    :: (MonadReader Config m, MonadCatch m, MonadIO m)+    => m (APIResponse StakingAccounts) getAccountStakes = do     pubkey <- asks cAccountPubKey     getReq (baseUrl /: "account" /~ pubkey /: "stakes") mempty + -- | Single Result Page of Staking Accounts Query. data StakingAccounts = StakingAccounts-    { saResults    :: [StakingAccount]+    { saResults :: [StakingAccount]     -- ^ The returned staking accounts     , saTotalPages :: Integer     -- ^ The total number of pages for the Account's PubKey.     }     deriving (Show, Read, Eq, Generic) + instance FromJSON StakingAccounts where     parseJSON = withObject "StakingAccounts" $ \o -> do-        saResults    <- o .: "data"+        saResults <- o .: "data"         saTotalPages <- o .: "totalPages"-        return StakingAccounts { .. }+        return StakingAccounts {..} + -- | A single Staking Account. data StakingAccount = StakingAccount-    { saPubKey        :: StakingPubKey+    { saPubKey :: StakingPubKey     -- ^ The Staking Accounts PubKey-    , saLamports      :: Lamports+    , saLamports :: Lamports     -- ^ The Balance of the Staking Account     , saValidatorName :: T.Text     -- ^ The Name of the Staking Account's Validator     }     deriving (Show, Read, Eq, Generic) + instance FromJSON StakingAccount where     parseJSON = withObject "StakingAccount" $ \o -> do-        saPubKey        <- o .: "pubkey" >>= (.: "address")-        saLamports      <- o .: "lamports"+        saPubKey <- o .: "pubkey" >>= (.: "address")+        saLamports <- o .: "lamports"         saValidatorName <-             o-            .:  "data"-            >>= (.: "stake")-            >>= (.: "delegation")-            >>= (.: "validatorInfo")-            >>= (.: "name")-        return StakingAccount { .. }+                .: "data"+                >>= (.: "stake")+                >>= (.: "delegation")+                >>= (.: "validatorInfo")+                >>= (.: "name")+        return StakingAccount {..} + -- | A PubKey for a Staking Account.-newtype StakingPubKey =-    StakingPubKey { fromStakingPubKey :: T.Text } deriving (Show, Read, Eq, Generic, FromJSON)+newtype StakingPubKey = StakingPubKey {fromStakingPubKey :: T.Text}+    deriving (Show, Read, Eq, Generic, FromJSON) + -- | An amount of Lamports, each of which represent 0.000000001 SOL.-newtype Lamports =-    Lamports { fromLamports :: Integer } deriving (Show, Read, Eq, Generic, FromJSON)+newtype Lamports = Lamports {fromLamports :: Integer}+    deriving (Show, Read, Eq, Num, Generic, FromJSON) + -- | Render an amount of 'Lamports' as text, converting it to SOL. renderLamports :: Lamports -> T.Text renderLamports = T.pack . formatScientific Fixed (Just 9) . scientificLamports + -- | Convert Lamports into Scientific representation of SOL. scientificLamports :: Lamports -> Scientific scientificLamports = (* 0.000000001) . fromInteger . fromLamports@@ -171,40 +191,45 @@  -- | Get the staking rewards with a staking account's pubkey. getStakeRewards-    :: (MonadIO m, MonadReader Config m)+    :: (MonadReader Config m, MonadCatch m, MonadIO m)     => StakingPubKey     -> Maybe Integer     -> m (APIResponse [StakeReward]) getStakeRewards (StakingPubKey stakeAccountPubkey) mbEpochCursor = do-    getReq (baseUrl /: "account" /: stakeAccountPubkey /: "stake-rewards")-           (queryParam "cursor" mbEpochCursor)+    getReq+        (baseUrl /: "account" /: stakeAccountPubkey /: "stake-rewards")+        (queryParam "cursor" mbEpochCursor) + -- | Get all the staking rewards for the given account. -- -- The API's @stake-rewards@ route only returns a maximum of 5 rewards, so -- we have to use the earliest epoch as the @cursor@ in an additional -- request to see if there are any more rewards. getAllStakeRewards-    :: (MonadIO m, MonadReader Config m)+    :: (MonadReader Config m, MonadCatch m, MonadIO m)     => StakingPubKey     -> m ([APIError], [StakeReward]) getAllStakeRewards pubkey =-    getStakeRewards pubkey Nothing >>= runApi >>= getStakeRewardsUntil-        pubkey-        (const True)-        ([], [])+    getStakeRewards pubkey Nothing+        >>= runApi+        >>= getStakeRewardsUntil+            pubkey+            (const True)+            ([], []) + -- | Get the year's worth of staking rewards for the given account. getYearsStakeRewards-    :: (MonadIO m, MonadReader Config m)+    :: (MonadReader Config m, MonadCatch m, MonadIO m)     => StakingPubKey     -> Integer     -> m ([APIError], [StakeReward]) getYearsStakeRewards pubkey year =-    fmap (second $ filter ((== year) . rewardYear))-        $   getStakeRewards pubkey Nothing-        >>= runApi-        >>= getStakeRewardsUntil pubkey stopAfterYear ([], [])+    fmap (second $ filter ((== year) . rewardYear)) $+        getStakeRewards pubkey Nothing+            >>= runApi+            >>= getStakeRewardsUntil pubkey stopAfterYear ([], [])   where     rewardYear :: StakeReward -> Integer     rewardYear =@@ -218,69 +243,77 @@     stopAfterYear rewards =         let years = map rewardYear rewards in any (< year) years + -- | Fetch staking rewards until we get less than 5 rewards or the general -- predicate returns true. getStakeRewardsUntil-    :: (MonadIO m, MonadReader Config m)+    :: (MonadReader Config m, MonadCatch m, MonadIO m)     => StakingPubKey     -> ([StakeReward] -> Bool)     -> ([APIError], [StakeReward])     -> Either APIError [StakeReward]     -> m ([APIError], [StakeReward]) getStakeRewardsUntil pubkey cond (errs, rws) = \case-    Left  err     -> return (err : errs, rws)-    Right rewards -> if length rewards < 5 || cond rewards-        then return (errs, rewards <> rws)-        else-            let minEpoch = minimum $ map srEpoch rewards-            in  getStakeRewards pubkey (Just minEpoch)-                >>= runApi-                >>= getStakeRewardsUntil pubkey cond (errs, rewards <> rws)+    Left err -> return (err : errs, rws)+    Right rewards ->+        if null rewards || cond rewards+            then return (errs, rewards <> rws)+            else+                let minEpoch = minimum $ map srEpoch rewards+                 in getStakeRewards pubkey (Just minEpoch)+                        >>= runApi+                        >>= getStakeRewardsUntil pubkey cond (errs, rewards <> rws)   -- | A Staking Reward Payment. data StakeReward = StakeReward-    { srEpoch     :: Integer+    { srEpoch :: Integer     -- ^ The Epoch the reward was paid.-    , srSlot      :: Integer+    , srSlot :: Integer     -- ^ The 'Block' number of the reward.-    , srAmount    :: Lamports+    , srAmount :: Lamports     -- ^ The total number of 'Lamports' awarded.     , srTimestamp :: POSIXTime     }     deriving (Show, Read, Eq, Generic) + instance FromJSON StakeReward where     parseJSON = withObject "StakeReward" $ \o -> do-        srEpoch     <- o .: "epoch"-        srSlot      <- o .: "effectiveSlot"-        srAmount    <- o .: "amount"+        srEpoch <- o .: "epoch"+        srSlot <- o .: "effectiveSlot"+        srAmount <- o .: "amount"         srTimestamp <- o .: "timestamp"-        return StakeReward { .. }+        return StakeReward {..} + -- | Get information about a specific block number. getBlock-    :: (MonadIO m, MonadReader Config m) => Integer -> m (APIResponse Block)+    :: (MonadReader Config m, MonadCatch m, MonadIO m)+    => Integer+    -> m (APIResponse Block) getBlock blockNum = do     getReq (baseUrl /: "block" /~ blockNum) mempty + -- | A single block on the Solana blockchain. data Block = Block-    { bNumber    :: Integer+    { bNumber :: Integer     -- ^ The blocks number.     , bBlockTime :: POSIXTime     -- ^ The blocks absolute timestamp.     }     deriving (Show, Read, Eq, Generic) + instance FromJSON Block where     parseJSON = withObject "Block" $ \o -> do-        bNumber    <- o .: "blocknumber"+        bNumber <- o .: "blocknumber"         bBlockTime <-             (o .: "blocktime")-            >>= fmap (fromInteger . (truncate @Scientific))-            .   (.: "absolute")-        return Block { .. }+                >>= fmap (fromInteger . (truncate @Scientific))+                    . (.: "absolute")+        return Block {..}   -- | Generic GET request to the Solana Beach API with up to 5 retries for@@ -289,7 +322,7 @@ -- Note: Prints to 'stderr' when waiting for request to finish processing. getReq     :: forall m a-     . (MonadReader Config m, MonadIO m, FromJSON a)+     . (MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m)     => Url 'Https     -> Option 'Https     -> m (APIResponse a)@@ -298,65 +331,103 @@     maxRetries :: Integer     maxRetries = 5     fetchWithRetries :: Integer -> m (APIResponse a)-    fetchWithRetries retryCount = if retryCount >= maxRetries-        then return $ ErrorResponse $ RetriesExceeded $ renderUrl endpoint-        else do-            apikey <- asks cApiKey-            let authHeader =-                    header "Authorization" $ "Bearer: " <> encodeUtf8 apikey-            respBody <- responseBody <$> runReq-                defaultHttpConfig-                (req GET endpoint NoReqBody jsonResponse $ authHeader <> options-                )-            case respBody of-                ProcessingResponse -> do-                    liftIO $ hPutStrLn-                        stderr-                        "Waiting for API to finish processing request..."-                    liftIO $ threadDelay $ 10 * 1000000-                    fetchWithRetries (retryCount + 1)-                _ -> return respBody--+    fetchWithRetries retryCount =+        if retryCount >= maxRetries+            then return $ ErrorResponse $ RetriesExceeded $ renderUrl endpoint+            else do+                apikey <- asks cApiKey+                let authHeader =+                        header "Authorization" $ "Bearer: " <> encodeUtf8 apikey+                respBody <-+                    catchRateLimitError $+                        runReq+                            defaultHttpConfig+                            ( req GET endpoint NoReqBody jsonResponse $ authHeader <> options+                            )+                case respBody of+                    ProcessingResponse -> do+                        liftIO $+                            hPutStrLn+                                stderr+                                "Waiting for API to finish processing request..."+                        liftIO $ threadDelay $ 10 * 1000000+                        fetchWithRetries (retryCount + 1)+                    RateLimitResponse wait -> do+                        liftIO $+                            hPutStrLn stderr $+                                "Exceeded rate limit, waiting "+                                    <> show wait+                                    <> " seconds before retrying..."+                        liftIO $ threadDelay $ wait * 1000000+                        fetchWithRetries retryCount+                    _ -> return respBody+    catchRateLimitError+        :: (FromJSON (HttpResponseBody b))+        => (HttpResponse b)+        => m b+        -> m (HttpResponseBody b)+    catchRateLimitError =+        try >=> \case+            Left e@(VanillaHttpException (HttpExceptionRequest _ (StatusCodeException resp body))) ->+                if statusCode (responseStatus resp) == 429+                    then+                        either (liftIO . throwIO . JsonHttpException) return $+                            eitherDecode $+                                LBS.fromStrict body+                    else liftIO $ throwIO e+            Left e -> liftIO $ throwIO e+            Right r -> return $ responseBody r   -- | Wrapper around error & processing responses from the API. data APIResponse a     = SuccessfulReponse a     | ProcessingResponse+    | RateLimitResponse Int     | ErrorResponse APIError     deriving (Show, Read, Eq) + -- | Attempts to parse a processing response, then an error response, -- & finally the inner @a@ response.-instance FromJSON a => FromJSON (APIResponse a) where+instance (FromJSON a) => FromJSON (APIResponse a) where     parseJSON v = case v of         Object o -> do             o .:? "err" >>= \case-                Just errMsg -> o .:? "processing" >>= \case-                    Nothing          -> return $ ErrorResponse $ APIError errMsg-                    Just (_ :: Bool) -> return ProcessingResponse+                Just errMsg ->+                    o .:? "processing" >>= \case+                        Nothing ->+                            o .:? "retry" >>= \case+                                Just (readMaybe -> Just i) ->+                                    return $ RateLimitResponse i+                                _ -> return $ ErrorResponse $ APIError errMsg+                        Just (_ :: Bool) -> return ProcessingResponse                 Nothing -> fmap SuccessfulReponse . parseJSON $ Object o         _ -> SuccessfulReponse <$> parseJSON v + -- | Evaluate an API response.-runApi :: Monad m => APIResponse a -> m (Either APIError a)+runApi :: (Monad m) => APIResponse a -> m (Either APIError a) runApi = runExceptT . raiseAPIError + -- | Pull the inner value out of an 'APIResponse' or throw the respective -- 'APIError'.-raiseAPIError :: MonadError APIError m => APIResponse a -> m a+raiseAPIError :: (MonadError APIError m) => APIResponse a -> m a raiseAPIError = \case     SuccessfulReponse v -> return v     ProcessingResponse ->         throwError $ APIError "Request cancelled during processing wait."+    RateLimitResponse i -> throwError $ RateLimitError i     ErrorResponse err -> throwError err   -- | Potential error responses from the Solana Beach API. data APIError-    = APIError T.Text-    -- ^ Generic API error with message.-    | RetriesExceeded T.Text-    -- ^ Exceeded maximum number of 'ProcessingResponse' retries.+    = -- | Generic API error with message.+      APIError T.Text+    | -- | Exceeded maximum number of 'ProcessingResponse' retries.+      RetriesExceeded T.Text+    | -- | Rate limiting 429 error.+      RateLimitError Int     deriving (Show, Read, Eq, Generic)

@@ -1,7 +1,6 @@ {-# LANGUAGE RecordWildCards #-}-{-| Generate & write/print CoinTracking import files. --}+-- | Generate & write/print CoinTracking import files. module Console.SolanaStaking.CoinTracking     ( makeCoinTrackingImport     , writeOrPrintImportData@@ -9,25 +8,27 @@     , sol     ) where -import           Control.Monad                  ( (>=>) )-import           Data.Time                      ( utcToLocalZonedTime )-import           Data.Time.Clock.POSIX          ( posixSecondsToUTCTime )-import           Web.CoinTracking.Imports       ( Amount(..)-                                                , CTImportData(..)-                                                , CTTransactionType(Staking)-                                                , Currency(..)-                                                , coinTrackingCsvImport-                                                , writeImportDataToFile-                                                )+import Control.Monad ((>=>))+import Data.Time (utcToLocalZonedTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Web.CoinTracking.Imports+    ( Amount (..)+    , CTImportData (..)+    , CTTransactionType (Staking)+    , Currency (..)+    , coinTrackingCsvImport+    , writeImportDataToFile+    ) -import           Console.SolanaStaking.Api      ( StakeReward(..)-                                                , StakingAccount(..)-                                                , StakingPubKey(..)-                                                , scientificLamports-                                                )+import Console.SolanaStaking.Api+    ( StakeReward (..)+    , StakingAccount (..)+    , StakingPubKey (..)+    , scientificLamports+    ) -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 Import file for CoinTracking & write to destination or@@ -35,32 +36,40 @@ makeCoinTrackingImport :: FilePath -> [(StakingAccount, StakeReward)] -> IO () makeCoinTrackingImport dest = makeImportData >=> 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 a 'StakeReward' into a 'CTImportData', localizing the reward -- time. makeImportData :: [(StakingAccount, StakeReward)] -> IO [CTImportData] makeImportData = mapM $ \(StakingAccount {..}, StakeReward {..}) -> do     zonedTime <- utcToLocalZonedTime $ posixSecondsToUTCTime srTimestamp-    return CTImportData-        { ctidType      = Staking-        , ctidBuy       = Just $ Amount (scientificLamports srAmount) sol-        , ctidSell      = Nothing-        , ctidFee       = Nothing-        , ctidExchange  = "Solana Staking"-        , ctidGroup     = "Staking"-        , ctidComment   = "Imported from solana-staking-csvs"-        , ctidDate      = zonedTime-        , ctidTradeId   =-            "SOL-STAKE-" <> fromStakingPubKey saPubKey <> "-" <> T.pack-                (show srEpoch)-        , ctidBuyValue  = Nothing-        , ctidSellValue = Nothing-        }+    return+        CTImportData+            { ctidType = Staking+            , ctidBuy = Just $ Amount (scientificLamports srAmount) sol+            , ctidSell = Nothing+            , ctidFee = Nothing+            , ctidExchange = "Solana Staking"+            , ctidGroup = "Staking"+            , ctidComment = "Imported from solana-staking-csvs"+            , ctidDate = zonedTime+            , ctidTradeId =+                "SOL-STAKE-"+                    <> fromStakingPubKey saPubKey+                    <> "-"+                    <> T.pack+                        (show srEpoch)+            , ctidBuyValue = Nothing+            , ctidSellValue = Nothing+            }+  -- | @SOL@ currency with the @SOL2@ ticker & 9 decimals of precision. sol :: Currency

@@ -1,76 +1,79 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-}-{-| Types responsible for CSV generation. --}+-- | Types responsible for CSV generation. module Console.SolanaStaking.Csv     ( makeCsvContents-    , ExportData(..)+    , ExportData (..)     , toExportData     ) where -import           Data.Csv                       ( (.=)-                                                , DefaultOrdered(..)-                                                , EncodeOptions(..)-                                                , ToNamedRecord(..)-                                                , defaultEncodeOptions-                                                , encodeDefaultOrderedByNameWith-                                                , namedRecord-                                                )-import           Data.Time                      ( defaultTimeLocale-                                                , formatTime-                                                )-import           Data.Time.Clock.POSIX          ( POSIXTime-                                                , posixSecondsToUTCTime-                                                )+import Data.Csv+    ( DefaultOrdered (..)+    , EncodeOptions (..)+    , ToNamedRecord (..)+    , defaultEncodeOptions+    , encodeDefaultOrderedByNameWith+    , namedRecord+    , (.=)+    )+import Data.Time (defaultTimeLocale, formatTime)+import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime) -import           Console.SolanaStaking.Api      ( StakeReward(..)-                                                , StakingAccount(..)-                                                , StakingPubKey(..)-                                                , renderLamports-                                                )+import Console.SolanaStaking.Api+    ( StakeReward (..)+    , StakingAccount (..)+    , StakingPubKey (..)+    , renderLamports+    ) -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   -- | Represents a single row of CSV data. data ExportData = ExportData-    { edTime         :: T.Text-    , edAmount       :: T.Text+    { edTime :: T.Text+    , edAmount :: T.Text     , edStakeAccount :: T.Text-    , edEpoch        :: Integer+    , edEpoch :: Integer     }     deriving (Show, Read, Eq, Ord) + -- | Remove the @ed@ prefixes from the field names. instance ToNamedRecord ExportData where-    toNamedRecord ExportData {..} = namedRecord-        [ "time" .= edTime-        , "amount" .= edAmount-        , "stakeAccount" .= edStakeAccount-        , "epoch" .= edEpoch-        ]+    toNamedRecord ExportData {..} =+        namedRecord+            [ "time" .= edTime+            , "amount" .= edAmount+            , "stakeAccount" .= edStakeAccount+            , "epoch" .= edEpoch+            ] + -- | Column order is @time, amount, stakeAccount, epoch@. instance DefaultOrdered ExportData where     headerOrder _ = ["time", "amount", "stakeAccount", "epoch"] + -- | Convert an Account & Reward into a CSV row. toExportData :: (StakingAccount, StakeReward) -> ExportData-toExportData (StakingAccount {..}, StakeReward {..}) = ExportData-    { edTime         = formatTimestamp srTimestamp-    , edAmount       = renderLamports srAmount-    , edStakeAccount = fromStakingPubKey saPubKey-    , edEpoch        = srEpoch-    }+toExportData (StakingAccount {..}, StakeReward {..}) =+    ExportData+        { edTime = formatTimestamp srTimestamp+        , edAmount = renderLamports srAmount+        , edStakeAccount = fromStakingPubKey saPubKey+        , edEpoch = srEpoch+        }   where     formatTimestamp :: POSIXTime -> T.Text     formatTimestamp =         T.pack . formatTime defaultTimeLocale "%F %T%Z" . posixSecondsToUTCTime + -- | Build the CSV contents with a header row. makeCsvContents :: [(StakingAccount, StakeReward)] -> LBS.ByteString makeCsvContents =-    encodeDefaultOrderedByNameWith defaultEncodeOptions { encUseCrLf = False }+    encodeDefaultOrderedByNameWith defaultEncodeOptions {encUseCrLf = False}         . map toExportData

@@ -1,56 +1,47 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-}-{-| This module contains the @main@ function used by the exectuable. --}+-- | This module contains the @main@ function used by the exectuable. module Console.SolanaStaking.Main     ( run     , getArgs-    , Args(..)+    , Args (..)     ) where -import           Control.Monad                  ( (<=<)-                                                , forM-                                                , unless-                                                )-import           Control.Monad.Except           ( ExceptT-                                                , runExceptT-                                                )-import           Control.Monad.Reader           ( ReaderT-                                                , liftIO-                                                , runReaderT-                                                )-import           Data.Bifunctor                 ( bimap-                                                , second-                                                )-import           Data.List                      ( sortOn )-import           Data.Maybe                     ( fromMaybe )-import           Data.Version                   ( showVersion )-import           System.Console.CmdArgs         ( (&=)-                                                , Data-                                                , Typeable-                                                , argPos-                                                , cmdArgs-                                                , def-                                                , explicit-                                                , help-                                                , helpArg-                                                , name-                                                , program-                                                , summary-                                                , typ-                                                )-import           System.IO                      ( hPutStrLn-                                                , stderr-                                                )+import Control.Monad (foldM, forM, unless, (<=<))+import Control.Monad.Except (ExceptT, runExceptT)+import Control.Monad.Reader (MonadIO, ReaderT, liftIO, runReaderT)+import Data.Bifunctor (bimap, second)+import Data.List (sortOn)+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Time (LocalTime (..), ZonedTime (..), utcToLocalZonedTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Version (showVersion)+import System.Console.CmdArgs+    ( Data+    , Typeable+    , argPos+    , cmdArgs+    , def+    , explicit+    , help+    , helpArg+    , name+    , program+    , summary+    , typ+    , (&=)+    )+import System.IO (hPutStrLn, stderr) -import           Console.SolanaStaking.Api-import           Console.SolanaStaking.CoinTracking-                                                ( makeCoinTrackingImport )-import           Console.SolanaStaking.Csv      ( makeCsvContents )-import           Paths_solana_staking_csvs      ( version )+import Console.SolanaStaking.Api+import Console.SolanaStaking.CoinTracking (makeCoinTrackingImport)+import Console.SolanaStaking.Csv (makeCsvContents)+import Paths_solana_staking_csvs (version) -import qualified Data.ByteString.Lazy          as LBS+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as M+import Data.Text qualified as T   -- | Pull staking rewards data for the account & print a CSV to stdout.@@ -63,78 +54,123 @@     -- Grab rewards for each stake account     (stakeErrors, stakeRewards) <-         fmap (bimap concat concat . unzip) . forM stakes $ \sa -> do--            second (map (sa, ))-                <$> maybe (getAllStakeRewards (saPubKey sa))-                          (getYearsStakeRewards $ saPubKey sa)-                          argYear+            second (map (sa,))+                <$> maybe+                    (getAllStakeRewards (saPubKey sa))+                    (getYearsStakeRewards $ saPubKey sa)+                    argYear     unless (null stakeErrors) . liftIO $ do         hPutStrLn stderr "Got errors while fetching stake rewards:"         mapM_ (hPutStrLn stderr . ("\t" <>) . show) stakeErrors     -- Write the CSV     let orderedRewards = sortOn (srTimestamp . snd) stakeRewards-        outputFile     = fromMaybe "-" argOutputFile+        aggregator = if argAggregate then aggregateRewards else return+        outputFile = fromMaybe "-" argOutputFile+    rewards <- aggregator orderedRewards     if argCoinTracking-        then liftIO $ makeCoinTrackingImport outputFile orderedRewards+        then liftIO $ makeCoinTrackingImport outputFile rewards         else do-            let output = makeCsvContents orderedRewards+            let output = makeCsvContents rewards             if outputFile == "-"                 then liftIO $ LBS.putStr output                 else liftIO $ LBS.writeFile outputFile output   where     runner :: ReaderT Config (ExceptT APIError IO) a -> IO (Either APIError a)     runner = runExceptT . flip runReaderT (mkConfig argApiKey argPubKey)+    aggregateRewards :: (MonadIO m) => [(StakingAccount, StakeReward)] -> m [(StakingAccount, StakeReward)]+    aggregateRewards =+        fmap (mapMaybe (aggregate . snd) . M.toList)+            . foldM+                ( \acc r -> do+                    rewardTime <- liftIO . utcToLocalZonedTime $ posixSecondsToUTCTime $ srTimestamp $ snd r+                    return $+                        M.insertWith+                            (<>)+                            (localDay $ zonedTimeToLocalTime rewardTime)+                            [r]+                            acc+                )+                M.empty +    aggregate :: [(StakingAccount, StakeReward)] -> Maybe (StakingAccount, StakeReward)+    aggregate = \case+        [] -> Nothing+        rs ->+            Just+                ( StakingAccount+                    { saValidatorName = "AGGREGATE-" <> T.pack (show $ length rs)+                    , saPubKey = StakingPubKey $ T.pack argPubKey+                    , saLamports = sum $ map (saLamports . fst) rs+                    }+                , StakeReward+                    { srTimestamp = minimum $ map (srTimestamp . snd) rs+                    , srSlot = srSlot $ snd $ head rs+                    , srEpoch = srEpoch $ snd $ head rs+                    , srAmount = sum $ map (srAmount . snd) rs+                    }+                ) + -- | CLI arguments supported by the executable. data Args = Args-    { argApiKey       :: String+    { argApiKey :: String     -- ^ Solana Beach API Key-    , argPubKey       :: String+    , argPubKey :: String     -- ^ Delegator's PubKey.-    , argOutputFile   :: Maybe String+    , argOutputFile :: Maybe String     -- ^ Optional output file. 'Nothing' or @'Just' "-"@ means print to     -- 'System.IO.stdout'.     , argCoinTracking :: Bool     -- ^ Flag to enable writing/printing files formatted for CoinTracking     -- Imports.-    , argYear         :: Maybe Integer+    , argYear :: Maybe Integer     -- ^ Year to limit output to.+    , argAggregate :: Bool+    -- ^ Aggregate rewards into single-day transactions.     }     deriving (Show, Read, Eq, Data, Typeable) + -- | Parse the CLI arguments with 'System.Console.CmdArgs'. getArgs :: IO Args getArgs = cmdArgs argSpec + argSpec :: Args argSpec =     Args-            { argApiKey       = def &= argPos 0 &= typ "API_KEY"-            , argPubKey       = def &= argPos 1 &= typ "ACCOUNT_PUBKEY"-            , argOutputFile   =-                Nothing+        { argApiKey = def &= argPos 0 &= typ "API_KEY"+        , argPubKey = def &= argPos 1 &= 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-               (  "solana-staking-csvs v"-               <> showVersion version-               <> ", Pavan Rikhi 2021"-               )+            ( "solana-staking-csvs v"+                <> showVersion version+                <> ", Pavan Rikhi 2021-2024"+            )         &= program "solana-staking-csvs"         &= helpArg [name "h"]         &= help "Generate CSV Exports of your Solana Staking Rewards."

@@ -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