-- | Block queries

module Blockfrost.Client.Cardano.Blocks
  ( getLatestBlock
  , getLatestBlockTxs
  , getLatestBlockTxs'
  , getBlock
  , getBlockSlot
  , getBlockEpochSlot
  , getNextBlocks
  , getNextBlocks'
  , getPreviousBlocks
  , getPreviousBlocks'
  , getBlockTxs
  , getBlockTxs'
  ) where

import Blockfrost.API
import Blockfrost.Client.Types
import Blockfrost.Types

blocksClient :: Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient :: Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient = (((ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
   :<|> (Paged
         -> SortOrder
         -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))
  :<|> ((Either Integer BlockHash
         -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
        :<|> (Slot
              -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)))
 :<|> (((Epoch
         -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
        :<|> (Either Integer BlockHash
              -> Paged
              -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]))
       :<|> ((Either Integer BlockHash
              -> Paged
              -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
             :<|> (Either Integer BlockHash
                   -> Paged
                   -> SortOrder
                   -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))))
-> BlocksAPI (AsClientT BlockfrostClient)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant ((((ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
    :<|> (Paged
          -> SortOrder
          -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))
   :<|> ((Either Integer BlockHash
          -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
         :<|> (Slot
               -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)))
  :<|> (((Epoch
          -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
         :<|> (Either Integer BlockHash
               -> Paged
               -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]))
        :<|> ((Either Integer BlockHash
               -> Paged
               -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
              :<|> (Either Integer BlockHash
                    -> Paged
                    -> SortOrder
                    -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))))
 -> BlocksAPI (AsClientT BlockfrostClient))
-> (Project
    -> ((ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
         :<|> (Paged
               -> SortOrder
               -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))
        :<|> ((Either Integer BlockHash
               -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
              :<|> (Slot
                    -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)))
       :<|> (((Epoch
               -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
              :<|> (Either Integer BlockHash
                    -> Paged
                    -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]))
             :<|> ((Either Integer BlockHash
                    -> Paged
                    -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
                   :<|> (Either Integer BlockHash
                         -> Paged
                         -> SortOrder
                         -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))))
-> Project
-> BlocksAPI (AsClientT BlockfrostClient)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoAPI (AsClientT BlockfrostClient)
-> ((ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
     :<|> (Paged
           -> SortOrder
           -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))
    :<|> ((Either Integer BlockHash
           -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
          :<|> (Slot
                -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)))
   :<|> (((Epoch
           -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
          :<|> (Either Integer BlockHash
                -> Paged
                -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]))
         :<|> ((Either Integer BlockHash
                -> Paged
                -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
               :<|> (Either Integer BlockHash
                     -> Paged
                     -> SortOrder
                     -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash])))
forall route.
CardanoAPI route
-> route
   :- ("blocks"
       :> (Tag "Cardano \187 Blocks" :> ToServantApi BlocksAPI))
_blocks (CardanoAPI (AsClientT BlockfrostClient)
 -> ((ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
      :<|> (Paged
            -> SortOrder
            -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))
     :<|> ((Either Integer BlockHash
            -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
           :<|> (Slot
                 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)))
    :<|> (((Epoch
            -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
           :<|> (Either Integer BlockHash
                 -> Paged
                 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]))
          :<|> ((Either Integer BlockHash
                 -> Paged
                 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
                :<|> (Either Integer BlockHash
                      -> Paged
                      -> SortOrder
                      -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))))
-> (Project -> CardanoAPI (AsClientT BlockfrostClient))
-> Project
-> ((ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
     :<|> (Paged
           -> SortOrder
           -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]))
    :<|> ((Either Integer BlockHash
           -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
          :<|> (Slot
                -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)))
   :<|> (((Epoch
           -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
          :<|> (Either Integer BlockHash
                -> Paged
                -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]))
         :<|> ((Either Integer BlockHash
                -> Paged
                -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
               :<|> (Either Integer BlockHash
                     -> Paged
                     -> SortOrder
                     -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> CardanoAPI (AsClientT BlockfrostClient)
cardanoClient

getLatestBlock_ :: Project -> BlockfrostClient Block
getLatestBlock_ :: Project -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getLatestBlock_ = BlocksAPI (AsClientT BlockfrostClient)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall route.
BlocksAPI route
-> route
   :- (Summary "Latest block"
       :> (Description
             "Return the latest block available to the backends, also known as the tip of the blockchain."
           :> ("latest" :> Get '[JSON] Block)))
_latest (BlocksAPI (AsClientT BlockfrostClient)
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the latest block available to the backends, also known as the tip of the blockchain.
getLatestBlock :: BlockfrostClient Block
getLatestBlock :: ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getLatestBlock = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go Project -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getLatestBlock_

getLatestBlockTxs_ :: Project -> Paged -> SortOrder -> BlockfrostClient [TxHash]
getLatestBlockTxs_ :: Project
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getLatestBlockTxs_ = BlocksAPI (AsClientT BlockfrostClient)
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
forall route.
BlocksAPI route
-> route
   :- (Summary "Latest block transactions"
       :> (Description "Return the transactions within the latest block."
           :> ("latest"
               :> ("txs" :> (Pagination :> (Sorting :> Get '[JSON] [TxHash]))))))
_latestTxs (BlocksAPI (AsClientT BlockfrostClient)
 -> Paged
 -> SortOrder
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash])
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the transactions within the latest block.
-- Allows custom paging and ordering using @Paged@ and @SortOrder@.
getLatestBlockTxs' :: Paged -> SortOrder -> BlockfrostClient [TxHash]
getLatestBlockTxs' :: Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getLatestBlockTxs' Paged
pg SortOrder
s = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash])
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (\Project
p -> Project
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getLatestBlockTxs_ Project
p Paged
pg SortOrder
s)

getLatestBlockTxs :: BlockfrostClient [TxHash]
getLatestBlockTxs :: ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getLatestBlockTxs = Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getLatestBlockTxs' Paged
forall a. Default a => a
def SortOrder
forall a. Default a => a
def

getBlock_ :: Project -> Either Integer BlockHash -> BlockfrostClient Block
getBlock_ :: Project
-> Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlock_ = BlocksAPI (AsClientT BlockfrostClient)
-> Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall route.
BlocksAPI route
-> route
   :- (Summary "Latest block transactions"
       :> (Description "Return the transactions within the latest block."
           :> (Capture "hash_or_number" (Either Integer BlockHash)
               :> Get '[JSON] Block)))
_block (BlocksAPI (AsClientT BlockfrostClient)
 -> Either Integer BlockHash
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the content of a requested block.
getBlock :: Either Integer BlockHash -> BlockfrostClient Block
getBlock :: Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlock Either Integer BlockHash
a = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (Project
-> Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
`getBlock_` Either Integer BlockHash
a)

getBlockSlot_ :: Project -> Slot -> BlockfrostClient Block
getBlockSlot_ :: Project
-> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlockSlot_ = BlocksAPI (AsClientT BlockfrostClient)
-> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall route.
BlocksAPI route
-> route
   :- (Summary "Specific block in a slot"
       :> (Description
             "Return the content of a requested block for a specific slot."
           :> ("slot" :> (Capture "slot_number" Slot :> Get '[JSON] Block))))
__blockSlot (BlocksAPI (AsClientT BlockfrostClient)
 -> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Slot
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the content of a requested block for a specific slot.
getBlockSlot :: Slot -> BlockfrostClient Block
getBlockSlot :: Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlockSlot Slot
i = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (Project
-> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
`getBlockSlot_` Slot
i)

getBlockEpochSlot_ :: Project -> Epoch -> Slot -> BlockfrostClient Block
getBlockEpochSlot_ :: Project
-> Epoch
-> Slot
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlockEpochSlot_ = BlocksAPI (AsClientT BlockfrostClient)
-> Epoch
-> Slot
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall route.
BlocksAPI route
-> route
   :- (Summary "Specific block in a slot in an epoch"
       :> (Description
             "Return the content of a requested block for a specific slot in an epoch."
           :> ("epoch"
               :> (Capture "epoch_number" Epoch
                   :> ("slot"
                       :> (Capture "slot_number" Slot :> Get '[JSON] Block))))))
__blockEpochSlot (BlocksAPI (AsClientT BlockfrostClient)
 -> Epoch
 -> Slot
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Epoch
-> Slot
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the content of a requested block for a specific slot in an epoch.
getBlockEpochSlot :: Epoch -> Slot -> BlockfrostClient Block
getBlockEpochSlot :: Epoch
-> Slot -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlockEpochSlot Epoch
ep Slot
sl = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block)
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (\Project
p -> Project
-> Epoch
-> Slot
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) Block
getBlockEpochSlot_ Project
p Epoch
ep Slot
sl)

getNextBlocks_ :: Project -> Either Integer BlockHash -> Paged -> BlockfrostClient [Block]
getNextBlocks_ :: Project
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getNextBlocks_ = BlocksAPI (AsClientT BlockfrostClient)
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
forall route.
BlocksAPI route
-> route
   :- (Summary "Listing of next blocks"
       :> (Description
             "Return the list of blocks following a specific block."
           :> (Capture "hash_or_number" (Either Integer BlockHash)
               :> ("next" :> (Pagination :> Get '[JSON] [Block])))))
_blockNext (BlocksAPI (AsClientT BlockfrostClient)
 -> Either Integer BlockHash
 -> Paged
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the list of blocks following a specific block.
-- Allows custom paging using @Paged@.
getNextBlocks' :: Either Integer BlockHash -> Paged -> BlockfrostClient [Block]
getNextBlocks' :: Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getNextBlocks' Either Integer BlockHash
a Paged
pg = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (\Project
p -> Project
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getNextBlocks_ Project
p Either Integer BlockHash
a Paged
pg)

-- | Return the list of blocks following a specific block.
getNextBlocks :: Either Integer BlockHash -> BlockfrostClient [Block]
getNextBlocks :: Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getNextBlocks Either Integer BlockHash
a = Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getNextBlocks' Either Integer BlockHash
a Paged
forall a. Default a => a
def

getPreviousBlocks_ :: Project -> Either Integer BlockHash -> Paged -> BlockfrostClient [Block]
getPreviousBlocks_ :: Project
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getPreviousBlocks_ = BlocksAPI (AsClientT BlockfrostClient)
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
forall route.
BlocksAPI route
-> route
   :- (Summary "Listing of preious blocks"
       :> (Description
             "Return the list of blocks preceeding a specific block."
           :> (Capture "hash_or_number" (Either Integer BlockHash)
               :> ("previous" :> (Pagination :> Get '[JSON] [Block])))))
_blockPrevious (BlocksAPI (AsClientT BlockfrostClient)
 -> Either Integer BlockHash
 -> Paged
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the list of blocks preceding a specific block.
-- Allows custom paging using @Paged@.
getPreviousBlocks' :: Either Integer BlockHash -> Paged -> BlockfrostClient [Block]
getPreviousBlocks' :: Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getPreviousBlocks' Either Integer BlockHash
a Paged
pg = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block])
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (\Project
p -> Project
-> Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getPreviousBlocks_ Project
p Either Integer BlockHash
a Paged
pg)

-- | Return the list of blocks preceding a specific block.
getPreviousBlocks :: Either Integer BlockHash -> BlockfrostClient [Block]
getPreviousBlocks :: Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getPreviousBlocks Either Integer BlockHash
a = Either Integer BlockHash
-> Paged
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [Block]
getPreviousBlocks' Either Integer BlockHash
a Paged
forall a. Default a => a
def

getBlockTxs_ :: Project -> Either Integer BlockHash -> Paged -> SortOrder -> BlockfrostClient [TxHash]
getBlockTxs_ :: Project
-> Either Integer BlockHash
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getBlockTxs_ = BlocksAPI (AsClientT BlockfrostClient)
-> Either Integer BlockHash
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
forall route.
BlocksAPI route
-> route
   :- (Summary "Block transactions"
       :> (Description "Return the transactions within the block."
           :> (Capture "hash_or_number" (Either Integer BlockHash)
               :> ("txs" :> (Pagination :> (Sorting :> Get '[JSON] [TxHash]))))))
_blockTxs (BlocksAPI (AsClientT BlockfrostClient)
 -> Either Integer BlockHash
 -> Paged
 -> SortOrder
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash])
-> (Project -> BlocksAPI (AsClientT BlockfrostClient))
-> Project
-> Either Integer BlockHash
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> BlocksAPI (AsClientT BlockfrostClient)
blocksClient

-- | Return the transactions within the block.
-- Allows custom paging and ordering using @Paged@ and @SortOrder@.
getBlockTxs' :: Either Integer BlockHash -> Paged -> SortOrder -> BlockfrostClient [TxHash]
getBlockTxs' :: Either Integer BlockHash
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getBlockTxs' Either Integer BlockHash
a Paged
pg SortOrder
s = (Project
 -> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash])
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
forall a. (Project -> BlockfrostClient a) -> BlockfrostClient a
go (\Project
p -> Project
-> Either Integer BlockHash
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getBlockTxs_ Project
p Either Integer BlockHash
a Paged
pg SortOrder
s)

-- | Return the transactions within the block.
getBlockTxs :: Either Integer BlockHash -> BlockfrostClient [TxHash]
getBlockTxs :: Either Integer BlockHash
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getBlockTxs Either Integer BlockHash
a = Either Integer BlockHash
-> Paged
-> SortOrder
-> ExceptT BlockfrostError (ReaderT ClientConfig IO) [TxHash]
getBlockTxs' Either Integer BlockHash
a Paged
forall a. Default a => a
def SortOrder
forall a. Default a => a
def