{-# 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 (..)
    , mkConfig

      -- * Requests / Responses
    , APIResponse (..)
    , APIError (..)
    , runApi
    , raiseAPIError

      -- ** Get Stake Accounts
    , getAccountStakes
    , StakingAccounts (..)
    , StakingAccount (..)

      -- ** Get Staking Rewards
    , getAllStakeRewards
    , getYearsStakeRewards
    , getStakeRewards
    , StakeReward (..)

      -- ** Get Block
    , getBlock
    , Block (..)

      -- * General API Types
    , Lamports (..)
    , renderLamports
    , scientificLamports
    , StakingPubKey (..)
    ) where

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 Data.ByteString.Lazy qualified as LBS
import Data.Text qualified as T


-- | Solana Beach API Configuration
data Config = Config
    { Config -> Text
cApiKey :: T.Text
    -- ^ Your API Key.
    -- Get one here: https://github.com/solana-beach/api
    , Config -> Text
cAccountPubKey :: T.Text
    -- ^ TODO: probably drop this when solana-beach-api is extracted to
    -- separate package.
    }
    deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Config
readsPrec :: Int -> ReadS Config
$creadList :: ReadS [Config]
readList :: ReadS [Config]
$creadPrec :: ReadPrec Config
readPrec :: ReadPrec Config
$creadListPrec :: ReadPrec [Config]
readListPrec :: ReadPrec [Config]
Read, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq)


-- | Create a program config from the API key & the target account's
-- pubkey.
mkConfig :: String -> String -> Config
mkConfig :: String -> String -> Config
mkConfig (String -> Text
T.pack -> Text
cApiKey) (String -> Text
T.pack -> Text
cAccountPubKey) = Config {Text
cApiKey :: Text
cAccountPubKey :: Text
cApiKey :: Text
cAccountPubKey :: Text
..}


-- | Base URL to Solana Beach's API
baseUrl :: Url 'Https
baseUrl :: Url 'Https
baseUrl = Text -> Url 'Https
https Text
"api.solanabeach.io" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"v1"


-- | Get the staking accounts for the 'cAccountPubKey'.
getAccountStakes
    :: (MonadReader Config m, MonadCatch m, MonadIO m)
    => m (APIResponse StakingAccounts)
getAccountStakes :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
m (APIResponse StakingAccounts)
getAccountStakes = do
    Text
pubkey <- (Config -> Text) -> m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Text
cAccountPubKey
    Url 'Https -> Option 'Https -> m (APIResponse StakingAccounts)
forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"account" Url 'Https -> Text -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Text
pubkey Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"stakes") Option 'Https
forall a. Monoid a => a
mempty


-- | Single Result Page of Staking Accounts Query.
data StakingAccounts = StakingAccounts
    { StakingAccounts -> [StakingAccount]
saResults :: [StakingAccount]
    -- ^ The returned staking accounts
    , StakingAccounts -> Integer
saTotalPages :: Integer
    -- ^ The total number of pages for the Account's PubKey.
    }
    deriving (Int -> StakingAccounts -> ShowS
[StakingAccounts] -> ShowS
StakingAccounts -> String
(Int -> StakingAccounts -> ShowS)
-> (StakingAccounts -> String)
-> ([StakingAccounts] -> ShowS)
-> Show StakingAccounts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingAccounts -> ShowS
showsPrec :: Int -> StakingAccounts -> ShowS
$cshow :: StakingAccounts -> String
show :: StakingAccounts -> String
$cshowList :: [StakingAccounts] -> ShowS
showList :: [StakingAccounts] -> ShowS
Show, ReadPrec [StakingAccounts]
ReadPrec StakingAccounts
Int -> ReadS StakingAccounts
ReadS [StakingAccounts]
(Int -> ReadS StakingAccounts)
-> ReadS [StakingAccounts]
-> ReadPrec StakingAccounts
-> ReadPrec [StakingAccounts]
-> Read StakingAccounts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakingAccounts
readsPrec :: Int -> ReadS StakingAccounts
$creadList :: ReadS [StakingAccounts]
readList :: ReadS [StakingAccounts]
$creadPrec :: ReadPrec StakingAccounts
readPrec :: ReadPrec StakingAccounts
$creadListPrec :: ReadPrec [StakingAccounts]
readListPrec :: ReadPrec [StakingAccounts]
Read, StakingAccounts -> StakingAccounts -> Bool
(StakingAccounts -> StakingAccounts -> Bool)
-> (StakingAccounts -> StakingAccounts -> Bool)
-> Eq StakingAccounts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingAccounts -> StakingAccounts -> Bool
== :: StakingAccounts -> StakingAccounts -> Bool
$c/= :: StakingAccounts -> StakingAccounts -> Bool
/= :: StakingAccounts -> StakingAccounts -> Bool
Eq, (forall x. StakingAccounts -> Rep StakingAccounts x)
-> (forall x. Rep StakingAccounts x -> StakingAccounts)
-> Generic StakingAccounts
forall x. Rep StakingAccounts x -> StakingAccounts
forall x. StakingAccounts -> Rep StakingAccounts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingAccounts -> Rep StakingAccounts x
from :: forall x. StakingAccounts -> Rep StakingAccounts x
$cto :: forall x. Rep StakingAccounts x -> StakingAccounts
to :: forall x. Rep StakingAccounts x -> StakingAccounts
Generic)


instance FromJSON StakingAccounts where
    parseJSON :: Value -> Parser StakingAccounts
parseJSON = String
-> (Object -> Parser StakingAccounts)
-> Value
-> Parser StakingAccounts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StakingAccounts" ((Object -> Parser StakingAccounts)
 -> Value -> Parser StakingAccounts)
-> (Object -> Parser StakingAccounts)
-> Value
-> Parser StakingAccounts
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [StakingAccount]
saResults <- Object
o Object -> Key -> Parser [StakingAccount]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
        Integer
saTotalPages <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"totalPages"
        StakingAccounts -> Parser StakingAccounts
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StakingAccounts {Integer
[StakingAccount]
saResults :: [StakingAccount]
saTotalPages :: Integer
saResults :: [StakingAccount]
saTotalPages :: Integer
..}


-- | A single Staking Account.
data StakingAccount = StakingAccount
    { StakingAccount -> StakingPubKey
saPubKey :: StakingPubKey
    -- ^ The Staking Accounts PubKey
    , StakingAccount -> Lamports
saLamports :: Lamports
    -- ^ The Balance of the Staking Account
    , StakingAccount -> Text
saValidatorName :: T.Text
    -- ^ The Name of the Staking Account's Validator
    }
    deriving (Int -> StakingAccount -> ShowS
[StakingAccount] -> ShowS
StakingAccount -> String
(Int -> StakingAccount -> ShowS)
-> (StakingAccount -> String)
-> ([StakingAccount] -> ShowS)
-> Show StakingAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingAccount -> ShowS
showsPrec :: Int -> StakingAccount -> ShowS
$cshow :: StakingAccount -> String
show :: StakingAccount -> String
$cshowList :: [StakingAccount] -> ShowS
showList :: [StakingAccount] -> ShowS
Show, ReadPrec [StakingAccount]
ReadPrec StakingAccount
Int -> ReadS StakingAccount
ReadS [StakingAccount]
(Int -> ReadS StakingAccount)
-> ReadS [StakingAccount]
-> ReadPrec StakingAccount
-> ReadPrec [StakingAccount]
-> Read StakingAccount
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakingAccount
readsPrec :: Int -> ReadS StakingAccount
$creadList :: ReadS [StakingAccount]
readList :: ReadS [StakingAccount]
$creadPrec :: ReadPrec StakingAccount
readPrec :: ReadPrec StakingAccount
$creadListPrec :: ReadPrec [StakingAccount]
readListPrec :: ReadPrec [StakingAccount]
Read, StakingAccount -> StakingAccount -> Bool
(StakingAccount -> StakingAccount -> Bool)
-> (StakingAccount -> StakingAccount -> Bool) -> Eq StakingAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingAccount -> StakingAccount -> Bool
== :: StakingAccount -> StakingAccount -> Bool
$c/= :: StakingAccount -> StakingAccount -> Bool
/= :: StakingAccount -> StakingAccount -> Bool
Eq, (forall x. StakingAccount -> Rep StakingAccount x)
-> (forall x. Rep StakingAccount x -> StakingAccount)
-> Generic StakingAccount
forall x. Rep StakingAccount x -> StakingAccount
forall x. StakingAccount -> Rep StakingAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingAccount -> Rep StakingAccount x
from :: forall x. StakingAccount -> Rep StakingAccount x
$cto :: forall x. Rep StakingAccount x -> StakingAccount
to :: forall x. Rep StakingAccount x -> StakingAccount
Generic)


instance FromJSON StakingAccount where
    parseJSON :: Value -> Parser StakingAccount
parseJSON = String
-> (Object -> Parser StakingAccount)
-> Value
-> Parser StakingAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StakingAccount" ((Object -> Parser StakingAccount)
 -> Value -> Parser StakingAccount)
-> (Object -> Parser StakingAccount)
-> Value
-> Parser StakingAccount
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        StakingPubKey
saPubKey <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pubkey" Parser Object
-> (Object -> Parser StakingPubKey) -> Parser StakingPubKey
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser StakingPubKey
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address")
        Lamports
saLamports <- Object
o Object -> Key -> Parser Lamports
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lamports"
        Text
saValidatorName <-
            Object
o
                Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser Object -> (Object -> Parser Object) -> Parser Object
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake")
                Parser Object -> (Object -> Parser Object) -> Parser Object
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delegation")
                Parser Object -> (Object -> Parser Object) -> Parser Object
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"validatorInfo")
                Parser Object -> (Object -> Parser Text) -> Parser Text
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
        StakingAccount -> Parser StakingAccount
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StakingAccount {Text
Lamports
StakingPubKey
saPubKey :: StakingPubKey
saLamports :: Lamports
saValidatorName :: Text
saPubKey :: StakingPubKey
saLamports :: Lamports
saValidatorName :: Text
..}


-- | A PubKey for a Staking Account.
newtype StakingPubKey = StakingPubKey {StakingPubKey -> Text
fromStakingPubKey :: T.Text}
    deriving (Int -> StakingPubKey -> ShowS
[StakingPubKey] -> ShowS
StakingPubKey -> String
(Int -> StakingPubKey -> ShowS)
-> (StakingPubKey -> String)
-> ([StakingPubKey] -> ShowS)
-> Show StakingPubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakingPubKey -> ShowS
showsPrec :: Int -> StakingPubKey -> ShowS
$cshow :: StakingPubKey -> String
show :: StakingPubKey -> String
$cshowList :: [StakingPubKey] -> ShowS
showList :: [StakingPubKey] -> ShowS
Show, ReadPrec [StakingPubKey]
ReadPrec StakingPubKey
Int -> ReadS StakingPubKey
ReadS [StakingPubKey]
(Int -> ReadS StakingPubKey)
-> ReadS [StakingPubKey]
-> ReadPrec StakingPubKey
-> ReadPrec [StakingPubKey]
-> Read StakingPubKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakingPubKey
readsPrec :: Int -> ReadS StakingPubKey
$creadList :: ReadS [StakingPubKey]
readList :: ReadS [StakingPubKey]
$creadPrec :: ReadPrec StakingPubKey
readPrec :: ReadPrec StakingPubKey
$creadListPrec :: ReadPrec [StakingPubKey]
readListPrec :: ReadPrec [StakingPubKey]
Read, StakingPubKey -> StakingPubKey -> Bool
(StakingPubKey -> StakingPubKey -> Bool)
-> (StakingPubKey -> StakingPubKey -> Bool) -> Eq StakingPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakingPubKey -> StakingPubKey -> Bool
== :: StakingPubKey -> StakingPubKey -> Bool
$c/= :: StakingPubKey -> StakingPubKey -> Bool
/= :: StakingPubKey -> StakingPubKey -> Bool
Eq, (forall x. StakingPubKey -> Rep StakingPubKey x)
-> (forall x. Rep StakingPubKey x -> StakingPubKey)
-> Generic StakingPubKey
forall x. Rep StakingPubKey x -> StakingPubKey
forall x. StakingPubKey -> Rep StakingPubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakingPubKey -> Rep StakingPubKey x
from :: forall x. StakingPubKey -> Rep StakingPubKey x
$cto :: forall x. Rep StakingPubKey x -> StakingPubKey
to :: forall x. Rep StakingPubKey x -> StakingPubKey
Generic, Maybe StakingPubKey
Value -> Parser [StakingPubKey]
Value -> Parser StakingPubKey
(Value -> Parser StakingPubKey)
-> (Value -> Parser [StakingPubKey])
-> Maybe StakingPubKey
-> FromJSON StakingPubKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StakingPubKey
parseJSON :: Value -> Parser StakingPubKey
$cparseJSONList :: Value -> Parser [StakingPubKey]
parseJSONList :: Value -> Parser [StakingPubKey]
$comittedField :: Maybe StakingPubKey
omittedField :: Maybe StakingPubKey
FromJSON)


-- | An amount of Lamports, each of which represent 0.000000001 SOL.
newtype Lamports = Lamports {Lamports -> Integer
fromLamports :: Integer}
    deriving (Int -> Lamports -> ShowS
[Lamports] -> ShowS
Lamports -> String
(Int -> Lamports -> ShowS)
-> (Lamports -> String) -> ([Lamports] -> ShowS) -> Show Lamports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lamports -> ShowS
showsPrec :: Int -> Lamports -> ShowS
$cshow :: Lamports -> String
show :: Lamports -> String
$cshowList :: [Lamports] -> ShowS
showList :: [Lamports] -> ShowS
Show, ReadPrec [Lamports]
ReadPrec Lamports
Int -> ReadS Lamports
ReadS [Lamports]
(Int -> ReadS Lamports)
-> ReadS [Lamports]
-> ReadPrec Lamports
-> ReadPrec [Lamports]
-> Read Lamports
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Lamports
readsPrec :: Int -> ReadS Lamports
$creadList :: ReadS [Lamports]
readList :: ReadS [Lamports]
$creadPrec :: ReadPrec Lamports
readPrec :: ReadPrec Lamports
$creadListPrec :: ReadPrec [Lamports]
readListPrec :: ReadPrec [Lamports]
Read, Lamports -> Lamports -> Bool
(Lamports -> Lamports -> Bool)
-> (Lamports -> Lamports -> Bool) -> Eq Lamports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lamports -> Lamports -> Bool
== :: Lamports -> Lamports -> Bool
$c/= :: Lamports -> Lamports -> Bool
/= :: Lamports -> Lamports -> Bool
Eq, Integer -> Lamports
Lamports -> Lamports
Lamports -> Lamports -> Lamports
(Lamports -> Lamports -> Lamports)
-> (Lamports -> Lamports -> Lamports)
-> (Lamports -> Lamports -> Lamports)
-> (Lamports -> Lamports)
-> (Lamports -> Lamports)
-> (Lamports -> Lamports)
-> (Integer -> Lamports)
-> Num Lamports
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Lamports -> Lamports -> Lamports
+ :: Lamports -> Lamports -> Lamports
$c- :: Lamports -> Lamports -> Lamports
- :: Lamports -> Lamports -> Lamports
$c* :: Lamports -> Lamports -> Lamports
* :: Lamports -> Lamports -> Lamports
$cnegate :: Lamports -> Lamports
negate :: Lamports -> Lamports
$cabs :: Lamports -> Lamports
abs :: Lamports -> Lamports
$csignum :: Lamports -> Lamports
signum :: Lamports -> Lamports
$cfromInteger :: Integer -> Lamports
fromInteger :: Integer -> Lamports
Num, (forall x. Lamports -> Rep Lamports x)
-> (forall x. Rep Lamports x -> Lamports) -> Generic Lamports
forall x. Rep Lamports x -> Lamports
forall x. Lamports -> Rep Lamports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Lamports -> Rep Lamports x
from :: forall x. Lamports -> Rep Lamports x
$cto :: forall x. Rep Lamports x -> Lamports
to :: forall x. Rep Lamports x -> Lamports
Generic, Maybe Lamports
Value -> Parser [Lamports]
Value -> Parser Lamports
(Value -> Parser Lamports)
-> (Value -> Parser [Lamports])
-> Maybe Lamports
-> FromJSON Lamports
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Lamports
parseJSON :: Value -> Parser Lamports
$cparseJSONList :: Value -> Parser [Lamports]
parseJSONList :: Value -> Parser [Lamports]
$comittedField :: Maybe Lamports
omittedField :: Maybe Lamports
FromJSON)


-- | Render an amount of 'Lamports' as text, converting it to SOL.
renderLamports :: Lamports -> T.Text
renderLamports :: Lamports -> Text
renderLamports = String -> Text
T.pack (String -> Text) -> (Lamports -> String) -> Lamports -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
9) (Scientific -> String)
-> (Lamports -> Scientific) -> Lamports -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lamports -> Scientific
scientificLamports


-- | Convert Lamports into Scientific representation of SOL.
scientificLamports :: Lamports -> Scientific
scientificLamports :: Lamports -> Scientific
scientificLamports = (Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
0.000000001) (Scientific -> Scientific)
-> (Lamports -> Scientific) -> Lamports -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific)
-> (Lamports -> Integer) -> Lamports -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lamports -> Integer
fromLamports


-- | Get the staking rewards with a staking account's pubkey.
getStakeRewards
    :: (MonadReader Config m, MonadCatch m, MonadIO m)
    => StakingPubKey
    -> Maybe Integer
    -> m (APIResponse [StakeReward])
getStakeRewards :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards (StakingPubKey Text
stakeAccountPubkey) Maybe Integer
mbEpochCursor = do
    Url 'Https -> Option 'Https -> m (APIResponse [StakeReward])
forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq
        (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"account" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
stakeAccountPubkey Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"stake-rewards")
        (Text -> Maybe Integer -> Option 'Https
forall a. ToHttpApiData a => Text -> Maybe a -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
"cursor" Maybe Integer
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
    :: (MonadReader Config m, MonadCatch m, MonadIO m)
    => StakingPubKey
    -> m ([APIError], [StakeReward])
getAllStakeRewards :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> m ([APIError], [StakeReward])
getAllStakeRewards StakingPubKey
pubkey =
    StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards StakingPubKey
pubkey Maybe Integer
forall a. Maybe a
Nothing
        m (APIResponse [StakeReward])
-> (APIResponse [StakeReward] -> m (Either APIError [StakeReward]))
-> m (Either APIError [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APIResponse [StakeReward] -> m (Either APIError [StakeReward])
forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi
        m (Either APIError [StakeReward])
-> (Either APIError [StakeReward] -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil
            StakingPubKey
pubkey
            (Bool -> [StakeReward] -> Bool
forall a b. a -> b -> a
const Bool
True)
            ([], [])


-- | Get the year's worth of staking rewards for the given account.
getYearsStakeRewards
    :: (MonadReader Config m, MonadCatch m, MonadIO m)
    => StakingPubKey
    -> Integer
    -> m ([APIError], [StakeReward])
getYearsStakeRewards :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Integer -> m ([APIError], [StakeReward])
getYearsStakeRewards StakingPubKey
pubkey Integer
year =
    (([APIError], [StakeReward]) -> ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([StakeReward] -> [StakeReward])
-> ([APIError], [StakeReward]) -> ([APIError], [StakeReward])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([StakeReward] -> [StakeReward])
 -> ([APIError], [StakeReward]) -> ([APIError], [StakeReward]))
-> ([StakeReward] -> [StakeReward])
-> ([APIError], [StakeReward])
-> ([APIError], [StakeReward])
forall a b. (a -> b) -> a -> b
$ (StakeReward -> Bool) -> [StakeReward] -> [StakeReward]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
year) (Integer -> Bool)
-> (StakeReward -> Integer) -> StakeReward -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeReward -> Integer
rewardYear)) (m ([APIError], [StakeReward]) -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a b. (a -> b) -> a -> b
$
        StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards StakingPubKey
pubkey Maybe Integer
forall a. Maybe a
Nothing
            m (APIResponse [StakeReward])
-> (APIResponse [StakeReward] -> m (Either APIError [StakeReward]))
-> m (Either APIError [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APIResponse [StakeReward] -> m (Either APIError [StakeReward])
forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi
            m (Either APIError [StakeReward])
-> (Either APIError [StakeReward] -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil StakingPubKey
pubkey [StakeReward] -> Bool
stopAfterYear ([], [])
  where
    rewardYear :: StakeReward -> Integer
    rewardYear :: StakeReward -> Integer
rewardYear =
        (\(Integer
y, Int
_, Int
_) -> Integer
y)
            ((Integer, Int, Int) -> Integer)
-> (StakeReward -> (Integer, Int, Int)) -> StakeReward -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
            (Day -> (Integer, Int, Int))
-> (StakeReward -> Day) -> StakeReward -> (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay
            (UTCTime -> Day) -> (StakeReward -> UTCTime) -> StakeReward -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
            (POSIXTime -> UTCTime)
-> (StakeReward -> POSIXTime) -> StakeReward -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeReward -> POSIXTime
srTimestamp

    stopAfterYear :: [StakeReward] -> Bool
    stopAfterYear :: [StakeReward] -> Bool
stopAfterYear [StakeReward]
rewards =
        let years :: [Integer]
years = (StakeReward -> Integer) -> [StakeReward] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map StakeReward -> Integer
rewardYear [StakeReward]
rewards in (Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
year) [Integer]
years


-- | Fetch staking rewards until we get less than 5 rewards or the general
-- predicate returns true.
getStakeRewardsUntil
    :: (MonadReader Config m, MonadCatch m, MonadIO m)
    => StakingPubKey
    -> ([StakeReward] -> Bool)
    -> ([APIError], [StakeReward])
    -> Either APIError [StakeReward]
    -> m ([APIError], [StakeReward])
getStakeRewardsUntil :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil StakingPubKey
pubkey [StakeReward] -> Bool
cond ([APIError]
errs, [StakeReward]
rws) = \case
    Left APIError
err -> ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIError
err APIError -> [APIError] -> [APIError]
forall a. a -> [a] -> [a]
: [APIError]
errs, [StakeReward]
rws)
    Right [StakeReward]
rewards ->
        if [StakeReward] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StakeReward]
rewards Bool -> Bool -> Bool
|| [StakeReward] -> Bool
cond [StakeReward]
rewards
            then ([APIError], [StakeReward]) -> m ([APIError], [StakeReward])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([APIError]
errs, [StakeReward]
rewards [StakeReward] -> [StakeReward] -> [StakeReward]
forall a. Semigroup a => a -> a -> a
<> [StakeReward]
rws)
            else
                let minEpoch :: Integer
minEpoch = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (StakeReward -> Integer) -> [StakeReward] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map StakeReward -> Integer
srEpoch [StakeReward]
rewards
                 in StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey -> Maybe Integer -> m (APIResponse [StakeReward])
getStakeRewards StakingPubKey
pubkey (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
minEpoch)
                        m (APIResponse [StakeReward])
-> (APIResponse [StakeReward] -> m (Either APIError [StakeReward]))
-> m (Either APIError [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APIResponse [StakeReward] -> m (Either APIError [StakeReward])
forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi
                        m (Either APIError [StakeReward])
-> (Either APIError [StakeReward] -> m ([APIError], [StakeReward]))
-> m ([APIError], [StakeReward])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
StakingPubKey
-> ([StakeReward] -> Bool)
-> ([APIError], [StakeReward])
-> Either APIError [StakeReward]
-> m ([APIError], [StakeReward])
getStakeRewardsUntil StakingPubKey
pubkey [StakeReward] -> Bool
cond ([APIError]
errs, [StakeReward]
rewards [StakeReward] -> [StakeReward] -> [StakeReward]
forall a. Semigroup a => a -> a -> a
<> [StakeReward]
rws)


-- | A Staking Reward Payment.
data StakeReward = StakeReward
    { StakeReward -> Integer
srEpoch :: Integer
    -- ^ The Epoch the reward was paid.
    , StakeReward -> Integer
srSlot :: Integer
    -- ^ The 'Block' number of the reward.
    , StakeReward -> Lamports
srAmount :: Lamports
    -- ^ The total number of 'Lamports' awarded.
    , StakeReward -> POSIXTime
srTimestamp :: POSIXTime
    }
    deriving (Int -> StakeReward -> ShowS
[StakeReward] -> ShowS
StakeReward -> String
(Int -> StakeReward -> ShowS)
-> (StakeReward -> String)
-> ([StakeReward] -> ShowS)
-> Show StakeReward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakeReward -> ShowS
showsPrec :: Int -> StakeReward -> ShowS
$cshow :: StakeReward -> String
show :: StakeReward -> String
$cshowList :: [StakeReward] -> ShowS
showList :: [StakeReward] -> ShowS
Show, ReadPrec [StakeReward]
ReadPrec StakeReward
Int -> ReadS StakeReward
ReadS [StakeReward]
(Int -> ReadS StakeReward)
-> ReadS [StakeReward]
-> ReadPrec StakeReward
-> ReadPrec [StakeReward]
-> Read StakeReward
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StakeReward
readsPrec :: Int -> ReadS StakeReward
$creadList :: ReadS [StakeReward]
readList :: ReadS [StakeReward]
$creadPrec :: ReadPrec StakeReward
readPrec :: ReadPrec StakeReward
$creadListPrec :: ReadPrec [StakeReward]
readListPrec :: ReadPrec [StakeReward]
Read, StakeReward -> StakeReward -> Bool
(StakeReward -> StakeReward -> Bool)
-> (StakeReward -> StakeReward -> Bool) -> Eq StakeReward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakeReward -> StakeReward -> Bool
== :: StakeReward -> StakeReward -> Bool
$c/= :: StakeReward -> StakeReward -> Bool
/= :: StakeReward -> StakeReward -> Bool
Eq, (forall x. StakeReward -> Rep StakeReward x)
-> (forall x. Rep StakeReward x -> StakeReward)
-> Generic StakeReward
forall x. Rep StakeReward x -> StakeReward
forall x. StakeReward -> Rep StakeReward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakeReward -> Rep StakeReward x
from :: forall x. StakeReward -> Rep StakeReward x
$cto :: forall x. Rep StakeReward x -> StakeReward
to :: forall x. Rep StakeReward x -> StakeReward
Generic)


instance FromJSON StakeReward where
    parseJSON :: Value -> Parser StakeReward
parseJSON = String
-> (Object -> Parser StakeReward) -> Value -> Parser StakeReward
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StakeReward" ((Object -> Parser StakeReward) -> Value -> Parser StakeReward)
-> (Object -> Parser StakeReward) -> Value -> Parser StakeReward
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
srEpoch <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"epoch"
        Integer
srSlot <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"effectiveSlot"
        Lamports
srAmount <- Object
o Object -> Key -> Parser Lamports
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
        POSIXTime
srTimestamp <- Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
        StakeReward -> Parser StakeReward
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StakeReward {Integer
POSIXTime
Lamports
srTimestamp :: POSIXTime
srEpoch :: Integer
srSlot :: Integer
srAmount :: Lamports
srEpoch :: Integer
srSlot :: Integer
srAmount :: Lamports
srTimestamp :: POSIXTime
..}


-- | Get information about a specific block number.
getBlock
    :: (MonadReader Config m, MonadCatch m, MonadIO m)
    => Integer
    -> m (APIResponse Block)
getBlock :: forall (m :: * -> *).
(MonadReader Config m, MonadCatch m, MonadIO m) =>
Integer -> m (APIResponse Block)
getBlock Integer
blockNum = do
    Url 'Https -> Option 'Https -> m (APIResponse Block)
forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"block" Url 'Https -> Integer -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Integer
blockNum) Option 'Https
forall a. Monoid a => a
mempty


-- | A single block on the Solana blockchain.
data Block = Block
    { Block -> Integer
bNumber :: Integer
    -- ^ The blocks number.
    , Block -> POSIXTime
bBlockTime :: POSIXTime
    -- ^ The blocks absolute timestamp.
    }
    deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show, ReadPrec [Block]
ReadPrec Block
Int -> ReadS Block
ReadS [Block]
(Int -> ReadS Block)
-> ReadS [Block]
-> ReadPrec Block
-> ReadPrec [Block]
-> Read Block
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Block
readsPrec :: Int -> ReadS Block
$creadList :: ReadS [Block]
readList :: ReadS [Block]
$creadPrec :: ReadPrec Block
readPrec :: ReadPrec Block
$creadListPrec :: ReadPrec [Block]
readListPrec :: ReadPrec [Block]
Read, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Block -> Rep Block x
from :: forall x. Block -> Rep Block x
$cto :: forall x. Rep Block x -> Block
to :: forall x. Rep Block x -> Block
Generic)


instance FromJSON Block where
    parseJSON :: Value -> Parser Block
parseJSON = String -> (Object -> Parser Block) -> Value -> Parser Block
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Block" ((Object -> Parser Block) -> Value -> Parser Block)
-> (Object -> Parser Block) -> Value -> Parser Block
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
bNumber <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocknumber"
        POSIXTime
bBlockTime <-
            (Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocktime")
                Parser Object -> (Object -> Parser POSIXTime) -> Parser POSIXTime
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Scientific -> POSIXTime) -> Parser Scientific -> Parser POSIXTime
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> POSIXTime)
-> (Scientific -> Integer) -> Scientific -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate @Scientific))
                    (Parser Scientific -> Parser POSIXTime)
-> (Object -> Parser Scientific) -> Object -> Parser POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"absolute")
        Block -> Parser Block
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Block {Integer
POSIXTime
bNumber :: Integer
bBlockTime :: POSIXTime
bNumber :: Integer
bBlockTime :: POSIXTime
..}


-- | Generic GET request to the Solana Beach API with up to 5 retries for
-- @ProcessingResponse@.
--
-- Note: Prints to 'stderr' when waiting for request to finish processing.
getReq
    :: forall m a
     . (MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m)
    => Url 'Https
    -> Option 'Https
    -> m (APIResponse a)
getReq :: forall (m :: * -> *) a.
(MonadReader Config m, FromJSON a, MonadIO m, MonadCatch m) =>
Url 'Https -> Option 'Https -> m (APIResponse a)
getReq Url 'Https
endpoint Option 'Https
options = Integer -> m (APIResponse a)
fetchWithRetries Integer
0
  where
    maxRetries :: Integer
    maxRetries :: Integer
maxRetries = Integer
5
    fetchWithRetries :: Integer -> m (APIResponse a)
    fetchWithRetries :: Integer -> m (APIResponse a)
fetchWithRetries Integer
retryCount =
        if Integer
retryCount Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
maxRetries
            then APIResponse a -> m (APIResponse a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResponse a -> m (APIResponse a))
-> APIResponse a -> m (APIResponse a)
forall a b. (a -> b) -> a -> b
$ APIError -> APIResponse a
forall a. APIError -> APIResponse a
ErrorResponse (APIError -> APIResponse a) -> APIError -> APIResponse a
forall a b. (a -> b) -> a -> b
$ Text -> APIError
RetriesExceeded (Text -> APIError) -> Text -> APIError
forall a b. (a -> b) -> a -> b
$ Url 'Https -> Text
forall (scheme :: Scheme). Url scheme -> Text
renderUrl Url 'Https
endpoint
            else do
                Text
apikey <- (Config -> Text) -> m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Text
cApiKey
                let authHeader :: Option scheme
authHeader =
                        ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Authorization" (ByteString -> Option scheme) -> ByteString -> Option scheme
forall a b. (a -> b) -> a -> b
$ ByteString
"Bearer: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
apikey
                APIResponse a
respBody <-
                    m (JsonResponse (APIResponse a))
-> m (HttpResponseBody (JsonResponse (APIResponse a)))
forall b.
(FromJSON (HttpResponseBody b), HttpResponse b) =>
m b -> m (HttpResponseBody b)
catchRateLimitError (m (JsonResponse (APIResponse a))
 -> m (HttpResponseBody (JsonResponse (APIResponse a))))
-> m (JsonResponse (APIResponse a))
-> m (HttpResponseBody (JsonResponse (APIResponse a)))
forall a b. (a -> b) -> a -> b
$
                        HttpConfig
-> Req (JsonResponse (APIResponse a))
-> m (JsonResponse (APIResponse a))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq
                            HttpConfig
defaultHttpConfig
                            ( GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse (APIResponse a))
-> Option 'Https
-> Req (JsonResponse (APIResponse a))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
endpoint NoReqBody
NoReqBody Proxy (JsonResponse (APIResponse a))
forall a. Proxy (JsonResponse a)
jsonResponse (Option 'Https -> Req (JsonResponse (APIResponse a)))
-> Option 'Https -> Req (JsonResponse (APIResponse a))
forall a b. (a -> b) -> a -> b
$ Option 'Https
forall {scheme :: Scheme}. Option scheme
authHeader Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Option 'Https
options
                            )
                case APIResponse a
respBody of
                    APIResponse a
ProcessingResponse -> do
                        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                            Handle -> String -> IO ()
hPutStrLn
                                Handle
stderr
                                String
"Waiting for API to finish processing request..."
                        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
                        Integer -> m (APIResponse a)
fetchWithRetries (Integer
retryCount Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
                    RateLimitResponse Int
wait -> do
                        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                            Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                                String
"Exceeded rate limit, waiting "
                                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
wait
                                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" seconds before retrying..."
                        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
wait Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
                        Integer -> m (APIResponse a)
fetchWithRetries Integer
retryCount
                    APIResponse a
_ -> APIResponse a -> m (APIResponse a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return APIResponse a
respBody
    catchRateLimitError
        :: (FromJSON (HttpResponseBody b))
        => (HttpResponse b)
        => m b
        -> m (HttpResponseBody b)
    catchRateLimitError :: forall b.
(FromJSON (HttpResponseBody b), HttpResponse b) =>
m b -> m (HttpResponseBody b)
catchRateLimitError =
        m b -> m (Either HttpException b)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either HttpException b))
-> (Either HttpException b -> m (HttpResponseBody b))
-> m b
-> m (HttpResponseBody b)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
            Left e :: HttpException
e@(VanillaHttpException (HttpExceptionRequest Request
_ (StatusCodeException Response ()
resp ByteString
body))) ->
                if Status -> Int
statusCode (Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
resp) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
429
                    then
                        (String -> m (HttpResponseBody b))
-> (HttpResponseBody b -> m (HttpResponseBody b))
-> Either String (HttpResponseBody b)
-> m (HttpResponseBody b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponseBody b) -> m (HttpResponseBody b))
-> (String -> IO (HttpResponseBody b))
-> String
-> m (HttpResponseBody b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> IO (HttpResponseBody b)
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO (HttpResponseBody b))
-> (String -> HttpException) -> String -> IO (HttpResponseBody b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HttpException
JsonHttpException) HttpResponseBody b -> m (HttpResponseBody b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (HttpResponseBody b) -> m (HttpResponseBody b))
-> Either String (HttpResponseBody b) -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$
                            ByteString -> Either String (HttpResponseBody b)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (HttpResponseBody b))
-> ByteString -> Either String (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$
                                ByteString -> ByteString
LBS.fromStrict ByteString
body
                    else IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponseBody b) -> m (HttpResponseBody b))
-> IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$ HttpException -> IO (HttpResponseBody b)
forall e a. Exception e => e -> IO a
throwIO HttpException
e
            Left HttpException
e -> IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HttpResponseBody b) -> m (HttpResponseBody b))
-> IO (HttpResponseBody b) -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$ HttpException -> IO (HttpResponseBody b)
forall e a. Exception e => e -> IO a
throwIO HttpException
e
            Right b
r -> HttpResponseBody b -> m (HttpResponseBody b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponseBody b -> m (HttpResponseBody b))
-> HttpResponseBody b -> m (HttpResponseBody b)
forall a b. (a -> b) -> a -> b
$ b -> HttpResponseBody b
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody b
r


-- | Wrapper around error & processing responses from the API.
data APIResponse a
    = SuccessfulReponse a
    | ProcessingResponse
    | RateLimitResponse Int
    | ErrorResponse APIError
    deriving (Int -> APIResponse a -> ShowS
[APIResponse a] -> ShowS
APIResponse a -> String
(Int -> APIResponse a -> ShowS)
-> (APIResponse a -> String)
-> ([APIResponse a] -> ShowS)
-> Show (APIResponse a)
forall a. Show a => Int -> APIResponse a -> ShowS
forall a. Show a => [APIResponse a] -> ShowS
forall a. Show a => APIResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> APIResponse a -> ShowS
showsPrec :: Int -> APIResponse a -> ShowS
$cshow :: forall a. Show a => APIResponse a -> String
show :: APIResponse a -> String
$cshowList :: forall a. Show a => [APIResponse a] -> ShowS
showList :: [APIResponse a] -> ShowS
Show, ReadPrec [APIResponse a]
ReadPrec (APIResponse a)
Int -> ReadS (APIResponse a)
ReadS [APIResponse a]
(Int -> ReadS (APIResponse a))
-> ReadS [APIResponse a]
-> ReadPrec (APIResponse a)
-> ReadPrec [APIResponse a]
-> Read (APIResponse a)
forall a. Read a => ReadPrec [APIResponse a]
forall a. Read a => ReadPrec (APIResponse a)
forall a. Read a => Int -> ReadS (APIResponse a)
forall a. Read a => ReadS [APIResponse a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (APIResponse a)
readsPrec :: Int -> ReadS (APIResponse a)
$creadList :: forall a. Read a => ReadS [APIResponse a]
readList :: ReadS [APIResponse a]
$creadPrec :: forall a. Read a => ReadPrec (APIResponse a)
readPrec :: ReadPrec (APIResponse a)
$creadListPrec :: forall a. Read a => ReadPrec [APIResponse a]
readListPrec :: ReadPrec [APIResponse a]
Read, APIResponse a -> APIResponse a -> Bool
(APIResponse a -> APIResponse a -> Bool)
-> (APIResponse a -> APIResponse a -> Bool) -> Eq (APIResponse a)
forall a. Eq a => APIResponse a -> APIResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => APIResponse a -> APIResponse a -> Bool
== :: APIResponse a -> APIResponse a -> Bool
$c/= :: forall a. Eq a => APIResponse a -> APIResponse a -> Bool
/= :: APIResponse a -> APIResponse a -> Bool
Eq)


-- | Attempts to parse a processing response, then an error response,
-- & finally the inner @a@ response.
instance (FromJSON a) => FromJSON (APIResponse a) where
    parseJSON :: Value -> Parser (APIResponse a)
parseJSON Value
v = case Value
v of
        Object Object
o -> do
            Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"err" Parser (Maybe Text)
-> (Maybe Text -> Parser (APIResponse a)) -> Parser (APIResponse a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Text
errMsg ->
                    Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"processing" Parser (Maybe Bool)
-> (Maybe Bool -> Parser (APIResponse a)) -> Parser (APIResponse a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Maybe Bool
Nothing ->
                            Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry" Parser (Maybe String)
-> (Maybe String -> Parser (APIResponse a))
-> Parser (APIResponse a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                Just (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
i) ->
                                    APIResponse a -> Parser (APIResponse a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResponse a -> Parser (APIResponse a))
-> APIResponse a -> Parser (APIResponse a)
forall a b. (a -> b) -> a -> b
$ Int -> APIResponse a
forall a. Int -> APIResponse a
RateLimitResponse Int
i
                                Maybe String
_ -> APIResponse a -> Parser (APIResponse a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResponse a -> Parser (APIResponse a))
-> APIResponse a -> Parser (APIResponse a)
forall a b. (a -> b) -> a -> b
$ APIError -> APIResponse a
forall a. APIError -> APIResponse a
ErrorResponse (APIError -> APIResponse a) -> APIError -> APIResponse a
forall a b. (a -> b) -> a -> b
$ Text -> APIError
APIError Text
errMsg
                        Just (Bool
_ :: Bool) -> APIResponse a -> Parser (APIResponse a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return APIResponse a
forall a. APIResponse a
ProcessingResponse
                Maybe Text
Nothing -> (a -> APIResponse a) -> Parser a -> Parser (APIResponse a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> APIResponse a
forall a. a -> APIResponse a
SuccessfulReponse (Parser a -> Parser (APIResponse a))
-> (Value -> Parser a) -> Value -> Parser (APIResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (APIResponse a))
-> Value -> Parser (APIResponse a)
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
o
        Value
_ -> a -> APIResponse a
forall a. a -> APIResponse a
SuccessfulReponse (a -> APIResponse a) -> Parser a -> Parser (APIResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v


-- | Evaluate an API response.
runApi :: (Monad m) => APIResponse a -> m (Either APIError a)
runApi :: forall (m :: * -> *) a.
Monad m =>
APIResponse a -> m (Either APIError a)
runApi = ExceptT APIError m a -> m (Either APIError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT APIError m a -> m (Either APIError a))
-> (APIResponse a -> ExceptT APIError m a)
-> APIResponse a
-> m (Either APIError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APIResponse a -> ExceptT APIError m a
forall (m :: * -> *) a.
MonadError APIError m =>
APIResponse a -> m a
raiseAPIError


-- | Pull the inner value out of an 'APIResponse' or throw the respective
-- 'APIError'.
raiseAPIError :: (MonadError APIError m) => APIResponse a -> m a
raiseAPIError :: forall (m :: * -> *) a.
MonadError APIError m =>
APIResponse a -> m a
raiseAPIError = \case
    SuccessfulReponse a
v -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    APIResponse a
ProcessingResponse ->
        APIError -> m a
forall a. APIError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (APIError -> m a) -> APIError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> APIError
APIError Text
"Request cancelled during processing wait."
    RateLimitResponse Int
i -> APIError -> m a
forall a. APIError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (APIError -> m a) -> APIError -> m a
forall a b. (a -> b) -> a -> b
$ Int -> APIError
RateLimitError Int
i
    ErrorResponse APIError
err -> APIError -> m a
forall a. APIError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError APIError
err


-- | Potential error responses from the Solana Beach API.
data APIError
    = -- | Generic API error with message.
      APIError T.Text
    | -- | Exceeded maximum number of 'ProcessingResponse' retries.
      RetriesExceeded T.Text
    | -- | Rate limiting 429 error.
      RateLimitError Int
    deriving (Int -> APIError -> ShowS
[APIError] -> ShowS
APIError -> String
(Int -> APIError -> ShowS)
-> (APIError -> String) -> ([APIError] -> ShowS) -> Show APIError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIError -> ShowS
showsPrec :: Int -> APIError -> ShowS
$cshow :: APIError -> String
show :: APIError -> String
$cshowList :: [APIError] -> ShowS
showList :: [APIError] -> ShowS
Show, ReadPrec [APIError]
ReadPrec APIError
Int -> ReadS APIError
ReadS [APIError]
(Int -> ReadS APIError)
-> ReadS [APIError]
-> ReadPrec APIError
-> ReadPrec [APIError]
-> Read APIError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS APIError
readsPrec :: Int -> ReadS APIError
$creadList :: ReadS [APIError]
readList :: ReadS [APIError]
$creadPrec :: ReadPrec APIError
readPrec :: ReadPrec APIError
$creadListPrec :: ReadPrec [APIError]
readListPrec :: ReadPrec [APIError]
Read, APIError -> APIError -> Bool
(APIError -> APIError -> Bool)
-> (APIError -> APIError -> Bool) -> Eq APIError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIError -> APIError -> Bool
== :: APIError -> APIError -> Bool
$c/= :: APIError -> APIError -> Bool
/= :: APIError -> APIError -> Bool
Eq, (forall x. APIError -> Rep APIError x)
-> (forall x. Rep APIError x -> APIError) -> Generic APIError
forall x. Rep APIError x -> APIError
forall x. APIError -> Rep APIError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. APIError -> Rep APIError x
from :: forall x. APIError -> Rep APIError x
$cto :: forall x. Rep APIError x -> APIError
to :: forall x. Rep APIError x -> APIError
Generic)