{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE UnicodeSyntax       #-}

{- HLINT ignore "Redundant $" -}

module Polysemy.Blockfrost.Effect.Blockfrost where

import           Data.Either
import           Data.Function              (($))
import           Data.Maybe
import           Data.Text                  (Text)
import           Prelude                    (Integer)
import           System.IO                  (IO)

import           Blockfrost.Client          (BlockfrostError, Project)
import qualified Blockfrost.Client          as BF
import           Blockfrost.Types
import           Blockfrost.Util.Pagination
import           Blockfrost.Util.Sorting
import           Polysemy
import           Polysemy.Reader

data Blockfrost m a where

  -- Client
  GetRoot :: Blockfrost m (Either BlockfrostError URLVersion)
  GetHealth :: Blockfrost m (Either BlockfrostError Healthy)
  GetClock :: Blockfrost m (Either BlockfrostError ServerTime)
  GetMetrics :: Blockfrost m (Either BlockfrostError [Metric])
  GetMetricsEndpoints :: Blockfrost m (Either BlockfrostError [(Text, Metric)])

  -- Client.NutLink
  NutlinkListAddress :: Address -> Blockfrost m (Either BlockfrostError NutlinkAddress)
  NutlinkListAddressTickers' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [NutlinkAddressTicker])
  NutlinkListAddressTickers :: Address -> Blockfrost m (Either BlockfrostError [NutlinkAddressTicker])
  NutlinkAddressTickers' :: Address -> Text -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [NutlinkTicker])
  NutlinkAddressTickers :: Address -> Text -> Blockfrost m (Either BlockfrostError [NutlinkTicker])
  NutlinkTickers' :: Text -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [(Address, NutlinkTicker)])
  NutlinkTickers :: Text -> Blockfrost m (Either BlockfrostError [(Address, NutlinkTicker)])

  -- Client.IPFS
  IpfsGateway :: Text -> Blockfrost m (Either BlockfrostError IPFSData)
  IpfsPin :: Text -> Blockfrost m (Either BlockfrostError IPFSPinChange)
  IpfsListPins' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [IPFSPin])
  IpfsListPins :: Blockfrost m (Either BlockfrostError [IPFSPin])
  IpfsGetPin :: Text -> Blockfrost m (Either BlockfrostError IPFSPin)
  IpfsRemovePin :: Text -> Blockfrost m (Either BlockfrostError IPFSPinChange)

  -- Client.Cardano.Blocks
  GetLatestBlock :: Blockfrost m (Either BlockfrostError Block)
  GetLatestBlockTxs' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [TxHash])
  GetLatestBlockTxs :: Blockfrost m (Either BlockfrostError [TxHash])
  GetBlock :: Either Integer BlockHash -> Blockfrost m (Either BlockfrostError Block)
  GetBlockSlot :: Slot -> Blockfrost m (Either BlockfrostError Block)
  GetBlockEpochSlot :: Epoch -> Slot -> Blockfrost m (Either BlockfrostError Block)
  GetNextBlocks' :: Either Integer BlockHash -> Paged -> Blockfrost m (Either BlockfrostError [Block])
  GetNextBlocks :: Either Integer BlockHash -> Blockfrost m (Either BlockfrostError [Block])
  GetPreviousBlocks' :: Either Integer BlockHash -> Paged -> Blockfrost m (Either BlockfrostError [Block])
  GetPreviousBlocks :: Either Integer BlockHash -> Blockfrost m (Either BlockfrostError [Block])
  GetBlockTxs' :: Either Integer BlockHash -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [TxHash])
  GetBlockTxs :: Either Integer BlockHash -> Blockfrost m (Either BlockfrostError [TxHash])
  GetBlockAffectedAddresses' :: Either Integer BlockHash -> Paged -> Blockfrost m (Either BlockfrostError [(Address, [TxHash])])
  GetBlockAffectedAddresses :: Either Integer BlockHash -> Blockfrost m (Either BlockfrostError [(Address, [TxHash])])

  -- Client.Cardano.Network
  GetNetworkInfo :: Blockfrost m (Either BlockfrostError Network)
  GetNetworkEras :: Blockfrost m (Either BlockfrostError [NetworkEraSummary])

  -- Client.Cardano.Addresses
  GetAddressInfo :: Address -> Blockfrost m (Either BlockfrostError AddressInfo)
  GetAddressInfoExtended :: Address -> Blockfrost m (Either BlockfrostError AddressInfoExtended)
  GetAddressDetails :: Address -> Blockfrost m (Either BlockfrostError AddressDetails)
  GetAddressUtxos' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AddressUtxo])
  GetAddressUtxos :: Address -> Blockfrost m (Either BlockfrostError [AddressUtxo])
  GetAddressUtxosAsset' :: Address -> AssetId-> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AddressUtxo])
  GetAddressUtxosAsset :: Address -> AssetId -> Blockfrost m (Either BlockfrostError [AddressUtxo])
  GetAddressTransactions' :: Address -> Paged -> SortOrder -> Maybe BlockIndex -> Maybe BlockIndex -> Blockfrost m (Either BlockfrostError [AddressTransaction])
  GetAddressTransactions :: Address -> Blockfrost m (Either BlockfrostError [AddressTransaction])

  -- Client.Cardano.Assets
  GetAssets' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AssetInfo])
  GetAssets :: Blockfrost m (Either BlockfrostError [AssetInfo])
  GetAssetDetails :: AssetId -> Blockfrost m (Either BlockfrostError AssetDetails)
  GetAssetHistory' :: AssetId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AssetHistory])
  GetAssetHistory :: AssetId -> Blockfrost m (Either BlockfrostError [AssetHistory])
  GetAssetTransactions' :: AssetId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AssetTransaction])
  GetAssetTransactions :: AssetId -> Blockfrost m (Either BlockfrostError [AssetTransaction])
  GetAssetAddresses' :: AssetId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AssetAddress])
  GetAssetAddresses :: AssetId -> Blockfrost m (Either BlockfrostError [AssetAddress])
  GetAssetsByPolicy' :: PolicyId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AssetInfo])
  GetAssetsByPolicy :: PolicyId -> Blockfrost m (Either BlockfrostError [AssetInfo])

  -- Client.Cardano.Scripts
  ListScripts' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError ScriptHashList)
  ListScripts :: Blockfrost m (Either BlockfrostError ScriptHashList)
  GetScript :: ScriptHash -> Blockfrost m (Either BlockfrostError Script)
  GetScriptRedeemers' :: ScriptHash -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [ScriptRedeemer])
  GetScriptRedeemers :: ScriptHash -> Blockfrost m (Either BlockfrostError [ScriptRedeemer])
  GetScriptDatum :: DatumHash -> Blockfrost m (Either BlockfrostError ScriptDatum)
  GetScriptDatumCBOR :: DatumHash -> Blockfrost m (Either BlockfrostError ScriptDatumCBOR)
  GetScriptJSON :: ScriptHash -> Blockfrost m (Either BlockfrostError ScriptJSON)
  GetScriptCBOR :: ScriptHash -> Blockfrost m (Either BlockfrostError ScriptCBOR)

  -- Client.Cardano.Epochs
  GetLatestEpoch :: Blockfrost m (Either BlockfrostError EpochInfo)
  GetLatestEpochProtocolParams :: Blockfrost m (Either BlockfrostError ProtocolParams)
  GetEpoch :: Epoch -> Blockfrost m (Either BlockfrostError EpochInfo)
  GetNextEpochs' :: Epoch -> Paged -> Blockfrost m (Either BlockfrostError [EpochInfo])
  GetNextEpochs :: Epoch -> Blockfrost m (Either BlockfrostError [EpochInfo])
  GetPreviousEpochs' :: Epoch -> Paged -> Blockfrost m (Either BlockfrostError [EpochInfo])
  GetPreviousEpochs :: Epoch -> Blockfrost m (Either BlockfrostError [EpochInfo])
  GetEpochStake' :: Epoch -> Paged -> Blockfrost m (Either BlockfrostError [StakeDistribution])
  GetEpochStake :: Epoch -> Blockfrost m (Either BlockfrostError [StakeDistribution])
  GetEpochStakeByPool' :: Epoch -> PoolId -> Paged -> Blockfrost m (Either BlockfrostError [PoolStakeDistribution])
  GetEpochStakeByPool :: Epoch -> PoolId -> Blockfrost m (Either BlockfrostError [PoolStakeDistribution])
  GetEpochBlocks' :: Epoch -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [BlockHash])
  GetEpochBlocks :: Epoch -> Blockfrost m (Either BlockfrostError [BlockHash])
  GetEpochBlocksByPool' :: Epoch -> PoolId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [BlockHash])
  GetEpochBlocksByPool :: Epoch -> PoolId -> Blockfrost m (Either BlockfrostError [BlockHash])
  GetEpochProtocolParams :: Epoch -> Blockfrost m (Either BlockfrostError ProtocolParams)

  -- Client.Cardano.Transactions
  GetTx :: TxHash -> Blockfrost m (Either BlockfrostError Transaction)
  GetTxUtxos :: TxHash -> Blockfrost m (Either BlockfrostError TransactionUtxos)
  GetTxRedeemers :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionRedeemer])
  GetTxStakes :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionStake])
  GetTxDelegations :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionDelegation])
  GetTxWithdrawals :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionWithdrawal])
  GetTxMirs :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionMir])
  GetTxPoolUpdates :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionPoolUpdate])
  GetTxPoolRetiring :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionPoolRetiring])
  GetTxMetadataJSON :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionMetaJSON])
  GetTxMetadataCBOR :: TxHash -> Blockfrost m (Either BlockfrostError [TransactionMetaCBOR])
  SubmitTx :: CBORString -> Blockfrost m (Either BlockfrostError TxHash)

  -- Client.Cardano.Ledger
  GetLedgerGenesis :: Blockfrost m (Either BlockfrostError Genesis)

  -- Client.Cardano.Accounts
  GetAccount :: Address -> Blockfrost m (Either BlockfrostError AccountInfo)
  GetAccountRewards' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AccountReward])
  GetAccountRewards :: Address -> Blockfrost m (Either BlockfrostError [AccountReward])
  GetAccountHistory' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AccountHistory])
  GetAccountHistory :: Address -> Blockfrost m (Either BlockfrostError [AccountHistory])
  GetAccountDelegations' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AccountDelegation])
  GetAccountDelegations :: Address -> Blockfrost m (Either BlockfrostError [AccountDelegation])
  GetAccountRegistrations' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AccountRegistration])
  GetAccountRegistrations :: Address -> Blockfrost m (Either BlockfrostError [AccountRegistration])
  GetAccountWithdrawals' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AccountWithdrawal])
  GetAccountWithdrawals :: Address -> Blockfrost m (Either BlockfrostError [AccountWithdrawal])
  GetAccountMirs' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AccountMir])
  GetAccountMirs :: Address -> Blockfrost m (Either BlockfrostError [AccountMir])
  GetAccountAssociatedAddresses' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [AddressAssociated])
  GetAccountAssociatedAddresses :: Address -> Blockfrost m (Either BlockfrostError [AddressAssociated])
  GetAccountAssociatedAddressesTotal :: Address -> Blockfrost m (Either BlockfrostError AddressAssociatedTotal)
  GetAccountAssociatedAssets' :: Address -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [Amount])
  GetAccountAssociatedAssets :: Address -> Blockfrost m (Either BlockfrostError [Amount])

  -- Client.Cardano.Pools
  ListPools' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [PoolId])
  ListPools :: Blockfrost m (Either BlockfrostError [PoolId])
  ListPoolsExtended' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [Pool])
  ListPoolsExtended :: Blockfrost m (Either BlockfrostError [Pool])
  ListRetiredPools' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [PoolEpoch])
  ListRetiredPools :: Blockfrost m (Either BlockfrostError [PoolEpoch])
  ListRetiringPools' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [PoolEpoch])
  ListRetiringPools :: Blockfrost m (Either BlockfrostError [PoolEpoch])
  GetPool :: PoolId -> Blockfrost m (Either BlockfrostError PoolInfo)
  GetPoolHistory' :: PoolId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [PoolHistory])
  GetPoolHistory :: PoolId -> Blockfrost m (Either BlockfrostError [PoolHistory])
  GetPoolMetadata :: PoolId -> Blockfrost m (Either BlockfrostError (Maybe PoolMetadata))
  GetPoolRelays :: PoolId -> Blockfrost m (Either BlockfrostError [PoolRelay])
  GetPoolDelegators' :: PoolId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [PoolDelegator])
  GetPoolDelegators :: PoolId -> Blockfrost m (Either BlockfrostError [PoolDelegator])
  GetPoolBlocks' :: PoolId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [BlockHash])
  GetPoolBlocks :: PoolId -> Blockfrost m (Either BlockfrostError [BlockHash])
  GetPoolUpdates' :: PoolId -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [PoolUpdate])
  GetPoolUpdates :: PoolId -> Blockfrost m (Either BlockfrostError [PoolUpdate])

  -- Client.Cardano.Metadata
  GetTxMetadataLabels' :: Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [TxMeta])
  GetTxMetadataLabels :: Blockfrost m (Either BlockfrostError [TxMeta])
  GetTxMetadataByLabelJSON' :: Text -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [TxMetaJSON])
  GetTxMetadataByLabelJSON :: Text -> Blockfrost m (Either BlockfrostError [TxMetaJSON])
  GetTxMetadataByLabelCBOR' :: Text -> Paged -> SortOrder -> Blockfrost m (Either BlockfrostError [TxMetaCBOR])
  GetTxMetadataByLabelCBOR :: Text -> Blockfrost m (Either BlockfrostError [TxMetaCBOR])

makeSem ''Blockfrost

callBlockfrost :: ()
  => Member (Reader Project) r
  => Member (Embed IO) r
  => BF.BlockfrostClientT IO b
  -> Sem r (Either BlockfrostError b)
callBlockfrost :: forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost BlockfrostClientT IO b
f = do
  Project
project <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask @Project
  IO (Either BlockfrostError b) -> Sem r (Either BlockfrostError b)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Project -> BlockfrostClientT IO b -> IO (Either BlockfrostError b)
forall a.
Project -> BlockfrostClientT IO a -> IO (Either BlockfrostError a)
BF.runBlockfrost Project
project BlockfrostClientT IO b
f)

runBlockfrost :: ()
  => Member (Embed IO) r
  => Member (Reader Project) r
  => Sem (Blockfrost ': r) a
  -> Sem r a
runBlockfrost :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Reader Project) r) =>
Sem (Blockfrost : r) a -> Sem r a
runBlockfrost =
  (forall (rInitial :: EffectRow) x.
 Blockfrost (Sem rInitial) x -> Sem r x)
-> Sem (Blockfrost : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Blockfrost (Sem rInitial) x -> Sem r x)
 -> Sem (Blockfrost : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Blockfrost (Sem rInitial) x -> Sem r x)
-> Sem (Blockfrost : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
    -- Client
    Blockfrost (Sem rInitial) x
GetRoot                                       -> BlockfrostClientT IO URLVersion
-> Sem r (Either BlockfrostError URLVersion)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO URLVersion
 -> Sem r (Either BlockfrostError URLVersion))
-> BlockfrostClientT IO URLVersion
-> Sem r (Either BlockfrostError URLVersion)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO URLVersion
forall (m :: * -> *). MonadBlockfrost m => m URLVersion
BF.getRoot
    Blockfrost (Sem rInitial) x
GetHealth                                     -> BlockfrostClientT IO Healthy
-> Sem r (Either BlockfrostError Healthy)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Healthy
 -> Sem r (Either BlockfrostError Healthy))
-> BlockfrostClientT IO Healthy
-> Sem r (Either BlockfrostError Healthy)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO Healthy
forall (m :: * -> *). MonadBlockfrost m => m Healthy
BF.getHealth
    Blockfrost (Sem rInitial) x
GetClock                                      -> BlockfrostClientT IO ServerTime
-> Sem r (Either BlockfrostError ServerTime)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ServerTime
 -> Sem r (Either BlockfrostError ServerTime))
-> BlockfrostClientT IO ServerTime
-> Sem r (Either BlockfrostError ServerTime)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO ServerTime
forall (m :: * -> *). MonadBlockfrost m => m ServerTime
BF.getClock
    Blockfrost (Sem rInitial) x
GetMetrics                                    -> BlockfrostClientT IO [Metric]
-> Sem r (Either BlockfrostError [Metric])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Metric]
 -> Sem r (Either BlockfrostError [Metric]))
-> BlockfrostClientT IO [Metric]
-> Sem r (Either BlockfrostError [Metric])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [Metric]
forall (m :: * -> *). MonadBlockfrost m => m [Metric]
BF.getMetrics
    Blockfrost (Sem rInitial) x
GetMetricsEndpoints                           -> BlockfrostClientT IO [(Text, Metric)]
-> Sem r (Either BlockfrostError [(Text, Metric)])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [(Text, Metric)]
 -> Sem r (Either BlockfrostError [(Text, Metric)]))
-> BlockfrostClientT IO [(Text, Metric)]
-> Sem r (Either BlockfrostError [(Text, Metric)])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [(Text, Metric)]
forall (m :: * -> *). MonadBlockfrost m => m [(Text, Metric)]
BF.getMetricsEndpoints

    -- Client.NutLink
    NutlinkListAddress                  Address
a         -> BlockfrostClientT IO NutlinkAddress
-> Sem r (Either BlockfrostError NutlinkAddress)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO NutlinkAddress
 -> Sem r (Either BlockfrostError NutlinkAddress))
-> BlockfrostClientT IO NutlinkAddress
-> Sem r (Either BlockfrostError NutlinkAddress)
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO NutlinkAddress
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m NutlinkAddress
BF.nutlinkListAddress                 Address
a
    NutlinkListAddressTickers'          Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [NutlinkAddressTicker]
-> Sem r (Either BlockfrostError [NutlinkAddressTicker])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [NutlinkAddressTicker]
 -> Sem r (Either BlockfrostError [NutlinkAddressTicker]))
-> BlockfrostClientT IO [NutlinkAddressTicker]
-> Sem r (Either BlockfrostError [NutlinkAddressTicker])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged
-> SortOrder
-> BlockfrostClientT IO [NutlinkAddressTicker]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [NutlinkAddressTicker]
BF.nutlinkListAddressTickers'         Address
a Paged
b SortOrder
c
    NutlinkListAddressTickers           Address
a         -> BlockfrostClientT IO [NutlinkAddressTicker]
-> Sem r (Either BlockfrostError [NutlinkAddressTicker])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [NutlinkAddressTicker]
 -> Sem r (Either BlockfrostError [NutlinkAddressTicker]))
-> BlockfrostClientT IO [NutlinkAddressTicker]
-> Sem r (Either BlockfrostError [NutlinkAddressTicker])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [NutlinkAddressTicker]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [NutlinkAddressTicker]
BF.nutlinkListAddressTickers          Address
a
    NutlinkAddressTickers'              Address
a Text
b Paged
c SortOrder
d   -> BlockfrostClientT IO [NutlinkTicker]
-> Sem r (Either BlockfrostError [NutlinkTicker])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [NutlinkTicker]
 -> Sem r (Either BlockfrostError [NutlinkTicker]))
-> BlockfrostClientT IO [NutlinkTicker]
-> Sem r (Either BlockfrostError [NutlinkTicker])
forall a b. (a -> b) -> a -> b
$ Address
-> Text
-> Paged
-> SortOrder
-> BlockfrostClientT IO [NutlinkTicker]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Text -> Paged -> SortOrder -> m [NutlinkTicker]
BF.nutlinkAddressTickers'             Address
a Text
b Paged
c SortOrder
d
    NutlinkAddressTickers               Address
a Text
b       -> BlockfrostClientT IO [NutlinkTicker]
-> Sem r (Either BlockfrostError [NutlinkTicker])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [NutlinkTicker]
 -> Sem r (Either BlockfrostError [NutlinkTicker]))
-> BlockfrostClientT IO [NutlinkTicker]
-> Sem r (Either BlockfrostError [NutlinkTicker])
forall a b. (a -> b) -> a -> b
$ Address -> Text -> BlockfrostClientT IO [NutlinkTicker]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Text -> m [NutlinkTicker]
BF.nutlinkAddressTickers              Address
a Text
b
    NutlinkTickers'                     Text
a Paged
b SortOrder
c     -> BlockfrostClientT IO [(Address, NutlinkTicker)]
-> Sem r (Either BlockfrostError [(Address, NutlinkTicker)])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [(Address, NutlinkTicker)]
 -> Sem r (Either BlockfrostError [(Address, NutlinkTicker)]))
-> BlockfrostClientT IO [(Address, NutlinkTicker)]
-> Sem r (Either BlockfrostError [(Address, NutlinkTicker)])
forall a b. (a -> b) -> a -> b
$ Text
-> Paged
-> SortOrder
-> BlockfrostClientT IO [(Address, NutlinkTicker)]
forall (m :: * -> *).
MonadBlockfrost m =>
Text -> Paged -> SortOrder -> m [(Address, NutlinkTicker)]
BF.nutlinkTickers'                    Text
a Paged
b SortOrder
c
    NutlinkTickers                      Text
a         -> BlockfrostClientT IO [(Address, NutlinkTicker)]
-> Sem r (Either BlockfrostError [(Address, NutlinkTicker)])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [(Address, NutlinkTicker)]
 -> Sem r (Either BlockfrostError [(Address, NutlinkTicker)]))
-> BlockfrostClientT IO [(Address, NutlinkTicker)]
-> Sem r (Either BlockfrostError [(Address, NutlinkTicker)])
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO [(Address, NutlinkTicker)]
forall (m :: * -> *).
MonadBlockfrost m =>
Text -> m [(Address, NutlinkTicker)]
BF.nutlinkTickers                     Text
a

    -- -- Client.IPFS
    IpfsGateway                         Text
a         -> BlockfrostClientT IO IPFSData
-> Sem r (Either BlockfrostError IPFSData)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO IPFSData
 -> Sem r (Either BlockfrostError IPFSData))
-> BlockfrostClientT IO IPFSData
-> Sem r (Either BlockfrostError IPFSData)
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO IPFSData
forall (m :: * -> *). MonadBlockfrost m => Text -> m IPFSData
BF.ipfsGateway                        Text
a
    IpfsPin                             Text
a         -> BlockfrostClientT IO IPFSPinChange
-> Sem r (Either BlockfrostError IPFSPinChange)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO IPFSPinChange
 -> Sem r (Either BlockfrostError IPFSPinChange))
-> BlockfrostClientT IO IPFSPinChange
-> Sem r (Either BlockfrostError IPFSPinChange)
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO IPFSPinChange
forall (m :: * -> *). MonadBlockfrost m => Text -> m IPFSPinChange
BF.ipfsPin                            Text
a
    IpfsListPins'                       Paged
a SortOrder
b       -> BlockfrostClientT IO [IPFSPin]
-> Sem r (Either BlockfrostError [IPFSPin])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [IPFSPin]
 -> Sem r (Either BlockfrostError [IPFSPin]))
-> BlockfrostClientT IO [IPFSPin]
-> Sem r (Either BlockfrostError [IPFSPin])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [IPFSPin]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [IPFSPin]
BF.ipfsListPins'                      Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
IpfsListPins                                  -> BlockfrostClientT IO [IPFSPin]
-> Sem r (Either BlockfrostError [IPFSPin])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [IPFSPin]
 -> Sem r (Either BlockfrostError [IPFSPin]))
-> BlockfrostClientT IO [IPFSPin]
-> Sem r (Either BlockfrostError [IPFSPin])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [IPFSPin]
forall (m :: * -> *). MonadBlockfrost m => m [IPFSPin]
BF.ipfsListPins
    IpfsGetPin                          Text
a         -> BlockfrostClientT IO IPFSPin
-> Sem r (Either BlockfrostError IPFSPin)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO IPFSPin
 -> Sem r (Either BlockfrostError IPFSPin))
-> BlockfrostClientT IO IPFSPin
-> Sem r (Either BlockfrostError IPFSPin)
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO IPFSPin
forall (m :: * -> *). MonadBlockfrost m => Text -> m IPFSPin
BF.ipfsGetPin                         Text
a
    IpfsRemovePin                       Text
a         -> BlockfrostClientT IO IPFSPinChange
-> Sem r (Either BlockfrostError IPFSPinChange)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO IPFSPinChange
 -> Sem r (Either BlockfrostError IPFSPinChange))
-> BlockfrostClientT IO IPFSPinChange
-> Sem r (Either BlockfrostError IPFSPinChange)
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO IPFSPinChange
forall (m :: * -> *). MonadBlockfrost m => Text -> m IPFSPinChange
BF.ipfsRemovePin                      Text
a

    -- Client.Cardano.Blocks
    Blockfrost (Sem rInitial) x
GetLatestBlock                                -> BlockfrostClientT IO Block -> Sem r (Either BlockfrostError Block)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Block
 -> Sem r (Either BlockfrostError Block))
-> BlockfrostClientT IO Block
-> Sem r (Either BlockfrostError Block)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO Block
forall (m :: * -> *). MonadBlockfrost m => m Block
BF.getLatestBlock
    GetLatestBlockTxs'                  Paged
a SortOrder
b       -> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxHash]
 -> Sem r (Either BlockfrostError [TxHash]))
-> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [TxHash]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [TxHash]
BF.getLatestBlockTxs'                 Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
GetLatestBlockTxs                             -> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxHash]
 -> Sem r (Either BlockfrostError [TxHash]))
-> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [TxHash]
forall (m :: * -> *). MonadBlockfrost m => m [TxHash]
BF.getLatestBlockTxs
    GetBlock                            Either Integer BlockHash
a         -> BlockfrostClientT IO Block -> Sem r (Either BlockfrostError Block)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Block
 -> Sem r (Either BlockfrostError Block))
-> BlockfrostClientT IO Block
-> Sem r (Either BlockfrostError Block)
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash -> BlockfrostClientT IO Block
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> m Block
BF.getBlock Either Integer BlockHash
a
    GetBlockSlot                        Slot
a         -> BlockfrostClientT IO Block -> Sem r (Either BlockfrostError Block)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Block
 -> Sem r (Either BlockfrostError Block))
-> BlockfrostClientT IO Block
-> Sem r (Either BlockfrostError Block)
forall a b. (a -> b) -> a -> b
$ Slot -> BlockfrostClientT IO Block
forall (m :: * -> *). MonadBlockfrost m => Slot -> m Block
BF.getBlockSlot                       Slot
a
    GetBlockEpochSlot                   Epoch
a Slot
b       -> BlockfrostClientT IO Block -> Sem r (Either BlockfrostError Block)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Block
 -> Sem r (Either BlockfrostError Block))
-> BlockfrostClientT IO Block
-> Sem r (Either BlockfrostError Block)
forall a b. (a -> b) -> a -> b
$ Epoch -> Slot -> BlockfrostClientT IO Block
forall (m :: * -> *). MonadBlockfrost m => Epoch -> Slot -> m Block
BF.getBlockEpochSlot                  Epoch
a Slot
b
    GetNextBlocks'                      Either Integer BlockHash
a Paged
b       -> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Block]
 -> Sem r (Either BlockfrostError [Block]))
-> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash -> Paged -> BlockfrostClientT IO [Block]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> Paged -> m [Block]
BF.getNextBlocks'                     Either Integer BlockHash
a Paged
b
    GetNextBlocks                       Either Integer BlockHash
a         -> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Block]
 -> Sem r (Either BlockfrostError [Block]))
-> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash -> BlockfrostClientT IO [Block]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> m [Block]
BF.getNextBlocks                      Either Integer BlockHash
a
    GetPreviousBlocks'                  Either Integer BlockHash
a Paged
b       -> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Block]
 -> Sem r (Either BlockfrostError [Block]))
-> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash -> Paged -> BlockfrostClientT IO [Block]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> Paged -> m [Block]
BF.getPreviousBlocks'                 Either Integer BlockHash
a Paged
b
    GetPreviousBlocks                   Either Integer BlockHash
a         -> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Block]
 -> Sem r (Either BlockfrostError [Block]))
-> BlockfrostClientT IO [Block]
-> Sem r (Either BlockfrostError [Block])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash -> BlockfrostClientT IO [Block]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> m [Block]
BF.getPreviousBlocks                  Either Integer BlockHash
a
    GetBlockTxs'                        Either Integer BlockHash
a Paged
b SortOrder
c     -> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxHash]
 -> Sem r (Either BlockfrostError [TxHash]))
-> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash
-> Paged -> SortOrder -> BlockfrostClientT IO [TxHash]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> Paged -> SortOrder -> m [TxHash]
BF.getBlockTxs'                       Either Integer BlockHash
a Paged
b SortOrder
c
    GetBlockTxs                         Either Integer BlockHash
a         -> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxHash]
 -> Sem r (Either BlockfrostError [TxHash]))
-> BlockfrostClientT IO [TxHash]
-> Sem r (Either BlockfrostError [TxHash])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash -> BlockfrostClientT IO [TxHash]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> m [TxHash]
BF.getBlockTxs                        Either Integer BlockHash
a
    GetBlockAffectedAddresses'          Either Integer BlockHash
a Paged
b       -> BlockfrostClientT IO [(Address, [TxHash])]
-> Sem r (Either BlockfrostError [(Address, [TxHash])])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [(Address, [TxHash])]
 -> Sem r (Either BlockfrostError [(Address, [TxHash])]))
-> BlockfrostClientT IO [(Address, [TxHash])]
-> Sem r (Either BlockfrostError [(Address, [TxHash])])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash
-> Paged -> BlockfrostClientT IO [(Address, [TxHash])]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> Paged -> m [(Address, [TxHash])]
BF.getBlockAffectedAddresses'         Either Integer BlockHash
a Paged
b
    GetBlockAffectedAddresses           Either Integer BlockHash
a         -> BlockfrostClientT IO [(Address, [TxHash])]
-> Sem r (Either BlockfrostError [(Address, [TxHash])])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [(Address, [TxHash])]
 -> Sem r (Either BlockfrostError [(Address, [TxHash])]))
-> BlockfrostClientT IO [(Address, [TxHash])]
-> Sem r (Either BlockfrostError [(Address, [TxHash])])
forall a b. (a -> b) -> a -> b
$ Either Integer BlockHash
-> BlockfrostClientT IO [(Address, [TxHash])]
forall (m :: * -> *).
MonadBlockfrost m =>
Either Integer BlockHash -> m [(Address, [TxHash])]
BF.getBlockAffectedAddresses          Either Integer BlockHash
a

    -- -- Client.Cardano.Network
    Blockfrost (Sem rInitial) x
GetNetworkInfo                                -> BlockfrostClientT IO Network
-> Sem r (Either BlockfrostError Network)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Network
 -> Sem r (Either BlockfrostError Network))
-> BlockfrostClientT IO Network
-> Sem r (Either BlockfrostError Network)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO Network
forall (m :: * -> *). MonadBlockfrost m => m Network
BF.getNetworkInfo
    Blockfrost (Sem rInitial) x
GetNetworkEras                                -> BlockfrostClientT IO [NetworkEraSummary]
-> Sem r (Either BlockfrostError [NetworkEraSummary])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [NetworkEraSummary]
 -> Sem r (Either BlockfrostError [NetworkEraSummary]))
-> BlockfrostClientT IO [NetworkEraSummary]
-> Sem r (Either BlockfrostError [NetworkEraSummary])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [NetworkEraSummary]
forall (m :: * -> *). MonadBlockfrost m => m [NetworkEraSummary]
BF.getNetworkEras

    -- Client.Cardano.Addresses
    GetAddressInfo                      Address
a         -> BlockfrostClientT IO AddressInfo
-> Sem r (Either BlockfrostError AddressInfo)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO AddressInfo
 -> Sem r (Either BlockfrostError AddressInfo))
-> BlockfrostClientT IO AddressInfo
-> Sem r (Either BlockfrostError AddressInfo)
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO AddressInfo
forall (m :: * -> *). MonadBlockfrost m => Address -> m AddressInfo
BF.getAddressInfo                   Address
a
    GetAddressInfoExtended              Address
a         -> BlockfrostClientT IO AddressInfoExtended
-> Sem r (Either BlockfrostError AddressInfoExtended)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO AddressInfoExtended
 -> Sem r (Either BlockfrostError AddressInfoExtended))
-> BlockfrostClientT IO AddressInfoExtended
-> Sem r (Either BlockfrostError AddressInfoExtended)
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO AddressInfoExtended
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m AddressInfoExtended
BF.getAddressInfoExtended           Address
a
    GetAddressDetails                   Address
a         -> BlockfrostClientT IO AddressDetails
-> Sem r (Either BlockfrostError AddressDetails)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO AddressDetails
 -> Sem r (Either BlockfrostError AddressDetails))
-> BlockfrostClientT IO AddressDetails
-> Sem r (Either BlockfrostError AddressDetails)
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO AddressDetails
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m AddressDetails
BF.getAddressDetails                Address
a
    GetAddressUtxos'                    Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressUtxo]
 -> Sem r (Either BlockfrostError [AddressUtxo]))
-> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall a b. (a -> b) -> a -> b
$ Address -> Paged -> SortOrder -> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AddressUtxo]
BF.getAddressUtxos'                 Address
a Paged
b SortOrder
c
    GetAddressUtxos                     Address
a         -> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressUtxo]
 -> Sem r (Either BlockfrostError [AddressUtxo]))
-> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AddressUtxo]
BF.getAddressUtxos                  Address
a
    GetAddressUtxosAsset'               Address
a AssetId
b Paged
c SortOrder
d   -> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressUtxo]
 -> Sem r (Either BlockfrostError [AddressUtxo]))
-> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall a b. (a -> b) -> a -> b
$ Address
-> AssetId
-> Paged
-> SortOrder
-> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> AssetId -> Paged -> SortOrder -> m [AddressUtxo]
BF.getAddressUtxosAsset'            Address
a AssetId
b Paged
c SortOrder
d
    GetAddressUtxosAsset                Address
a AssetId
b       -> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressUtxo]
 -> Sem r (Either BlockfrostError [AddressUtxo]))
-> BlockfrostClientT IO [AddressUtxo]
-> Sem r (Either BlockfrostError [AddressUtxo])
forall a b. (a -> b) -> a -> b
$ Address -> AssetId -> BlockfrostClientT IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> AssetId -> m [AddressUtxo]
BF.getAddressUtxosAsset             Address
a AssetId
b
    GetAddressTransactions              Address
a         -> BlockfrostClientT IO [AddressTransaction]
-> Sem r (Either BlockfrostError [AddressTransaction])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressTransaction]
 -> Sem r (Either BlockfrostError [AddressTransaction]))
-> BlockfrostClientT IO [AddressTransaction]
-> Sem r (Either BlockfrostError [AddressTransaction])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AddressTransaction]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AddressTransaction]
BF.getAddressTransactions           Address
a
    GetAddressTransactions'             Address
a Paged
b SortOrder
c Maybe BlockIndex
d Maybe BlockIndex
e -> BlockfrostClientT IO [AddressTransaction]
-> Sem r (Either BlockfrostError [AddressTransaction])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressTransaction]
 -> Sem r (Either BlockfrostError [AddressTransaction]))
-> BlockfrostClientT IO [AddressTransaction]
-> Sem r (Either BlockfrostError [AddressTransaction])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged
-> SortOrder
-> Maybe BlockIndex
-> Maybe BlockIndex
-> BlockfrostClientT IO [AddressTransaction]
forall (m :: * -> *).
MonadBlockfrost m =>
Address
-> Paged
-> SortOrder
-> Maybe BlockIndex
-> Maybe BlockIndex
-> m [AddressTransaction]
BF.getAddressTransactions'          Address
a Paged
b SortOrder
c Maybe BlockIndex
d Maybe BlockIndex
e

    -- Client.Cardano.Assets
    GetAssets'                          Paged
a SortOrder
b       -> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetInfo]
 -> Sem r (Either BlockfrostError [AssetInfo]))
-> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [AssetInfo]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [AssetInfo]
BF.getAssets'                       Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
GetAssets                                     -> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetInfo]
 -> Sem r (Either BlockfrostError [AssetInfo]))
-> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [AssetInfo]
forall (m :: * -> *). MonadBlockfrost m => m [AssetInfo]
BF.getAssets
    GetAssetDetails                     AssetId
a         -> BlockfrostClientT IO AssetDetails
-> Sem r (Either BlockfrostError AssetDetails)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO AssetDetails
 -> Sem r (Either BlockfrostError AssetDetails))
-> BlockfrostClientT IO AssetDetails
-> Sem r (Either BlockfrostError AssetDetails)
forall a b. (a -> b) -> a -> b
$ AssetId -> BlockfrostClientT IO AssetDetails
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> m AssetDetails
BF.getAssetDetails                  AssetId
a
    GetAssetHistory'                    AssetId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AssetHistory]
-> Sem r (Either BlockfrostError [AssetHistory])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetHistory]
 -> Sem r (Either BlockfrostError [AssetHistory]))
-> BlockfrostClientT IO [AssetHistory]
-> Sem r (Either BlockfrostError [AssetHistory])
forall a b. (a -> b) -> a -> b
$ AssetId
-> Paged -> SortOrder -> BlockfrostClientT IO [AssetHistory]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> Paged -> SortOrder -> m [AssetHistory]
BF.getAssetHistory'                 AssetId
a Paged
b SortOrder
c
    GetAssetHistory                     AssetId
a         -> BlockfrostClientT IO [AssetHistory]
-> Sem r (Either BlockfrostError [AssetHistory])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetHistory]
 -> Sem r (Either BlockfrostError [AssetHistory]))
-> BlockfrostClientT IO [AssetHistory]
-> Sem r (Either BlockfrostError [AssetHistory])
forall a b. (a -> b) -> a -> b
$ AssetId -> BlockfrostClientT IO [AssetHistory]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> m [AssetHistory]
BF.getAssetHistory                  AssetId
a
    GetAssetTransactions'               AssetId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AssetTransaction]
-> Sem r (Either BlockfrostError [AssetTransaction])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetTransaction]
 -> Sem r (Either BlockfrostError [AssetTransaction]))
-> BlockfrostClientT IO [AssetTransaction]
-> Sem r (Either BlockfrostError [AssetTransaction])
forall a b. (a -> b) -> a -> b
$ AssetId
-> Paged -> SortOrder -> BlockfrostClientT IO [AssetTransaction]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> Paged -> SortOrder -> m [AssetTransaction]
BF.getAssetTransactions'            AssetId
a Paged
b SortOrder
c
    GetAssetTransactions                AssetId
a         -> BlockfrostClientT IO [AssetTransaction]
-> Sem r (Either BlockfrostError [AssetTransaction])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetTransaction]
 -> Sem r (Either BlockfrostError [AssetTransaction]))
-> BlockfrostClientT IO [AssetTransaction]
-> Sem r (Either BlockfrostError [AssetTransaction])
forall a b. (a -> b) -> a -> b
$ AssetId -> BlockfrostClientT IO [AssetTransaction]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> m [AssetTransaction]
BF.getAssetTransactions             AssetId
a
    GetAssetAddresses'                  AssetId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AssetAddress]
-> Sem r (Either BlockfrostError [AssetAddress])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetAddress]
 -> Sem r (Either BlockfrostError [AssetAddress]))
-> BlockfrostClientT IO [AssetAddress]
-> Sem r (Either BlockfrostError [AssetAddress])
forall a b. (a -> b) -> a -> b
$ AssetId
-> Paged -> SortOrder -> BlockfrostClientT IO [AssetAddress]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> Paged -> SortOrder -> m [AssetAddress]
BF.getAssetAddresses'               AssetId
a Paged
b SortOrder
c
    GetAssetAddresses                   AssetId
a         -> BlockfrostClientT IO [AssetAddress]
-> Sem r (Either BlockfrostError [AssetAddress])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetAddress]
 -> Sem r (Either BlockfrostError [AssetAddress]))
-> BlockfrostClientT IO [AssetAddress]
-> Sem r (Either BlockfrostError [AssetAddress])
forall a b. (a -> b) -> a -> b
$ AssetId -> BlockfrostClientT IO [AssetAddress]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> m [AssetAddress]
BF.getAssetAddresses                AssetId
a
    GetAssetsByPolicy'                  PolicyId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetInfo]
 -> Sem r (Either BlockfrostError [AssetInfo]))
-> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall a b. (a -> b) -> a -> b
$ PolicyId -> Paged -> SortOrder -> BlockfrostClientT IO [AssetInfo]
forall (m :: * -> *).
MonadBlockfrost m =>
PolicyId -> Paged -> SortOrder -> m [AssetInfo]
BF.getAssetsByPolicy'               PolicyId
a Paged
b SortOrder
c
    GetAssetsByPolicy                   PolicyId
a         -> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AssetInfo]
 -> Sem r (Either BlockfrostError [AssetInfo]))
-> BlockfrostClientT IO [AssetInfo]
-> Sem r (Either BlockfrostError [AssetInfo])
forall a b. (a -> b) -> a -> b
$ PolicyId -> BlockfrostClientT IO [AssetInfo]
forall (m :: * -> *).
MonadBlockfrost m =>
PolicyId -> m [AssetInfo]
BF.getAssetsByPolicy                PolicyId
a

    -- Client.Cardano.Scripts
    ListScripts'                        Paged
a SortOrder
b       -> BlockfrostClientT IO ScriptHashList
-> Sem r (Either BlockfrostError ScriptHashList)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ScriptHashList
 -> Sem r (Either BlockfrostError ScriptHashList))
-> BlockfrostClientT IO ScriptHashList
-> Sem r (Either BlockfrostError ScriptHashList)
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO ScriptHashList
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m ScriptHashList
BF.listScripts'                       Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
ListScripts                                   -> BlockfrostClientT IO ScriptHashList
-> Sem r (Either BlockfrostError ScriptHashList)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ScriptHashList
 -> Sem r (Either BlockfrostError ScriptHashList))
-> BlockfrostClientT IO ScriptHashList
-> Sem r (Either BlockfrostError ScriptHashList)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO ScriptHashList
forall (m :: * -> *). MonadBlockfrost m => m ScriptHashList
BF.listScripts
    GetScript                           ScriptHash
a         -> BlockfrostClientT IO Script
-> Sem r (Either BlockfrostError Script)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Script
 -> Sem r (Either BlockfrostError Script))
-> BlockfrostClientT IO Script
-> Sem r (Either BlockfrostError Script)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> BlockfrostClientT IO Script
forall (m :: * -> *). MonadBlockfrost m => ScriptHash -> m Script
BF.getScript                          ScriptHash
a
    GetScriptRedeemers'                 ScriptHash
a Paged
b SortOrder
c     -> BlockfrostClientT IO [ScriptRedeemer]
-> Sem r (Either BlockfrostError [ScriptRedeemer])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [ScriptRedeemer]
 -> Sem r (Either BlockfrostError [ScriptRedeemer]))
-> BlockfrostClientT IO [ScriptRedeemer]
-> Sem r (Either BlockfrostError [ScriptRedeemer])
forall a b. (a -> b) -> a -> b
$ ScriptHash
-> Paged -> SortOrder -> BlockfrostClientT IO [ScriptRedeemer]
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> Paged -> SortOrder -> m [ScriptRedeemer]
BF.getScriptRedeemers'                ScriptHash
a Paged
b SortOrder
c
    GetScriptRedeemers                  ScriptHash
a         -> BlockfrostClientT IO [ScriptRedeemer]
-> Sem r (Either BlockfrostError [ScriptRedeemer])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [ScriptRedeemer]
 -> Sem r (Either BlockfrostError [ScriptRedeemer]))
-> BlockfrostClientT IO [ScriptRedeemer]
-> Sem r (Either BlockfrostError [ScriptRedeemer])
forall a b. (a -> b) -> a -> b
$ ScriptHash -> BlockfrostClientT IO [ScriptRedeemer]
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> m [ScriptRedeemer]
BF.getScriptRedeemers                 ScriptHash
a
    GetScriptDatum                      DatumHash
a         -> BlockfrostClientT IO ScriptDatum
-> Sem r (Either BlockfrostError ScriptDatum)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ScriptDatum
 -> Sem r (Either BlockfrostError ScriptDatum))
-> BlockfrostClientT IO ScriptDatum
-> Sem r (Either BlockfrostError ScriptDatum)
forall a b. (a -> b) -> a -> b
$ DatumHash -> BlockfrostClientT IO ScriptDatum
forall (m :: * -> *).
MonadBlockfrost m =>
DatumHash -> m ScriptDatum
BF.getScriptDatum                     DatumHash
a
    GetScriptDatumCBOR                  DatumHash
a         -> BlockfrostClientT IO ScriptDatumCBOR
-> Sem r (Either BlockfrostError ScriptDatumCBOR)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ScriptDatumCBOR
 -> Sem r (Either BlockfrostError ScriptDatumCBOR))
-> BlockfrostClientT IO ScriptDatumCBOR
-> Sem r (Either BlockfrostError ScriptDatumCBOR)
forall a b. (a -> b) -> a -> b
$ DatumHash -> BlockfrostClientT IO ScriptDatumCBOR
forall (m :: * -> *).
MonadBlockfrost m =>
DatumHash -> m ScriptDatumCBOR
BF.getScriptDatumCBOR                 DatumHash
a
    GetScriptJSON                       ScriptHash
a         -> BlockfrostClientT IO ScriptJSON
-> Sem r (Either BlockfrostError ScriptJSON)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ScriptJSON
 -> Sem r (Either BlockfrostError ScriptJSON))
-> BlockfrostClientT IO ScriptJSON
-> Sem r (Either BlockfrostError ScriptJSON)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> BlockfrostClientT IO ScriptJSON
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> m ScriptJSON
BF.getScriptJSON                      ScriptHash
a
    GetScriptCBOR                       ScriptHash
a         -> BlockfrostClientT IO ScriptCBOR
-> Sem r (Either BlockfrostError ScriptCBOR)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ScriptCBOR
 -> Sem r (Either BlockfrostError ScriptCBOR))
-> BlockfrostClientT IO ScriptCBOR
-> Sem r (Either BlockfrostError ScriptCBOR)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> BlockfrostClientT IO ScriptCBOR
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> m ScriptCBOR
BF.getScriptCBOR                      ScriptHash
a

    -- Client.Cardano.Epochs
    Blockfrost (Sem rInitial) x
GetLatestEpoch                                -> BlockfrostClientT IO EpochInfo
-> Sem r (Either BlockfrostError EpochInfo)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO EpochInfo
 -> Sem r (Either BlockfrostError EpochInfo))
-> BlockfrostClientT IO EpochInfo
-> Sem r (Either BlockfrostError EpochInfo)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO EpochInfo
forall (m :: * -> *). MonadBlockfrost m => m EpochInfo
BF.getLatestEpoch
    Blockfrost (Sem rInitial) x
GetLatestEpochProtocolParams                  -> BlockfrostClientT IO ProtocolParams
-> Sem r (Either BlockfrostError ProtocolParams)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ProtocolParams
 -> Sem r (Either BlockfrostError ProtocolParams))
-> BlockfrostClientT IO ProtocolParams
-> Sem r (Either BlockfrostError ProtocolParams)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO ProtocolParams
forall (m :: * -> *). MonadBlockfrost m => m ProtocolParams
BF.getLatestEpochProtocolParams
    GetEpoch                            Epoch
a         -> BlockfrostClientT IO EpochInfo
-> Sem r (Either BlockfrostError EpochInfo)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO EpochInfo
 -> Sem r (Either BlockfrostError EpochInfo))
-> BlockfrostClientT IO EpochInfo
-> Sem r (Either BlockfrostError EpochInfo)
forall a b. (a -> b) -> a -> b
$ Epoch -> BlockfrostClientT IO EpochInfo
forall (m :: * -> *). MonadBlockfrost m => Epoch -> m EpochInfo
BF.getEpoch                           Epoch
a
    GetNextEpochs'                      Epoch
a Paged
b       -> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [EpochInfo]
 -> Sem r (Either BlockfrostError [EpochInfo]))
-> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall a b. (a -> b) -> a -> b
$ Epoch -> Paged -> BlockfrostClientT IO [EpochInfo]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [EpochInfo]
BF.getNextEpochs'                     Epoch
a Paged
b
    GetNextEpochs                       Epoch
a         -> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [EpochInfo]
 -> Sem r (Either BlockfrostError [EpochInfo]))
-> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall a b. (a -> b) -> a -> b
$ Epoch -> BlockfrostClientT IO [EpochInfo]
forall (m :: * -> *). MonadBlockfrost m => Epoch -> m [EpochInfo]
BF.getNextEpochs                      Epoch
a
    GetPreviousEpochs'                  Epoch
a Paged
b       -> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [EpochInfo]
 -> Sem r (Either BlockfrostError [EpochInfo]))
-> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall a b. (a -> b) -> a -> b
$ Epoch -> Paged -> BlockfrostClientT IO [EpochInfo]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [EpochInfo]
BF.getPreviousEpochs'                 Epoch
a Paged
b
    GetPreviousEpochs                   Epoch
a         -> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [EpochInfo]
 -> Sem r (Either BlockfrostError [EpochInfo]))
-> BlockfrostClientT IO [EpochInfo]
-> Sem r (Either BlockfrostError [EpochInfo])
forall a b. (a -> b) -> a -> b
$ Epoch -> BlockfrostClientT IO [EpochInfo]
forall (m :: * -> *). MonadBlockfrost m => Epoch -> m [EpochInfo]
BF.getPreviousEpochs                  Epoch
a
    GetEpochStake'                      Epoch
a Paged
b       -> BlockfrostClientT IO [StakeDistribution]
-> Sem r (Either BlockfrostError [StakeDistribution])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [StakeDistribution]
 -> Sem r (Either BlockfrostError [StakeDistribution]))
-> BlockfrostClientT IO [StakeDistribution]
-> Sem r (Either BlockfrostError [StakeDistribution])
forall a b. (a -> b) -> a -> b
$ Epoch -> Paged -> BlockfrostClientT IO [StakeDistribution]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> m [StakeDistribution]
BF.getEpochStake'                     Epoch
a Paged
b
    GetEpochStake                       Epoch
a         -> BlockfrostClientT IO [StakeDistribution]
-> Sem r (Either BlockfrostError [StakeDistribution])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [StakeDistribution]
 -> Sem r (Either BlockfrostError [StakeDistribution]))
-> BlockfrostClientT IO [StakeDistribution]
-> Sem r (Either BlockfrostError [StakeDistribution])
forall a b. (a -> b) -> a -> b
$ Epoch -> BlockfrostClientT IO [StakeDistribution]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> m [StakeDistribution]
BF.getEpochStake                      Epoch
a
    GetEpochStakeByPool'                Epoch
a PoolId
b Paged
c     -> BlockfrostClientT IO [PoolStakeDistribution]
-> Sem r (Either BlockfrostError [PoolStakeDistribution])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolStakeDistribution]
 -> Sem r (Either BlockfrostError [PoolStakeDistribution]))
-> BlockfrostClientT IO [PoolStakeDistribution]
-> Sem r (Either BlockfrostError [PoolStakeDistribution])
forall a b. (a -> b) -> a -> b
$ Epoch
-> PoolId -> Paged -> BlockfrostClientT IO [PoolStakeDistribution]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> Paged -> m [PoolStakeDistribution]
BF.getEpochStakeByPool'               Epoch
a PoolId
b Paged
c
    GetEpochStakeByPool                 Epoch
a PoolId
b       -> BlockfrostClientT IO [PoolStakeDistribution]
-> Sem r (Either BlockfrostError [PoolStakeDistribution])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolStakeDistribution]
 -> Sem r (Either BlockfrostError [PoolStakeDistribution]))
-> BlockfrostClientT IO [PoolStakeDistribution]
-> Sem r (Either BlockfrostError [PoolStakeDistribution])
forall a b. (a -> b) -> a -> b
$ Epoch -> PoolId -> BlockfrostClientT IO [PoolStakeDistribution]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> m [PoolStakeDistribution]
BF.getEpochStakeByPool                Epoch
a PoolId
b
    GetEpochBlocks'                     Epoch
a Paged
b SortOrder
c     -> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [BlockHash]
 -> Sem r (Either BlockfrostError [BlockHash]))
-> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall a b. (a -> b) -> a -> b
$ Epoch -> Paged -> SortOrder -> BlockfrostClientT IO [BlockHash]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> Paged -> SortOrder -> m [BlockHash]
BF.getEpochBlocks'                    Epoch
a Paged
b SortOrder
c
    GetEpochBlocks                      Epoch
a         -> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [BlockHash]
 -> Sem r (Either BlockfrostError [BlockHash]))
-> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall a b. (a -> b) -> a -> b
$ Epoch -> BlockfrostClientT IO [BlockHash]
forall (m :: * -> *). MonadBlockfrost m => Epoch -> m [BlockHash]
BF.getEpochBlocks                     Epoch
a
    GetEpochBlocksByPool'               Epoch
a PoolId
b Paged
c SortOrder
d   -> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [BlockHash]
 -> Sem r (Either BlockfrostError [BlockHash]))
-> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall a b. (a -> b) -> a -> b
$ Epoch
-> PoolId -> Paged -> SortOrder -> BlockfrostClientT IO [BlockHash]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> Paged -> SortOrder -> m [BlockHash]
BF.getEpochBlocksByPool'              Epoch
a PoolId
b Paged
c SortOrder
d
    GetEpochBlocksByPool                Epoch
a PoolId
b       -> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [BlockHash]
 -> Sem r (Either BlockfrostError [BlockHash]))
-> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall a b. (a -> b) -> a -> b
$ Epoch -> PoolId -> BlockfrostClientT IO [BlockHash]
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> PoolId -> m [BlockHash]
BF.getEpochBlocksByPool               Epoch
a PoolId
b
    GetEpochProtocolParams              Epoch
a         -> BlockfrostClientT IO ProtocolParams
-> Sem r (Either BlockfrostError ProtocolParams)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO ProtocolParams
 -> Sem r (Either BlockfrostError ProtocolParams))
-> BlockfrostClientT IO ProtocolParams
-> Sem r (Either BlockfrostError ProtocolParams)
forall a b. (a -> b) -> a -> b
$ Epoch -> BlockfrostClientT IO ProtocolParams
forall (m :: * -> *).
MonadBlockfrost m =>
Epoch -> m ProtocolParams
BF.getEpochProtocolParams             Epoch
a

    -- Client.Cardano.Transactions
    GetTx                               TxHash
a         -> BlockfrostClientT IO Transaction
-> Sem r (Either BlockfrostError Transaction)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Transaction
 -> Sem r (Either BlockfrostError Transaction))
-> BlockfrostClientT IO Transaction
-> Sem r (Either BlockfrostError Transaction)
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO Transaction
forall (m :: * -> *). MonadBlockfrost m => TxHash -> m Transaction
BF.getTx                              TxHash
a
    GetTxUtxos                          TxHash
a         -> BlockfrostClientT IO TransactionUtxos
-> Sem r (Either BlockfrostError TransactionUtxos)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO TransactionUtxos
 -> Sem r (Either BlockfrostError TransactionUtxos))
-> BlockfrostClientT IO TransactionUtxos
-> Sem r (Either BlockfrostError TransactionUtxos)
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO TransactionUtxos
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m TransactionUtxos
BF.getTxUtxos                         TxHash
a
    GetTxRedeemers                      TxHash
a         -> BlockfrostClientT IO [TransactionRedeemer]
-> Sem r (Either BlockfrostError [TransactionRedeemer])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionRedeemer]
 -> Sem r (Either BlockfrostError [TransactionRedeemer]))
-> BlockfrostClientT IO [TransactionRedeemer]
-> Sem r (Either BlockfrostError [TransactionRedeemer])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionRedeemer]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionRedeemer]
BF.getTxRedeemers                     TxHash
a
    GetTxStakes                         TxHash
a         -> BlockfrostClientT IO [TransactionStake]
-> Sem r (Either BlockfrostError [TransactionStake])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionStake]
 -> Sem r (Either BlockfrostError [TransactionStake]))
-> BlockfrostClientT IO [TransactionStake]
-> Sem r (Either BlockfrostError [TransactionStake])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionStake]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionStake]
BF.getTxStakes                        TxHash
a
    GetTxDelegations                    TxHash
a         -> BlockfrostClientT IO [TransactionDelegation]
-> Sem r (Either BlockfrostError [TransactionDelegation])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionDelegation]
 -> Sem r (Either BlockfrostError [TransactionDelegation]))
-> BlockfrostClientT IO [TransactionDelegation]
-> Sem r (Either BlockfrostError [TransactionDelegation])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionDelegation]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionDelegation]
BF.getTxDelegations                   TxHash
a
    GetTxWithdrawals                    TxHash
a         -> BlockfrostClientT IO [TransactionWithdrawal]
-> Sem r (Either BlockfrostError [TransactionWithdrawal])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionWithdrawal]
 -> Sem r (Either BlockfrostError [TransactionWithdrawal]))
-> BlockfrostClientT IO [TransactionWithdrawal]
-> Sem r (Either BlockfrostError [TransactionWithdrawal])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionWithdrawal]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionWithdrawal]
BF.getTxWithdrawals                   TxHash
a
    GetTxMirs                           TxHash
a         -> BlockfrostClientT IO [TransactionMir]
-> Sem r (Either BlockfrostError [TransactionMir])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionMir]
 -> Sem r (Either BlockfrostError [TransactionMir]))
-> BlockfrostClientT IO [TransactionMir]
-> Sem r (Either BlockfrostError [TransactionMir])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionMir]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionMir]
BF.getTxMirs                          TxHash
a
    GetTxPoolUpdates                    TxHash
a         -> BlockfrostClientT IO [TransactionPoolUpdate]
-> Sem r (Either BlockfrostError [TransactionPoolUpdate])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionPoolUpdate]
 -> Sem r (Either BlockfrostError [TransactionPoolUpdate]))
-> BlockfrostClientT IO [TransactionPoolUpdate]
-> Sem r (Either BlockfrostError [TransactionPoolUpdate])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionPoolUpdate]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionPoolUpdate]
BF.getTxPoolUpdates                   TxHash
a
    GetTxPoolRetiring                   TxHash
a         -> BlockfrostClientT IO [TransactionPoolRetiring]
-> Sem r (Either BlockfrostError [TransactionPoolRetiring])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionPoolRetiring]
 -> Sem r (Either BlockfrostError [TransactionPoolRetiring]))
-> BlockfrostClientT IO [TransactionPoolRetiring]
-> Sem r (Either BlockfrostError [TransactionPoolRetiring])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionPoolRetiring]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionPoolRetiring]
BF.getTxPoolRetiring                  TxHash
a
    GetTxMetadataJSON                   TxHash
a         -> BlockfrostClientT IO [TransactionMetaJSON]
-> Sem r (Either BlockfrostError [TransactionMetaJSON])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionMetaJSON]
 -> Sem r (Either BlockfrostError [TransactionMetaJSON]))
-> BlockfrostClientT IO [TransactionMetaJSON]
-> Sem r (Either BlockfrostError [TransactionMetaJSON])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionMetaJSON]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionMetaJSON]
BF.getTxMetadataJSON                  TxHash
a
    GetTxMetadataCBOR                   TxHash
a         -> BlockfrostClientT IO [TransactionMetaCBOR]
-> Sem r (Either BlockfrostError [TransactionMetaCBOR])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TransactionMetaCBOR]
 -> Sem r (Either BlockfrostError [TransactionMetaCBOR]))
-> BlockfrostClientT IO [TransactionMetaCBOR]
-> Sem r (Either BlockfrostError [TransactionMetaCBOR])
forall a b. (a -> b) -> a -> b
$ TxHash -> BlockfrostClientT IO [TransactionMetaCBOR]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionMetaCBOR]
BF.getTxMetadataCBOR                  TxHash
a
    SubmitTx                            CBORString
a         -> BlockfrostClientT IO TxHash
-> Sem r (Either BlockfrostError TxHash)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO TxHash
 -> Sem r (Either BlockfrostError TxHash))
-> BlockfrostClientT IO TxHash
-> Sem r (Either BlockfrostError TxHash)
forall a b. (a -> b) -> a -> b
$ CBORString -> BlockfrostClientT IO TxHash
forall (m :: * -> *). MonadBlockfrost m => CBORString -> m TxHash
BF.submitTx                           CBORString
a

    -- Client.Cardano.Ledger
    Blockfrost (Sem rInitial) x
GetLedgerGenesis                              -> BlockfrostClientT IO Genesis
-> Sem r (Either BlockfrostError Genesis)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO Genesis
 -> Sem r (Either BlockfrostError Genesis))
-> BlockfrostClientT IO Genesis
-> Sem r (Either BlockfrostError Genesis)
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO Genesis
forall (m :: * -> *). MonadBlockfrost m => m Genesis
BF.getLedgerGenesis

    -- Client.Cardano.Accounts
    GetAccount                          Address
a         -> BlockfrostClientT IO AccountInfo
-> Sem r (Either BlockfrostError AccountInfo)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO AccountInfo
 -> Sem r (Either BlockfrostError AccountInfo))
-> BlockfrostClientT IO AccountInfo
-> Sem r (Either BlockfrostError AccountInfo)
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO AccountInfo
forall (m :: * -> *). MonadBlockfrost m => Address -> m AccountInfo
BF.getAccount                         Address
a
    GetAccountRewards'                  Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AccountReward]
-> Sem r (Either BlockfrostError [AccountReward])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountReward]
 -> Sem r (Either BlockfrostError [AccountReward]))
-> BlockfrostClientT IO [AccountReward]
-> Sem r (Either BlockfrostError [AccountReward])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged -> SortOrder -> BlockfrostClientT IO [AccountReward]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AccountReward]
BF.getAccountRewards'                 Address
a Paged
b SortOrder
c
    GetAccountRewards                   Address
a         -> BlockfrostClientT IO [AccountReward]
-> Sem r (Either BlockfrostError [AccountReward])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountReward]
 -> Sem r (Either BlockfrostError [AccountReward]))
-> BlockfrostClientT IO [AccountReward]
-> Sem r (Either BlockfrostError [AccountReward])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AccountReward]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AccountReward]
BF.getAccountRewards                  Address
a
    GetAccountHistory'                  Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AccountHistory]
-> Sem r (Either BlockfrostError [AccountHistory])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountHistory]
 -> Sem r (Either BlockfrostError [AccountHistory]))
-> BlockfrostClientT IO [AccountHistory]
-> Sem r (Either BlockfrostError [AccountHistory])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged -> SortOrder -> BlockfrostClientT IO [AccountHistory]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AccountHistory]
BF.getAccountHistory'                 Address
a Paged
b SortOrder
c
    GetAccountHistory                   Address
a         -> BlockfrostClientT IO [AccountHistory]
-> Sem r (Either BlockfrostError [AccountHistory])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountHistory]
 -> Sem r (Either BlockfrostError [AccountHistory]))
-> BlockfrostClientT IO [AccountHistory]
-> Sem r (Either BlockfrostError [AccountHistory])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AccountHistory]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AccountHistory]
BF.getAccountHistory                  Address
a
    GetAccountDelegations'              Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AccountDelegation]
-> Sem r (Either BlockfrostError [AccountDelegation])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountDelegation]
 -> Sem r (Either BlockfrostError [AccountDelegation]))
-> BlockfrostClientT IO [AccountDelegation]
-> Sem r (Either BlockfrostError [AccountDelegation])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged -> SortOrder -> BlockfrostClientT IO [AccountDelegation]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AccountDelegation]
BF.getAccountDelegations'             Address
a Paged
b SortOrder
c
    GetAccountDelegations               Address
a         -> BlockfrostClientT IO [AccountDelegation]
-> Sem r (Either BlockfrostError [AccountDelegation])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountDelegation]
 -> Sem r (Either BlockfrostError [AccountDelegation]))
-> BlockfrostClientT IO [AccountDelegation]
-> Sem r (Either BlockfrostError [AccountDelegation])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AccountDelegation]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AccountDelegation]
BF.getAccountDelegations              Address
a
    GetAccountRegistrations'            Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AccountRegistration]
-> Sem r (Either BlockfrostError [AccountRegistration])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountRegistration]
 -> Sem r (Either BlockfrostError [AccountRegistration]))
-> BlockfrostClientT IO [AccountRegistration]
-> Sem r (Either BlockfrostError [AccountRegistration])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged -> SortOrder -> BlockfrostClientT IO [AccountRegistration]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AccountRegistration]
BF.getAccountRegistrations'           Address
a Paged
b SortOrder
c
    GetAccountRegistrations             Address
a         -> BlockfrostClientT IO [AccountRegistration]
-> Sem r (Either BlockfrostError [AccountRegistration])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountRegistration]
 -> Sem r (Either BlockfrostError [AccountRegistration]))
-> BlockfrostClientT IO [AccountRegistration]
-> Sem r (Either BlockfrostError [AccountRegistration])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AccountRegistration]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AccountRegistration]
BF.getAccountRegistrations            Address
a
    GetAccountWithdrawals'              Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AccountWithdrawal]
-> Sem r (Either BlockfrostError [AccountWithdrawal])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountWithdrawal]
 -> Sem r (Either BlockfrostError [AccountWithdrawal]))
-> BlockfrostClientT IO [AccountWithdrawal]
-> Sem r (Either BlockfrostError [AccountWithdrawal])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged -> SortOrder -> BlockfrostClientT IO [AccountWithdrawal]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AccountWithdrawal]
BF.getAccountWithdrawals'             Address
a Paged
b SortOrder
c
    GetAccountWithdrawals               Address
a         -> BlockfrostClientT IO [AccountWithdrawal]
-> Sem r (Either BlockfrostError [AccountWithdrawal])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountWithdrawal]
 -> Sem r (Either BlockfrostError [AccountWithdrawal]))
-> BlockfrostClientT IO [AccountWithdrawal]
-> Sem r (Either BlockfrostError [AccountWithdrawal])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AccountWithdrawal]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AccountWithdrawal]
BF.getAccountWithdrawals              Address
a
    GetAccountMirs'                     Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AccountMir]
-> Sem r (Either BlockfrostError [AccountMir])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountMir]
 -> Sem r (Either BlockfrostError [AccountMir]))
-> BlockfrostClientT IO [AccountMir]
-> Sem r (Either BlockfrostError [AccountMir])
forall a b. (a -> b) -> a -> b
$ Address -> Paged -> SortOrder -> BlockfrostClientT IO [AccountMir]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AccountMir]
BF.getAccountMirs'                    Address
a Paged
b SortOrder
c
    GetAccountMirs                      Address
a         -> BlockfrostClientT IO [AccountMir]
-> Sem r (Either BlockfrostError [AccountMir])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AccountMir]
 -> Sem r (Either BlockfrostError [AccountMir]))
-> BlockfrostClientT IO [AccountMir]
-> Sem r (Either BlockfrostError [AccountMir])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AccountMir]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AccountMir]
BF.getAccountMirs                     Address
a
    GetAccountAssociatedAddresses'      Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [AddressAssociated]
-> Sem r (Either BlockfrostError [AddressAssociated])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressAssociated]
 -> Sem r (Either BlockfrostError [AddressAssociated]))
-> BlockfrostClientT IO [AddressAssociated]
-> Sem r (Either BlockfrostError [AddressAssociated])
forall a b. (a -> b) -> a -> b
$ Address
-> Paged -> SortOrder -> BlockfrostClientT IO [AddressAssociated]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AddressAssociated]
BF.getAccountAssociatedAddresses'     Address
a Paged
b SortOrder
c
    GetAccountAssociatedAddresses       Address
a         -> BlockfrostClientT IO [AddressAssociated]
-> Sem r (Either BlockfrostError [AddressAssociated])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [AddressAssociated]
 -> Sem r (Either BlockfrostError [AddressAssociated]))
-> BlockfrostClientT IO [AddressAssociated]
-> Sem r (Either BlockfrostError [AddressAssociated])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [AddressAssociated]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m [AddressAssociated]
BF.getAccountAssociatedAddresses      Address
a
    GetAccountAssociatedAddressesTotal  Address
a         -> BlockfrostClientT IO AddressAssociatedTotal
-> Sem r (Either BlockfrostError AddressAssociatedTotal)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO AddressAssociatedTotal
 -> Sem r (Either BlockfrostError AddressAssociatedTotal))
-> BlockfrostClientT IO AddressAssociatedTotal
-> Sem r (Either BlockfrostError AddressAssociatedTotal)
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO AddressAssociatedTotal
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> m AddressAssociatedTotal
BF.getAccountAssociatedAddressesTotal Address
a
    GetAccountAssociatedAssets'         Address
a Paged
b SortOrder
c     -> BlockfrostClientT IO [Amount]
-> Sem r (Either BlockfrostError [Amount])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Amount]
 -> Sem r (Either BlockfrostError [Amount]))
-> BlockfrostClientT IO [Amount]
-> Sem r (Either BlockfrostError [Amount])
forall a b. (a -> b) -> a -> b
$ Address -> Paged -> SortOrder -> BlockfrostClientT IO [Amount]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [Amount]
BF.getAccountAssociatedAssets'        Address
a Paged
b SortOrder
c
    GetAccountAssociatedAssets          Address
a         -> BlockfrostClientT IO [Amount]
-> Sem r (Either BlockfrostError [Amount])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Amount]
 -> Sem r (Either BlockfrostError [Amount]))
-> BlockfrostClientT IO [Amount]
-> Sem r (Either BlockfrostError [Amount])
forall a b. (a -> b) -> a -> b
$ Address -> BlockfrostClientT IO [Amount]
forall (m :: * -> *). MonadBlockfrost m => Address -> m [Amount]
BF.getAccountAssociatedAssets         Address
a

    -- Client.Cardano.Pools
    ListPools'                          Paged
a SortOrder
b       -> BlockfrostClientT IO [PoolId]
-> Sem r (Either BlockfrostError [PoolId])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolId]
 -> Sem r (Either BlockfrostError [PoolId]))
-> BlockfrostClientT IO [PoolId]
-> Sem r (Either BlockfrostError [PoolId])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [PoolId]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [PoolId]
BF.listPools'                         Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
ListPools                                     -> BlockfrostClientT IO [PoolId]
-> Sem r (Either BlockfrostError [PoolId])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolId]
 -> Sem r (Either BlockfrostError [PoolId]))
-> BlockfrostClientT IO [PoolId]
-> Sem r (Either BlockfrostError [PoolId])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [PoolId]
forall (m :: * -> *). MonadBlockfrost m => m [PoolId]
BF.listPools
    ListPoolsExtended'                  Paged
a SortOrder
b       -> BlockfrostClientT IO [Pool]
-> Sem r (Either BlockfrostError [Pool])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Pool]
 -> Sem r (Either BlockfrostError [Pool]))
-> BlockfrostClientT IO [Pool]
-> Sem r (Either BlockfrostError [Pool])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [Pool]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [Pool]
BF.listPoolsExtended'                 Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
ListPoolsExtended                             -> BlockfrostClientT IO [Pool]
-> Sem r (Either BlockfrostError [Pool])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [Pool]
 -> Sem r (Either BlockfrostError [Pool]))
-> BlockfrostClientT IO [Pool]
-> Sem r (Either BlockfrostError [Pool])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [Pool]
forall (m :: * -> *). MonadBlockfrost m => m [Pool]
BF.listPoolsExtended
    ListRetiredPools'                   Paged
a SortOrder
b       -> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolEpoch]
 -> Sem r (Either BlockfrostError [PoolEpoch]))
-> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [PoolEpoch]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [PoolEpoch]
BF.listRetiredPools'                  Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
ListRetiredPools                              -> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolEpoch]
 -> Sem r (Either BlockfrostError [PoolEpoch]))
-> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [PoolEpoch]
forall (m :: * -> *). MonadBlockfrost m => m [PoolEpoch]
BF.listRetiredPools
    ListRetiringPools'                  Paged
a SortOrder
b       -> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolEpoch]
 -> Sem r (Either BlockfrostError [PoolEpoch]))
-> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [PoolEpoch]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [PoolEpoch]
BF.listRetiringPools'                 Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
ListRetiringPools                             -> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolEpoch]
 -> Sem r (Either BlockfrostError [PoolEpoch]))
-> BlockfrostClientT IO [PoolEpoch]
-> Sem r (Either BlockfrostError [PoolEpoch])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [PoolEpoch]
forall (m :: * -> *). MonadBlockfrost m => m [PoolEpoch]
BF.listRetiringPools
    GetPool                             PoolId
a         -> BlockfrostClientT IO PoolInfo
-> Sem r (Either BlockfrostError PoolInfo)
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO PoolInfo
 -> Sem r (Either BlockfrostError PoolInfo))
-> BlockfrostClientT IO PoolInfo
-> Sem r (Either BlockfrostError PoolInfo)
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO PoolInfo
forall (m :: * -> *). MonadBlockfrost m => PoolId -> m PoolInfo
BF.getPool                            PoolId
a
    GetPoolHistory'                     PoolId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [PoolHistory]
-> Sem r (Either BlockfrostError [PoolHistory])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolHistory]
 -> Sem r (Either BlockfrostError [PoolHistory]))
-> BlockfrostClientT IO [PoolHistory]
-> Sem r (Either BlockfrostError [PoolHistory])
forall a b. (a -> b) -> a -> b
$ PoolId -> Paged -> SortOrder -> BlockfrostClientT IO [PoolHistory]
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> Paged -> SortOrder -> m [PoolHistory]
BF.getPoolHistory'                    PoolId
a Paged
b SortOrder
c
    GetPoolHistory                      PoolId
a         -> BlockfrostClientT IO [PoolHistory]
-> Sem r (Either BlockfrostError [PoolHistory])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolHistory]
 -> Sem r (Either BlockfrostError [PoolHistory]))
-> BlockfrostClientT IO [PoolHistory]
-> Sem r (Either BlockfrostError [PoolHistory])
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO [PoolHistory]
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> m [PoolHistory]
BF.getPoolHistory                     PoolId
a
    GetPoolMetadata                     PoolId
a         -> BlockfrostClientT IO (Maybe PoolMetadata)
-> Sem r (Either BlockfrostError (Maybe PoolMetadata))
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO (Maybe PoolMetadata)
 -> Sem r (Either BlockfrostError (Maybe PoolMetadata)))
-> BlockfrostClientT IO (Maybe PoolMetadata)
-> Sem r (Either BlockfrostError (Maybe PoolMetadata))
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO (Maybe PoolMetadata)
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> m (Maybe PoolMetadata)
BF.getPoolMetadata                    PoolId
a
    GetPoolRelays                       PoolId
a         -> BlockfrostClientT IO [PoolRelay]
-> Sem r (Either BlockfrostError [PoolRelay])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolRelay]
 -> Sem r (Either BlockfrostError [PoolRelay]))
-> BlockfrostClientT IO [PoolRelay]
-> Sem r (Either BlockfrostError [PoolRelay])
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO [PoolRelay]
forall (m :: * -> *). MonadBlockfrost m => PoolId -> m [PoolRelay]
BF.getPoolRelays                      PoolId
a
    GetPoolDelegators'                  PoolId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [PoolDelegator]
-> Sem r (Either BlockfrostError [PoolDelegator])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolDelegator]
 -> Sem r (Either BlockfrostError [PoolDelegator]))
-> BlockfrostClientT IO [PoolDelegator]
-> Sem r (Either BlockfrostError [PoolDelegator])
forall a b. (a -> b) -> a -> b
$ PoolId
-> Paged -> SortOrder -> BlockfrostClientT IO [PoolDelegator]
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> Paged -> SortOrder -> m [PoolDelegator]
BF.getPoolDelegators'                 PoolId
a Paged
b SortOrder
c
    GetPoolDelegators                   PoolId
a         -> BlockfrostClientT IO [PoolDelegator]
-> Sem r (Either BlockfrostError [PoolDelegator])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolDelegator]
 -> Sem r (Either BlockfrostError [PoolDelegator]))
-> BlockfrostClientT IO [PoolDelegator]
-> Sem r (Either BlockfrostError [PoolDelegator])
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO [PoolDelegator]
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> m [PoolDelegator]
BF.getPoolDelegators                  PoolId
a
    GetPoolBlocks'                      PoolId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [BlockHash]
 -> Sem r (Either BlockfrostError [BlockHash]))
-> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall a b. (a -> b) -> a -> b
$ PoolId -> Paged -> SortOrder -> BlockfrostClientT IO [BlockHash]
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> Paged -> SortOrder -> m [BlockHash]
BF.getPoolBlocks'                     PoolId
a Paged
b SortOrder
c
    GetPoolBlocks                       PoolId
a         -> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [BlockHash]
 -> Sem r (Either BlockfrostError [BlockHash]))
-> BlockfrostClientT IO [BlockHash]
-> Sem r (Either BlockfrostError [BlockHash])
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO [BlockHash]
forall (m :: * -> *). MonadBlockfrost m => PoolId -> m [BlockHash]
BF.getPoolBlocks                      PoolId
a
    GetPoolUpdates'                     PoolId
a Paged
b SortOrder
c     -> BlockfrostClientT IO [PoolUpdate]
-> Sem r (Either BlockfrostError [PoolUpdate])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolUpdate]
 -> Sem r (Either BlockfrostError [PoolUpdate]))
-> BlockfrostClientT IO [PoolUpdate]
-> Sem r (Either BlockfrostError [PoolUpdate])
forall a b. (a -> b) -> a -> b
$ PoolId -> Paged -> SortOrder -> BlockfrostClientT IO [PoolUpdate]
forall (m :: * -> *).
MonadBlockfrost m =>
PoolId -> Paged -> SortOrder -> m [PoolUpdate]
BF.getPoolUpdates'                    PoolId
a Paged
b SortOrder
c
    GetPoolUpdates                      PoolId
a         -> BlockfrostClientT IO [PoolUpdate]
-> Sem r (Either BlockfrostError [PoolUpdate])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [PoolUpdate]
 -> Sem r (Either BlockfrostError [PoolUpdate]))
-> BlockfrostClientT IO [PoolUpdate]
-> Sem r (Either BlockfrostError [PoolUpdate])
forall a b. (a -> b) -> a -> b
$ PoolId -> BlockfrostClientT IO [PoolUpdate]
forall (m :: * -> *). MonadBlockfrost m => PoolId -> m [PoolUpdate]
BF.getPoolUpdates                     PoolId
a

    -- Client.Cardano.Metadata
    GetTxMetadataLabels'                Paged
a SortOrder
b       -> BlockfrostClientT IO [TxMeta]
-> Sem r (Either BlockfrostError [TxMeta])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxMeta]
 -> Sem r (Either BlockfrostError [TxMeta]))
-> BlockfrostClientT IO [TxMeta]
-> Sem r (Either BlockfrostError [TxMeta])
forall a b. (a -> b) -> a -> b
$ Paged -> SortOrder -> BlockfrostClientT IO [TxMeta]
forall (m :: * -> *).
MonadBlockfrost m =>
Paged -> SortOrder -> m [TxMeta]
BF.getTxMetadataLabels'               Paged
a SortOrder
b
    Blockfrost (Sem rInitial) x
GetTxMetadataLabels                           -> BlockfrostClientT IO [TxMeta]
-> Sem r (Either BlockfrostError [TxMeta])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxMeta]
 -> Sem r (Either BlockfrostError [TxMeta]))
-> BlockfrostClientT IO [TxMeta]
-> Sem r (Either BlockfrostError [TxMeta])
forall a b. (a -> b) -> a -> b
$ BlockfrostClientT IO [TxMeta]
forall (m :: * -> *). MonadBlockfrost m => m [TxMeta]
BF.getTxMetadataLabels
    GetTxMetadataByLabelJSON'           Text
a Paged
b SortOrder
c     -> BlockfrostClientT IO [TxMetaJSON]
-> Sem r (Either BlockfrostError [TxMetaJSON])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxMetaJSON]
 -> Sem r (Either BlockfrostError [TxMetaJSON]))
-> BlockfrostClientT IO [TxMetaJSON]
-> Sem r (Either BlockfrostError [TxMetaJSON])
forall a b. (a -> b) -> a -> b
$ Text -> Paged -> SortOrder -> BlockfrostClientT IO [TxMetaJSON]
forall (m :: * -> *).
MonadBlockfrost m =>
Text -> Paged -> SortOrder -> m [TxMetaJSON]
BF.getTxMetadataByLabelJSON'          Text
a Paged
b SortOrder
c
    GetTxMetadataByLabelJSON            Text
a         -> BlockfrostClientT IO [TxMetaJSON]
-> Sem r (Either BlockfrostError [TxMetaJSON])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxMetaJSON]
 -> Sem r (Either BlockfrostError [TxMetaJSON]))
-> BlockfrostClientT IO [TxMetaJSON]
-> Sem r (Either BlockfrostError [TxMetaJSON])
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO [TxMetaJSON]
forall (m :: * -> *). MonadBlockfrost m => Text -> m [TxMetaJSON]
BF.getTxMetadataByLabelJSON           Text
a
    GetTxMetadataByLabelCBOR'           Text
a Paged
b SortOrder
c     -> BlockfrostClientT IO [TxMetaCBOR]
-> Sem r (Either BlockfrostError [TxMetaCBOR])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxMetaCBOR]
 -> Sem r (Either BlockfrostError [TxMetaCBOR]))
-> BlockfrostClientT IO [TxMetaCBOR]
-> Sem r (Either BlockfrostError [TxMetaCBOR])
forall a b. (a -> b) -> a -> b
$ Text -> Paged -> SortOrder -> BlockfrostClientT IO [TxMetaCBOR]
forall (m :: * -> *).
MonadBlockfrost m =>
Text -> Paged -> SortOrder -> m [TxMetaCBOR]
BF.getTxMetadataByLabelCBOR'          Text
a Paged
b SortOrder
c
    GetTxMetadataByLabelCBOR            Text
a         -> BlockfrostClientT IO [TxMetaCBOR]
-> Sem r (Either BlockfrostError [TxMetaCBOR])
forall (r :: EffectRow) b.
(Member (Reader Project) r, Member (Embed IO) r) =>
BlockfrostClientT IO b -> Sem r (Either BlockfrostError b)
callBlockfrost (BlockfrostClientT IO [TxMetaCBOR]
 -> Sem r (Either BlockfrostError [TxMetaCBOR]))
-> BlockfrostClientT IO [TxMetaCBOR]
-> Sem r (Either BlockfrostError [TxMetaCBOR])
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostClientT IO [TxMetaCBOR]
forall (m :: * -> *). MonadBlockfrost m => Text -> m [TxMetaCBOR]
BF.getTxMetadataByLabelCBOR           Text
a