Reintegrate the chain-index queries for querying txs by id and spent …

…tx outputs from reference (IntersectMBO#418)

plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs

@@ -25,9 +25,10 @@ import Data.OpenApi qualified as OpenApi
 import Data.Proxy (Proxy (..))
 import GHC.Generics (Generic)
 import Ledger (AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator,
-               StakeValidatorHash, Validator, ValidatorHash)
+               StakeValidatorHash, TxId, Validator, ValidatorHash)
 import Ledger.Credential (Credential)
 import Ledger.Tx (ChainIndexTxOut, TxOutRef)
+import Plutus.ChainIndex.Tx (ChainIndexTx)
 import Plutus.ChainIndex.Types (Diagnostics, Tip)
 import Servant qualified
 import Servant.API (Description, Get, JSON, NoContent, Post, Put, ReqBody, (:<|>), (:>))
@@ -145,10 +146,13 @@ data TxosResponse = TxosResponse
 type API
     = "healthcheck" :> Description "Is the server alive?" :> Get '[JSON] NoContent
     :<|> "from-hash" :> FromHashAPI
-    :<|> "unspent-tx-out" :> Description "Get an unspent transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] ChainIndexTxOut
+    :<|> "tx-out" :> Description "Get a transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] ChainIndexTxOut
+    :<|> "unspent-tx-out" :> Description "Get a unspent transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] ChainIndexTxOut
+    :<|> "tx" :> Description "Get a transaction from its id." :> ReqBody '[JSON] TxId :> Post '[JSON] ChainIndexTx
     :<|> "is-utxo" :> Description "Check if the reference is an UTxO." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] IsUtxoResponse
     :<|> "utxo-at-address" :> Description "Get all UTxOs at an address." :> ReqBody '[JSON] UtxoAtAddressRequest :> Post '[JSON] UtxosResponse
     :<|> "utxo-with-currency" :> Description "Get all UTxOs with a currency." :> ReqBody '[JSON] UtxoWithCurrencyRequest :> Post '[JSON] UtxosResponse
+    :<|> "txs" :> Description "Get transactions from a list of their ids." :> ReqBody '[JSON] [TxId] :> Post '[JSON] [ChainIndexTx]
     :<|> "txo-at-address" :> Description "Get TxOs at an address." :> ReqBody '[JSON] TxoAtAddressRequest :> Post '[JSON] TxosResponse
     :<|> "tip" :> Description "Get the current synced tip." :> Get '[JSON] Tip
     :<|> "collect-garbage" :> Description "Collect chain index garbage to free up space." :> Put '[JSON] NoContent

plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs

@@ -26,13 +26,14 @@ import Control.Monad.Freer.Reader (Reader, ask)
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.Proxy (Proxy (..))
 import Ledger (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator,
-               StakeValidatorHash, Validator, ValidatorHash)
+               StakeValidatorHash, TxId, Validator, ValidatorHash)
 import Ledger.Tx (ChainIndexTxOut, TxOutRef)
 import Network.HTTP.Types.Status (Status (..))
 import Plutus.ChainIndex.Api (API, IsUtxoResponse, TxoAtAddressRequest (TxoAtAddressRequest), TxosResponse,
                               UtxoAtAddressRequest (UtxoAtAddressRequest),
                               UtxoWithCurrencyRequest (UtxoWithCurrencyRequest), UtxosResponse)
 import Plutus.ChainIndex.Effects (ChainIndexQueryEffect (..))
+import Plutus.ChainIndex.Tx (ChainIndexTx)
 import Plutus.ChainIndex.Types (Tip)
 import Servant (NoContent, (:<|>) (..))
 import Servant.Client (ClientEnv, ClientError (..), ClientM, client, runClientM)
@@ -48,21 +49,27 @@ getMintingPolicy :: MintingPolicyHash -> ClientM MintingPolicy
 getStakeValidator :: StakeValidatorHash -> ClientM StakeValidator
 getRedeemer :: RedeemerHash -> ClientM Redeemer
 
+getTxOut :: TxOutRef -> ClientM ChainIndexTxOut
+getTx :: TxId -> ClientM ChainIndexTx
 getUnspentTxOut :: TxOutRef -> ClientM ChainIndexTxOut
 getIsUtxo :: TxOutRef -> ClientM IsUtxoResponse
 getUtxoSetAtAddress :: UtxoAtAddressRequest -> ClientM UtxosResponse
 getUtxoSetWithCurrency :: UtxoWithCurrencyRequest -> ClientM UtxosResponse
+getTxs :: [TxId] -> ClientM [ChainIndexTx]
 getTxoSetAtAddress :: TxoAtAddressRequest -> ClientM TxosResponse
 getTip :: ClientM Tip
 
-(healthCheck, (getDatum, getValidator, getMintingPolicy, getStakeValidator, getRedeemer), getUnspentTxOut, getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxoSetAtAddress, getTip, collectGarbage) =
-    (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getUnspentTxOut_, getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, getTxoSetAtAddress_, getTip_, collectGarbage_) where
+(healthCheck, (getDatum, getValidator, getMintingPolicy, getStakeValidator, getRedeemer), getTxOut, getUnspentTxOut, getTx, getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxs, getTxoSetAtAddress, getTip, collectGarbage) =
+    (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getTxOut_, getUnspentTxOut_, getTx_, getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, getTxs_, getTxoSetAtAddress_, getTip_, collectGarbage_) where
         healthCheck_
             :<|> (getDatum_ :<|> getValidator_ :<|> getMintingPolicy_ :<|> getStakeValidator_ :<|> getRedeemer_)
+            :<|> getTxOut_
             :<|> getUnspentTxOut_
+            :<|> getTx_
             :<|> getIsUtxo_
             :<|> getUtxoSetAtAddress_
             :<|> getUtxoSetWithCurrency_
+            :<|> getTxs_
             :<|> getTxoSetAtAddress_
             :<|> getTip_
             :<|> collectGarbage_
@@ -99,9 +106,12 @@ handleChainIndexClient event = do
         MintingPolicyFromHash d  -> runClientMaybe (getMintingPolicy d)
         StakeValidatorFromHash d -> runClientMaybe (getStakeValidator d)
         RedeemerFromHash d       -> runClientMaybe (getRedeemer d)
+        TxFromTxId t             -> runClientMaybe (getTx t)
+        TxOutFromRef r           -> runClientMaybe (getTxOut r)
         UnspentTxOutFromRef r    -> runClientMaybe (getUnspentTxOut r)
         UtxoSetMembership r      -> runClient (getIsUtxo r)
         UtxoSetAtAddress pq a    -> runClient (getUtxoSetAtAddress $ UtxoAtAddressRequest (Just pq) a)
         UtxoSetWithCurrency pq a -> runClient (getUtxoSetWithCurrency $ UtxoWithCurrencyRequest (Just pq) a)
+        TxsFromTxIds t           -> runClient (getTxs t)
         TxoSetAtAddress pq a     -> runClient (getTxoSetAtAddress $ TxoAtAddressRequest (Just pq) a)
         GetTip                   -> runClient getTip

plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs

@@ -77,6 +77,17 @@ instance Table RedeemerRowT where
     data PrimaryKey RedeemerRowT f = RedeemerRowId (Columnar f ByteString) deriving (Generic, Beamable)
     primaryKey = RedeemerRowId . _redeemerRowHash
 
+data TxRowT f = TxRow
+    { _txRowTxId :: Columnar f ByteString
+    , _txRowTx   :: Columnar f ByteString
+    } deriving (Generic, Beamable)
+
+type TxRow = TxRowT Identity
+
+instance Table TxRowT where
+    data PrimaryKey TxRowT f = TxRowId (Columnar f ByteString) deriving (Generic, Beamable)
+    primaryKey = TxRowId . _txRowTxId
+
 data AddressRowT f = AddressRow
     { _addressRowCred   :: Columnar f ByteString
     , _addressRowOutRef :: Columnar f ByteString
@@ -164,6 +175,7 @@ data Db f = Db
     { datumRows          :: f (TableEntity DatumRowT)
     , scriptRows         :: f (TableEntity ScriptRowT)
     , redeemerRows       :: f (TableEntity RedeemerRowT)
+    , txRows             :: f (TableEntity TxRowT)
     , utxoOutRefRows     :: f (TableEntity UtxoRowT)
     , addressRows        :: f (TableEntity AddressRowT)
     , assetClassRows     :: f (TableEntity AssetClassRowT)
@@ -176,6 +188,7 @@ type AllTables (c :: * -> Constraint) f =
     ( c (f (TableEntity DatumRowT))
     , c (f (TableEntity ScriptRowT))
     , c (f (TableEntity RedeemerRowT))
+    , c (f (TableEntity TxRowT))
     , c (f (TableEntity UtxoRowT))
     , c (f (TableEntity AddressRowT))
     , c (f (TableEntity AssetClassRowT))
@@ -195,6 +208,7 @@ checkedSqliteDb = defaultMigratableDbSettings
     { datumRows   = renameCheckedEntity (const "datums")
     , scriptRows  = renameCheckedEntity (const "scripts")
     , redeemerRows = renameCheckedEntity (const "redeemers")
+    , txRows = renameCheckedEntity (const "txs")
     , utxoOutRefRows = renameCheckedEntity (const "utxo_out_refs")
     , addressRows = renameCheckedEntity (const "addresses")
     , assetClassRows = renameCheckedEntity (const "asset_classes")
@@ -279,6 +293,11 @@ instance HasDbType (RedeemerHash, Redeemer) where
     toDbValue (hash, redeemer) = RedeemerRow (toDbValue hash) (toDbValue redeemer)
     fromDbValue (RedeemerRow hash redeemer) = (fromDbValue hash, fromDbValue redeemer)
 
+instance HasDbType (TxId, ChainIndexTx) where
+    type DbType (TxId, ChainIndexTx) = TxRow
+    toDbValue (txId, tx) = TxRow (toDbValue txId) (toDbValue tx)
+    fromDbValue (TxRow txId tx) = (fromDbValue txId, fromDbValue tx)
+
 instance HasDbType (Credential, TxOutRef) where
     type DbType (Credential, TxOutRef) = AddressRow
     toDbValue (cred, outRef) = AddressRow (toDbValue cred) (toDbValue outRef)

plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs

@@ -11,11 +11,14 @@ module Plutus.ChainIndex.Effects(
     , mintingPolicyFromHash
     , stakeValidatorFromHash
     , redeemerFromHash
+    , txOutFromRef
     , unspentTxOutFromRef
+    , txFromTxId
     , utxoSetMembership
     , utxoSetAtAddress
     , utxoSetWithCurrency
     , txoSetAtAddress
+    , txsFromTxIds
     , getTip
     -- * Control effect
     , ChainIndexControlEffect(..)
@@ -29,10 +32,11 @@ module Plutus.ChainIndex.Effects(
 import Control.Monad.Freer.Extras.Pagination (PageQuery)
 import Control.Monad.Freer.TH (makeEffect)
 import Ledger (AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator,
-               StakeValidatorHash, Validator, ValidatorHash)
+               StakeValidatorHash, TxId, Validator, ValidatorHash)
 import Ledger.Credential (Credential)
 import Ledger.Tx (ChainIndexTxOut, TxOutRef)
 import Plutus.ChainIndex.Api (IsUtxoResponse, TxosResponse, UtxosResponse)
+import Plutus.ChainIndex.Tx (ChainIndexTx)
 import Plutus.ChainIndex.Types (ChainSyncBlock, Diagnostics, Point, Tip)
 
 data ChainIndexQueryEffect r where
@@ -55,6 +59,12 @@ data ChainIndexQueryEffect r where
     -- | Get the TxOut from a TxOutRef (if available)
     UnspentTxOutFromRef :: TxOutRef -> ChainIndexQueryEffect (Maybe ChainIndexTxOut)
 
+    -- | Get the TxOut from a TxOutRef (if available)
+    TxOutFromRef :: TxOutRef -> ChainIndexQueryEffect (Maybe ChainIndexTxOut)
+
+    -- | Get the transaction for a tx ID
+    TxFromTxId :: TxId -> ChainIndexQueryEffect (Maybe ChainIndexTx)
+
     -- | Whether a tx output is part of the UTXO set
     UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse
 
@@ -67,6 +77,9 @@ data ChainIndexQueryEffect r where
     -- anything, as this request will always return all unspent outputs.
     UtxoSetWithCurrency :: PageQuery TxOutRef -> AssetClass -> ChainIndexQueryEffect UtxosResponse
 
+    -- | Get the transactions for a list of tx IDs.
+    TxsFromTxIds :: [TxId] -> ChainIndexQueryEffect [ChainIndexTx]
+
     -- | Outputs located at addresses with the given credential.
     TxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect TxosResponse
 

plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs

@@ -146,9 +146,11 @@ fromTx tx =
 diagnostics :: DiskState -> Diagnostics
 diagnostics DiskState{_DataMap, _ScriptMap, _TxMap, _RedeemerMap, _AddressMap, _AssetClassMap} =
     Diagnostics
-        { numScripts = toInteger $ Map.size _ScriptMap
+        { numTransactions = toInteger $ Map.size _TxMap
+        , numScripts = toInteger $ Map.size _ScriptMap
         , numAddresses = toInteger $ Map.size $ _unCredentialMap _AddressMap
         , numAssetClasses = toInteger $ Map.size $ _unAssetClassMap _AssetClassMap
+        , someTransactions = take 10 $ fmap fst $ Map.toList _TxMap
         -- These 2 are filled in Handlers.hs
         , numUnmatchedInputs = 0
         , numUnspentOutputs = 0

plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs

@@ -76,14 +76,14 @@ getTxFromTxId i = do
         _       -> pure result
 
 -- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
-getUtxoutFromRef ::
+getTxOutFromRef ::
   forall effs.
   ( Member (State ChainIndexEmulatorState) effs
   , Member (LogMsg ChainIndexLog) effs
   )
   => TxOutRef
   -> Eff effs (Maybe ChainIndexTxOut)
-getUtxoutFromRef ref@TxOutRef{txOutRefId, txOutRefIdx} = do
+getTxOutFromRef ref@TxOutRef{txOutRefId, txOutRefIdx} = do
   ds <- gets (view diskState)
   -- Find the output in the tx matching the output ref
   case preview (txMap . ix txOutRefId . citxOutputs . _ValidTx . ix (fromIntegral txOutRefIdx)) ds of
@@ -120,8 +120,10 @@ handleQuery = \case
       gets (fmap (fmap MintingPolicy) . view $ diskState . scriptMap . at (ScriptHash h))
     StakeValidatorFromHash (StakeValidatorHash h) ->
       gets (fmap (fmap StakeValidator) . view $ diskState . scriptMap . at (ScriptHash h))
-    UnspentTxOutFromRef ref -> getUtxoutFromRef ref
+    UnspentTxOutFromRef ref -> getTxOutFromRef ref
+    TxOutFromRef ref -> getTxOutFromRef ref
     RedeemerFromHash h -> gets (view $ diskState . redeemerMap . at h)
+    TxFromTxId i -> getTxFromTxId i
     UtxoSetMembership r -> do
         utxo <- gets (utxoState . view utxoIndex)
         case tip utxo of
@@ -150,6 +152,7 @@ handleQuery = \case
                 logWarn TipIsGenesis
                 pure (UtxosResponse TipAtGenesis (pageOf pageQuery Set.empty))
             tp           -> pure (UtxosResponse tp page)
+    TxsFromTxIds is -> catMaybes <$> mapM getTxFromTxId is
     TxoSetAtAddress pageQuery cred -> do
         state <- get
         let outRefs = view (diskState . addressMap . at cred) state