SCP-3501: Remove txs from chain index

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

@@ -25,10 +25,9 @@ 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, TxId, Validator, ValidatorHash)
+               StakeValidatorHash, 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, (:<|>), (:>))
@@ -146,12 +145,10 @@ data TxosResponse = TxosResponse
 type API
     = "healthcheck" :> Description "Is the server alive?" :> Get '[JSON] NoContent
     :<|> "from-hash" :> FromHashAPI
-    :<|> "tx-out" :> Description "Get a 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
+    :<|> "unspent-tx-out" :> Description "Get an unspent transaction output from its reference." :> ReqBody '[JSON] TxOutRef :> Post '[JSON] ChainIndexTxOut
     :<|> "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

@@ -11,12 +11,10 @@ module Plutus.ChainIndex.Client(
     , getValidator
     , getMintingPolicy
     , getStakeValidator
-    , getTxOut
-    , getTx
+    , getUnspentTxOut
     , getIsUtxo
     , getUtxoSetAtAddress
     , getUtxoSetWithCurrency
-    , getTxs
     , getTxoSetAtAddress
     , getTip
     , collectGarbage
@@ -28,14 +26,13 @@ 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, TxId, Validator, ValidatorHash)
+               StakeValidatorHash, 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)
@@ -51,25 +48,21 @@ 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), getTxOut, getTx, getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxs, getTxoSetAtAddress, getTip, collectGarbage) =
-    (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getTxOut_, getTx_, getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, getTxs_, getTxoSetAtAddress_, getTip_, collectGarbage_) where
+(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_
-            :<|> getTx_
+            :<|> getUnspentTxOut_
             :<|> getIsUtxo_
             :<|> getUtxoSetAtAddress_
             :<|> getUtxoSetWithCurrency_
-            :<|> getTxs_
             :<|> getTxoSetAtAddress_
             :<|> getTip_
             :<|> collectGarbage_
@@ -106,11 +99,9 @@ handleChainIndexClient event = do
         MintingPolicyFromHash d  -> runClientMaybe (getMintingPolicy d)
         StakeValidatorFromHash d -> runClientMaybe (getStakeValidator d)
         RedeemerFromHash d       -> runClientMaybe (getRedeemer d)
-        TxOutFromRef r           -> runClientMaybe (getTxOut r)
-        TxFromTxId t             -> runClientMaybe (getTx t)
+        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

@@ -36,9 +36,9 @@ import Database.Beam (Beamable, Columnar, Database, DatabaseSettings, FromBacken
 import Database.Beam.Migrate (CheckedDatabaseSettings, defaultMigratableDbSettings, renameCheckedEntity,
                               unCheckDatabase)
 import Database.Beam.Sqlite (Sqlite)
-import Ledger (AssetClass, BlockId (..), Datum, DatumHash (..), MintingPolicy, MintingPolicyHash (..), Redeemer,
-               RedeemerHash (..), Script, ScriptHash (..), Slot, StakeValidator, StakeValidatorHash (..), TxId (..),
-               TxOutRef (..), Validator, ValidatorHash (..))
+import Ledger (AssetClass, BlockId (..), ChainIndexTxOut (..), Datum, DatumHash (..), MintingPolicy,
+               MintingPolicyHash (..), Redeemer, RedeemerHash (..), Script, ScriptHash (..), Slot, StakeValidator,
+               StakeValidatorHash (..), TxId (..), TxOut, TxOutRef (..), Validator, ValidatorHash (..))
 import Plutus.ChainIndex.Tx (ChainIndexTx)
 import Plutus.ChainIndex.Types (BlockNumber (..), Tip (..))
 import Plutus.V1.Ledger.Api (Credential)
@@ -77,17 +77,6 @@ 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
@@ -160,11 +149,22 @@ instance Table UnmatchedInputRowT where
     data PrimaryKey UnmatchedInputRowT f = UnmatchedInputRowId (PrimaryKey TipRowT f) (Columnar f ByteString) deriving (Generic, Beamable)
     primaryKey (UnmatchedInputRow t o) = UnmatchedInputRowId t o
 
+data UtxoRowT f = UtxoRow
+    { _utxoRowOutRef :: Columnar f ByteString
+    , _utxoRowTxOut  :: Columnar f ByteString
+    } deriving (Generic, Beamable)
+
+type UtxoRow = UtxoRowT Identity
+
+instance Table UtxoRowT where
+    data PrimaryKey UtxoRowT f = UtxoRowOutRef (Columnar f ByteString) deriving (Generic, Beamable)
+    primaryKey = UtxoRowOutRef . _utxoRowOutRef
+
 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)
     , tipRows            :: f (TableEntity TipRowT)
@@ -176,7 +176,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))
     , c (f (TableEntity TipRowT))
@@ -195,7 +195,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")
     , tipRows     = renameCheckedEntity (const "tips")
@@ -240,7 +240,9 @@ deriving via Serialisable Redeemer instance HasDbType Redeemer
 deriving via Serialisable StakeValidator instance HasDbType StakeValidator
 deriving via Serialisable Validator instance HasDbType Validator
 deriving via Serialisable ChainIndexTx instance HasDbType ChainIndexTx
+deriving via Serialisable ChainIndexTxOut instance HasDbType ChainIndexTxOut
 deriving via Serialisable TxOutRef instance HasDbType TxOutRef
+deriving via Serialisable TxOut instance HasDbType TxOut
 deriving via Serialisable Credential instance HasDbType Credential
 deriving via Serialisable AssetClass instance HasDbType AssetClass
 deriving via Serialisable Script instance HasDbType Script
@@ -277,10 +279,10 @@ 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 (TxOutRef, TxOut) where
+--     type DbType (TxOutRef, TxOut) = UtxoRow
+--     toDbValue (outRef, txOut) = UtxoRow (toDbValue outRef) (toDbValue txOut)
+--     fromDbValue (UtxoRow outRef txOut) = (fromDbValue outRef, fromDbValue txOut)
 
 instance HasDbType (Credential, TxOutRef) where
     type DbType (Credential, TxOutRef) = AddressRow

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

@@ -11,12 +11,10 @@ module Plutus.ChainIndex.Effects(
     , mintingPolicyFromHash
     , stakeValidatorFromHash
     , redeemerFromHash
-    , txOutFromRef
-    , txFromTxId
+    , unspentTxOutFromRef
     , utxoSetMembership
     , utxoSetAtAddress
     , utxoSetWithCurrency
-    , txsFromTxIds
     , txoSetAtAddress
     , getTip
     -- * Control effect
@@ -31,11 +29,10 @@ 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, TxId, Validator, ValidatorHash)
+               StakeValidatorHash, 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
@@ -56,10 +53,7 @@ data ChainIndexQueryEffect r where
     StakeValidatorFromHash :: StakeValidatorHash -> ChainIndexQueryEffect (Maybe StakeValidator)
 
     -- | 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)
+    UnspentTxOutFromRef :: TxOutRef -> ChainIndexQueryEffect (Maybe ChainIndexTxOut)
 
     -- | Whether a tx output is part of the UTXO set
     UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse
@@ -73,9 +67,6 @@ 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,11 +146,9 @@ fromTx tx =
 diagnostics :: DiskState -> Diagnostics
 diagnostics DiskState{_DataMap, _ScriptMap, _TxMap, _RedeemerMap, _AddressMap, _AssetClassMap} =
     Diagnostics
-        { numTransactions = toInteger $ Map.size _TxMap
-        , numScripts = toInteger $ Map.size _ScriptMap
+        { 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

@@ -75,14 +75,14 @@ getTxFromTxId i = do
         _       -> pure result
 
 -- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
-getTxOutFromRef ::
+getUtxoutFromRef ::
   forall effs.
   ( Member (State ChainIndexEmulatorState) effs
   , Member (LogMsg ChainIndexLog) effs
   )
   => TxOutRef
   -> Eff effs (Maybe ChainIndexTxOut)
-getTxOutFromRef ref@TxOutRef{txOutRefId, txOutRefIdx} = do
+getUtxoutFromRef 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
@@ -119,9 +119,8 @@ 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))
-    TxOutFromRef ref -> getTxOutFromRef ref
+    UnspentTxOutFromRef ref -> getUtxoutFromRef 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,7 +149,6 @@ 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