-- | Mempool queries

module Blockfrost.Client.Cardano.Mempool
  ( getMempoolTransactions
  , getMempoolTransaction 
  , getMempoolTransactionsByAddress
  ) where

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

mempoolClient :: MonadBlockfrost m => Project -> MempoolAPI (AsClientT m)
mempoolClient :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> MempoolAPI (AsClientT m)
mempoolClient = ((Paged -> SortOrder -> m [TxHashObject])
 :<|> ((TxHash -> m MempoolTransaction)
       :<|> (Address -> Paged -> SortOrder -> m [TxHashObject])))
-> MempoolAPI (AsClientT m)
ToServant MempoolAPI (AsClientT m) -> MempoolAPI (AsClientT m)
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (((Paged -> SortOrder -> m [TxHashObject])
  :<|> ((TxHash -> m MempoolTransaction)
        :<|> (Address -> Paged -> SortOrder -> m [TxHashObject])))
 -> MempoolAPI (AsClientT m))
-> (Project
    -> (Paged -> SortOrder -> m [TxHashObject])
       :<|> ((TxHash -> m MempoolTransaction)
             :<|> (Address -> Paged -> SortOrder -> m [TxHashObject])))
-> Project
-> MempoolAPI (AsClientT m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoAPI (AsClientT m)
-> (Paged -> SortOrder -> m [TxHashObject])
   :<|> ((TxHash -> m MempoolTransaction)
         :<|> (Address -> Paged -> SortOrder -> m [TxHashObject]))
CardanoAPI (AsClientT m)
-> AsClientT m
   :- ("mempool"
       :> (Tag "Cardano \187 Mempool" :> ToServantApi MempoolAPI))
forall route.
CardanoAPI route
-> route
   :- ("mempool"
       :> (Tag "Cardano \187 Mempool" :> ToServantApi MempoolAPI))
_mempool (CardanoAPI (AsClientT m)
 -> (Paged -> SortOrder -> m [TxHashObject])
    :<|> ((TxHash -> m MempoolTransaction)
          :<|> (Address -> Paged -> SortOrder -> m [TxHashObject])))
-> (Project -> CardanoAPI (AsClientT m))
-> Project
-> (Paged -> SortOrder -> m [TxHashObject])
   :<|> ((TxHash -> m MempoolTransaction)
         :<|> (Address -> Paged -> SortOrder -> m [TxHashObject]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> CardanoAPI (AsClientT m)
forall (m :: * -> *).
MonadBlockfrost m =>
Project -> CardanoAPI (AsClientT m)
cardanoClient

getMempoolTransactions :: MonadBlockfrost m => Project -> Paged -> SortOrder -> m [TxHashObject]
getMempoolTransactions :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Paged -> SortOrder -> m [TxHashObject]
getMempoolTransactions = MempoolAPI (AsClientT m)
-> AsClientT m
   :- (Summary "Transactions in Mempool."
       :> (Description
             "Tx hash list of all transactions that are currently stored in the mempool."
           :> (Pagination :> (Sorting :> Get '[JSON] [TxHashObject]))))
MempoolAPI (AsClientT m) -> Paged -> SortOrder -> m [TxHashObject]
forall route.
MempoolAPI route
-> route
   :- (Summary "Transactions in Mempool."
       :> (Description
             "Tx hash list of all transactions that are currently stored in the mempool."
           :> (Pagination :> (Sorting :> Get '[JSON] [TxHashObject]))))
_mempoolTransactions (MempoolAPI (AsClientT m)
 -> Paged -> SortOrder -> m [TxHashObject])
-> (Project -> MempoolAPI (AsClientT m))
-> Project
-> Paged
-> SortOrder
-> m [TxHashObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> MempoolAPI (AsClientT m)
forall (m :: * -> *).
MonadBlockfrost m =>
Project -> MempoolAPI (AsClientT m)
mempoolClient 

getMempoolTransaction :: MonadBlockfrost m => Project -> TxHash -> m MempoolTransaction
getMempoolTransaction :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> TxHash -> m MempoolTransaction
getMempoolTransaction = MempoolAPI (AsClientT m)
-> AsClientT m
   :- (Summary "Transaction in mempoool."
       :> (Description "Content of a specific transaction in the mempool."
           :> (Capture "hash" TxHash :> Get '[JSON] MempoolTransaction)))
MempoolAPI (AsClientT m) -> TxHash -> m MempoolTransaction
forall route.
MempoolAPI route
-> route
   :- (Summary "Transaction in mempoool."
       :> (Description "Content of a specific transaction in the mempool."
           :> (Capture "hash" TxHash :> Get '[JSON] MempoolTransaction)))
_specificTransaction (MempoolAPI (AsClientT m) -> TxHash -> m MempoolTransaction)
-> (Project -> MempoolAPI (AsClientT m))
-> Project
-> TxHash
-> m MempoolTransaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> MempoolAPI (AsClientT m)
forall (m :: * -> *).
MonadBlockfrost m =>
Project -> MempoolAPI (AsClientT m)
mempoolClient  

getMempoolTransactionsByAddress :: MonadBlockfrost m => Project -> Address -> Paged -> SortOrder -> m [TxHashObject]
getMempoolTransactionsByAddress :: forall (m :: * -> *).
MonadBlockfrost m =>
Project -> Address -> Paged -> SortOrder -> m [TxHashObject]
getMempoolTransactionsByAddress = MempoolAPI (AsClientT m)
-> AsClientT m
   :- (Summary "Transactions involving an address in mempool."
       :> (Description
             "List of transactions in the mempool that involves a specific address."
           :> ("addresses"
               :> (Capture "address" Address
                   :> (Pagination :> (Sorting :> Get '[JSON] [TxHashObject]))))))
MempoolAPI (AsClientT m)
-> Address -> Paged -> SortOrder -> m [TxHashObject]
forall route.
MempoolAPI route
-> route
   :- (Summary "Transactions involving an address in mempool."
       :> (Description
             "List of transactions in the mempool that involves a specific address."
           :> ("addresses"
               :> (Capture "address" Address
                   :> (Pagination :> (Sorting :> Get '[JSON] [TxHashObject]))))))
_specificAddress (MempoolAPI (AsClientT m)
 -> Address -> Paged -> SortOrder -> m [TxHashObject])
-> (Project -> MempoolAPI (AsClientT m))
-> Project
-> Address
-> Paged
-> SortOrder
-> m [TxHashObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> MempoolAPI (AsClientT m)
forall (m :: * -> *).
MonadBlockfrost m =>
Project -> MempoolAPI (AsClientT m)
mempoolClient