Merge pull request #62 from Jimbo4350/jordan/add-mempool-endpoint

Add mempool endpoint

blockfrost-api/blockfrost-api.cabal

@@ -34,6 +34,7 @@ common libstuff
     DeriveAnyClass
     DeriveGeneric
     DerivingVia
+    DuplicateRecordFields
     GADTs
     GeneralizedNewtypeDeriving
     FlexibleContexts
@@ -68,6 +69,7 @@ library
                       , Blockfrost.API.Cardano.Blocks
                       , Blockfrost.API.Cardano.Epochs
                       , Blockfrost.API.Cardano.Ledger
+                      , Blockfrost.API.Cardano.Mempool
                       , Blockfrost.API.Cardano.Metadata
                       , Blockfrost.API.Cardano.Network
                       , Blockfrost.API.Cardano.Pools
@@ -89,6 +91,7 @@ library
                       , Blockfrost.Types.Cardano.Blocks
                       , Blockfrost.Types.Cardano.Epochs
                       , Blockfrost.Types.Cardano.Genesis
+                      , Blockfrost.Types.Cardano.Mempool
                       , Blockfrost.Types.Cardano.Metadata
                       , Blockfrost.Types.Cardano.Network
                       , Blockfrost.Types.Cardano.Pools

blockfrost-api/src/Blockfrost/API.hs

@@ -98,6 +98,11 @@ data CardanoAPI route =
       :- "genesis"
       :> Tag "Cardano » Ledger"
       :> ToServantApi LedgerAPI
+    , _mempool
+      :: route
+      :- "mempool"
+      :> Tag "Cardano » Mempool"
+      :> ToServantApi MempoolAPI
     , _metadata
       :: route
       :- "metadata"

blockfrost-api/src/Blockfrost/API/Cardano.hs

@@ -9,6 +9,7 @@ module Blockfrost.API.Cardano
   , module Blockfrost.API.Cardano.Blocks
   , module Blockfrost.API.Cardano.Epochs
   , module Blockfrost.API.Cardano.Ledger
+  , module Blockfrost.API.Cardano.Mempool
   , module Blockfrost.API.Cardano.Metadata
   , module Blockfrost.API.Cardano.Network
   , module Blockfrost.API.Cardano.Pools
@@ -23,6 +24,7 @@ import Blockfrost.API.Cardano.Assets
 import Blockfrost.API.Cardano.Blocks
 import Blockfrost.API.Cardano.Epochs
 import Blockfrost.API.Cardano.Ledger
+import Blockfrost.API.Cardano.Mempool
 import Blockfrost.API.Cardano.Metadata
 import Blockfrost.API.Cardano.Network
 import Blockfrost.API.Cardano.Pools

blockfrost-api/src/Blockfrost/API/Cardano/Mempool.hs

@@ -0,0 +1,42 @@
+-- | Cardano Mempool endpoints
+
+{-# OPTIONS_HADDOCK hide #-}
+
+module Blockfrost.API.Cardano.Mempool
+  where
+
+import Servant.API
+import Servant.API.Generic
+
+import Blockfrost.Types
+import Blockfrost.Util.Pagination
+import Blockfrost.Util.Sorting
+
+data MempoolAPI route =
+  MempoolAPI
+    {
+      _mempoolTransactions
+        :: route
+        :- Summary "Transactions in Mempool."
+        :> Description "Tx hash list of all transactions that are currently stored in the mempool."
+        :> Pagination
+        :> Sorting
+        :> Get '[JSON] [TxHashObject]
+    , _specificTransaction
+        :: route
+        :- Summary "Transaction in mempoool."
+        :> Description "Content of a specific transaction in the mempool."
+        :> Capture "hash" TxHash
+        :> Get '[JSON] MempoolTransaction
+    , _specificAddress
+        :: 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]
+    } deriving (Generic)
+
+

blockfrost-api/src/Blockfrost/Lens.hs

@@ -45,6 +45,12 @@ makeFields ''PoolStakeDistribution
 
 makeFields ''Genesis
 
+makeFields  ''MempoolTransaction
+makeFields  ''TransactionInMempool
+makeFields  ''Amount
+makeFields  ''MempoolUTxOInput
+makeFields  ''MempoolRedeemer
+
 makeFields ''TxMeta
 makeFields ''TxMetaJSON
 makeFields ''TxMetaCBOR

blockfrost-api/src/Blockfrost/Types/Cardano.hs

@@ -7,6 +7,7 @@ module Blockfrost.Types.Cardano
   , module Blockfrost.Types.Cardano.Blocks
   , module Blockfrost.Types.Cardano.Epochs
   , module Blockfrost.Types.Cardano.Genesis
+  , module Blockfrost.Types.Cardano.Mempool
   , module Blockfrost.Types.Cardano.Metadata
   , module Blockfrost.Types.Cardano.Network
   , module Blockfrost.Types.Cardano.Pools
@@ -21,6 +22,7 @@ import Blockfrost.Types.Cardano.Assets
 import Blockfrost.Types.Cardano.Blocks
 import Blockfrost.Types.Cardano.Epochs
 import Blockfrost.Types.Cardano.Genesis
+import Blockfrost.Types.Cardano.Mempool
 import Blockfrost.Types.Cardano.Metadata
 import Blockfrost.Types.Cardano.Network
 import Blockfrost.Types.Cardano.Pools

blockfrost-api/src/Blockfrost/Types/Cardano/Mempool.hs

@@ -0,0 +1,68 @@
+-- | Transaction metadata
+
+module Blockfrost.Types.Cardano.Mempool
+  ( MempoolTransaction(..)
+  , TransactionInMempool (..)
+  , MempoolUTxOInput(..)
+  , MempoolRedeemer(..)
+  ) where
+
+import Data.Text
+import Deriving.Aeson
+import Blockfrost.Types.Cardano.Transactions
+import Blockfrost.Types.Shared.Ada
+import Blockfrost.Types.Shared.Amount
+
+data MempoolTransaction = MempoolTransaction
+  { _tx :: TransactionInMempool
+  , _inputs :: [MempoolUTxOInput]
+  , _outputs :: [UtxoOutput]
+  , _redeemers :: Maybe [MempoolRedeemer]
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON)
+  via CustomJSON '[FieldLabelModifier '[StripPrefix "_", CamelToSnake]] MempoolTransaction
+
+data TransactionInMempool = TransactionInMempool
+  { _transactionHash                 :: Text -- ^ Transaction hash
+  , _transactionOutputAmount         :: [Amount] -- ^ Transaction outputs
+  , _transactionFees                 :: Lovelaces -- ^ Transaction fee
+  , _transactionDeposit              :: Lovelaces -- ^ Deposit within the transaction in Lovelaces
+  , _transactionSize                 :: Integer -- ^ Size of the transaction in Bytes
+  , _transactionInvalidBefore        :: Maybe Text -- ^ Left (included) endpoint of the timelock validity intervals
+  , _transactionInvalidHereafter     :: Maybe Text -- ^ Right (excluded) endpoint of the timelock validity intervals
+  , _transactionUtxoCount            :: Integer -- ^ Count of UTXOs within the transaction
+  , _transactionWithdrawalCount      :: Integer -- ^ Count of the withdrawals within the transaction
+  , _transactionMirCertCount         :: Integer -- ^ Count of the MIR certificates within the transaction
+  , _transactionDelegationCount      :: Integer -- ^ Count of the delegations within the transaction
+  , _transactionStakeCertCount       :: Integer -- ^ Count of the stake keys (de)registration and delegation certificates within the transaction
+  , _transactionPoolUpdateCount      :: Integer -- ^ Count of the stake pool registration and update certificates within the transaction
+  , _transactionPoolRetireCount      :: Integer -- ^ Count of the stake pool retirement certificates within the transaction
+  , _transactionAssetMintOrBurnCount :: Integer -- ^ Count of asset mints and burns within the transaction
+  , _transactionRedeemerCount        :: Integer -- ^ Count of redeemers within the transaction
+  , _transactionValidContract        :: Bool    -- ^ True if this is a valid transaction, False in case of contract validation failure
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON)
+  via CustomJSON '[FieldLabelModifier '[StripPrefix "_transaction", CamelToSnake]] TransactionInMempool
+
+data MempoolUTxOInput = MempoolUTxOInput
+   { _address :: Text -- ^ Address
+   , _txHash :: Text -- ^ Transaction hash
+   , _outputIndex :: Integer -- ^ Output index
+   , _collateral :: Bool -- ^ True if the input is a collateral input
+   , _reference :: Bool -- ^ Is the input a reference input
+   }
+   deriving stock (Show, Eq, Generic)
+   deriving (FromJSON, ToJSON)
+   via CustomJSON '[FieldLabelModifier '[StripPrefix "_", CamelToSnake]] MempoolUTxOInput
+
+data MempoolRedeemer = MempoolRedeemer
+  { _tx_index :: Integer -- ^ Transaction index
+  , _purpose :: Text -- ^ Purpose of the redeemer
+  , _unit_mem :: Text -- ^ Memory unit
+  , _unit_steps :: Text -- ^ Steps unit
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON)
+  via CustomJSON '[FieldLabelModifier '[StripPrefix "_", CamelToSnake]] MempoolRedeemer

blockfrost-api/src/Blockfrost/Types/Shared/TxHash.hs

@@ -2,9 +2,10 @@
 
 module Blockfrost.Types.Shared.TxHash
   ( TxHash (..)
+  , TxHashObject (..)
   ) where
 
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (FromJSON (..), ToJSON (..), object, (.=), withObject, (.:))
 import Data.String (IsString (..))
 import Data.Text (Text)
 import qualified Data.Text
@@ -35,3 +36,19 @@ instance ToSample TxHash where
 
 instance ToCapture (Capture "hash" TxHash) where
   toCapture _ = DocCapture "hash" "Hash of the requested transaction."
+
+
+-- Temporary until blockfrost server returns proper TxHash
+
+newtype TxHashObject = TxHashObject { unTxHashObject :: Text }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving newtype (FromHttpApiData, ToHttpApiData)
+
+instance IsString TxHashObject where
+  fromString = TxHashObject . Data.Text.pack
+
+instance ToJSON TxHashObject where
+  toJSON hash = object ["tx_hash" .= unTxHashObject hash]
+
+instance FromJSON TxHashObject where
+  parseJSON = withObject "TxHashObject" $ \o -> TxHashObject <$> o .: "tx_hash"

blockfrost-api/test/Cardano/Transactions.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}

blockfrost-client/blockfrost-client.cabal

@@ -35,6 +35,7 @@ flag Production
 
 common libstuff
   default-language:    Haskell2010
+  default-extensions:  DuplicateRecordFields
   ghc-options:         -Wall -Wunused-packages
                        -fno-specialize
                        -- ^ this helps quite a lot
@@ -57,6 +58,7 @@ library
                       , Blockfrost.Client.Cardano.Blocks
                       , Blockfrost.Client.Cardano.Epochs
                       , Blockfrost.Client.Cardano.Ledger
+                      , Blockfrost.Client.Cardano.Mempool
                       , Blockfrost.Client.Cardano.Metadata
                       , Blockfrost.Client.Cardano.Network
                       , Blockfrost.Client.Cardano.Pools

blockfrost-client/example/Main.hs

@@ -3,7 +3,8 @@
 module Main
   where
 
-import Blockfrost.Client
+import Blockfrost.Client hiding (NutLinkAPI(..))
+import Control.Monad.IO.Class
 
 main = do
   -- reads token from BLOCKFROST_TOKEN_PATH
@@ -15,8 +16,45 @@ main = do
     latestBlocks <- getLatestBlock
     (ers :: Either BlockfrostError [AccountReward]) <-
       tryError $ getAccountRewards "gonnaFail"
+
+    allMempoolTxs <- 
+      getMempoolTransactions prj def def
+
+    if null allMempoolTxs 
+    then return $ (latestBlocks, ers, allMempoolTxs, Nothing)
+    else do let lastTxInMempool = TxHash . unTxHashObject $ last allMempoolTxs
+            lastMempoolTx <- getMempoolTransaction prj lastTxInMempool
+
+            return (latestBlocks, ers, allMempoolTxs, Just lastMempoolTx) 
+
+  -- variant accepting @Paged@ and @SortOrder@ arguments
+  -- getAccountRewards' "gonnaFail" (page 10) desc
+  case res of 
+    Left e -> print e
+    Right ((latestBlocks, ers, allMempoolTxs, lastMempoolTx)) -> do 
+      print "Latest blocks:"
+      print latestBlocks
+      putStrLn ""
+      print "Account rewards (expected to error):"
+      print ers
+      putStrLn ""
+      print "All mempool transactions (mempool potentially empty):"
+      print allMempoolTxs
+      putStrLn ""
+      print "Last mempool transaction (if any):"
+      print lastMempoolTx
+      putStrLn ""
 
-    -- variant accepting @Paged@ and @SortOrder@ arguments
-    -- getAccountRewards' "gonnaFail" (page 10) desc
-    pure (latestBlocks, ers)
-  print res
+      case lastMempoolTx of 
+        Nothing -> print "No mempool transactions found."
+        Just mempoolTx -> do
+          let inputs = _inputs mempoolTx
+          if null inputs 
+          then print "No mempool transactions found" -- Should be impossible
+          else 
+            do let address = Address . _address $ head inputs
+               mempoolTxByAddress <- runBlockfrost prj $ getMempoolTransactionsByAddress prj address def def
+               print "Mempool transactions by address:"
+               print mempoolTxByAddress
+
+

blockfrost-client/src/Blockfrost/Client.hs

@@ -97,6 +97,10 @@ module Blockfrost.Client
   , getTxMetadataByLabelJSON'
   , getTxMetadataByLabelCBOR
   , getTxMetadataByLabelCBOR'
+    -- Cardano - Mempool
+  , getMempoolTransactions
+  , getMempoolTransaction
+  , getMempoolTransactionsByAddress
     -- Cardano - Network
   , getNetworkInfo
   , getNetworkEras
@@ -178,6 +182,7 @@ import Blockfrost.Client.Cardano.Assets
 import Blockfrost.Client.Cardano.Blocks
 import Blockfrost.Client.Cardano.Epochs
 import Blockfrost.Client.Cardano.Ledger
+import Blockfrost.Client.Cardano.Mempool
 import Blockfrost.Client.Cardano.Metadata
 import Blockfrost.Client.Cardano.Network
 import Blockfrost.Client.Cardano.Pools

blockfrost-client/src/Blockfrost/Client/Cardano/Mempool.hs

@@ -0,0 +1,24 @@
+-- | 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 = fromServant . _mempool . cardanoClient
+
+getMempoolTransactions :: MonadBlockfrost m => Project -> Paged -> SortOrder -> m [TxHashObject]
+getMempoolTransactions = _mempoolTransactions . mempoolClient 
+
+getMempoolTransaction :: MonadBlockfrost m => Project -> TxHash -> m MempoolTransaction
+getMempoolTransaction = _specificTransaction . mempoolClient  
+
+getMempoolTransactionsByAddress :: MonadBlockfrost m => Project -> Address -> Paged -> SortOrder -> m [TxHashObject]
+getMempoolTransactionsByAddress = _specificAddress . mempoolClient 
+

blockfrost-client/src/Blockfrost/Client/Cardano/Transactions.hs

@@ -18,7 +18,7 @@ module Blockfrost.Client.Cardano.Transactions
 
 import Blockfrost.API
 import Blockfrost.Client.Types
-import Blockfrost.Types
+import Blockfrost.Types hiding (MempoolTransaction(..))
 
 transactionsClient :: MonadBlockfrost m => Project -> TransactionsAPI (AsClientT m)
 transactionsClient = fromServant . _transactions . cardanoClient

blockfrost-client/src/Blockfrost/Client/NutLink.hs

@@ -12,7 +12,7 @@ module Blockfrost.Client.NutLink
 
 import Blockfrost.API
 import Blockfrost.Client.Types
-import Blockfrost.Types
+import Blockfrost.Types hiding (MempoolUTxOInput(..))
 import Data.Text (Text)
 
 nutlinkListAddress_ :: MonadBlockfrost m => Project -> Address-> m NutlinkAddress