From 2eb4f9ea918450762dd262b11d1dd20fbf346a6a Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Wed, 16 Feb 2022 18:06:31 +0500 Subject: [PATCH 01/17] Remove txs from chain index --- .../src/Plutus/ChainIndex/Api.hs | 8 +- .../src/Plutus/ChainIndex/Client.hs | 16 +--- .../src/Plutus/ChainIndex/DbSchema.hs | 19 ----- .../src/Plutus/ChainIndex/Effects.hs | 15 +--- .../Plutus/ChainIndex/Emulator/DiskState.hs | 4 +- .../Plutus/ChainIndex/Emulator/Handlers.hs | 33 -------- .../src/Plutus/ChainIndex/Handlers.hs | 78 +------------------ .../src/Plutus/ChainIndex/Server.hs | 3 - .../src/Plutus/ChainIndex/Types.hs | 4 +- .../ChainIndex/Emulator/HandlersSpec.hs | 49 ++---------- .../test/Plutus/ChainIndex/HandlersSpec.hs | 42 +--------- 11 files changed, 16 insertions(+), 255 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs index 3c7eb820d6..b2e8aa21f8 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs +++ b/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 Ledger.Tx (TxOutRef) import Plutus.ChainIndex.Types (Diagnostics, Tip) import Servant qualified import Servant.API (Description, Get, JSON, NoContent, Post, Put, ReqBody, (:<|>), (:>)) @@ -146,12 +145,9 @@ 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 :<|> "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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs index 00e10c0972..444debbc3b 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs @@ -11,12 +11,9 @@ module Plutus.ChainIndex.Client( , getValidator , getMintingPolicy , getStakeValidator - , getTxOut - , getTx , getIsUtxo , getUtxoSetAtAddress , getUtxoSetWithCurrency - , getTxs , getTxoSetAtAddress , getTip , collectGarbage @@ -51,25 +48,19 @@ getMintingPolicy :: MintingPolicyHash -> ClientM MintingPolicy getStakeValidator :: StakeValidatorHash -> ClientM StakeValidator getRedeemer :: RedeemerHash -> ClientM Redeemer -getTxOut :: TxOutRef -> ClientM ChainIndexTxOut -getTx :: TxId -> ClientM ChainIndexTx 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), getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxoSetAtAddress, getTip, collectGarbage) = + (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, getTxoSetAtAddress_, getTip_, collectGarbage_) where healthCheck_ :<|> (getDatum_ :<|> getValidator_ :<|> getMintingPolicy_ :<|> getStakeValidator_ :<|> getRedeemer_) - :<|> getTxOut_ - :<|> getTx_ :<|> getIsUtxo_ :<|> getUtxoSetAtAddress_ :<|> getUtxoSetWithCurrency_ - :<|> getTxs_ :<|> getTxoSetAtAddress_ :<|> getTip_ :<|> collectGarbage_ @@ -106,11 +97,8 @@ 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) 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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs index 6efc291d82..8c4f109c41 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs @@ -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 @@ -164,7 +153,6 @@ data Db f = Db { datumRows :: f (TableEntity DatumRowT) , scriptRows :: f (TableEntity ScriptRowT) , redeemerRows :: f (TableEntity RedeemerRowT) - , txRows :: f (TableEntity TxRowT) , addressRows :: f (TableEntity AddressRowT) , assetClassRows :: f (TableEntity AssetClassRowT) , tipRows :: f (TableEntity TipRowT) @@ -176,7 +164,6 @@ type AllTables (c :: * -> Constraint) f = ( c (f (TableEntity DatumRowT)) , c (f (TableEntity ScriptRowT)) , c (f (TableEntity RedeemerRowT)) - , c (f (TableEntity TxRowT)) , c (f (TableEntity AddressRowT)) , c (f (TableEntity AssetClassRowT)) , c (f (TableEntity TipRowT)) @@ -195,7 +182,6 @@ checkedSqliteDb = defaultMigratableDbSettings { datumRows = renameCheckedEntity (const "datums") , scriptRows = renameCheckedEntity (const "scripts") , redeemerRows = renameCheckedEntity (const "redeemers") - , txRows = renameCheckedEntity (const "txs") , addressRows = renameCheckedEntity (const "addresses") , assetClassRows = renameCheckedEntity (const "asset_classes") , tipRows = renameCheckedEntity (const "tips") @@ -277,11 +263,6 @@ 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) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs index ed7b66e1b4..2a5218b5f3 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs @@ -11,12 +11,9 @@ module Plutus.ChainIndex.Effects( , mintingPolicyFromHash , stakeValidatorFromHash , redeemerFromHash - , txOutFromRef - , txFromTxId , utxoSetMembership , utxoSetAtAddress , utxoSetWithCurrency - , txsFromTxIds , txoSetAtAddress , getTip -- * Control effect @@ -33,9 +30,8 @@ import Control.Monad.Freer.TH (makeEffect) import Ledger (AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, StakeValidatorHash, TxId, Validator, ValidatorHash) import Ledger.Credential (Credential) -import Ledger.Tx (ChainIndexTxOut, TxOutRef) +import Ledger.Tx (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,12 +51,6 @@ data ChainIndexQueryEffect r where -- | Get the stake validator from a stake validator hash (if available) 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) - -- | Whether a tx output is part of the UTXO set UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse @@ -73,9 +63,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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs index 8400511787..294401b1cf 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs +++ b/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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs index 8a98575931..91d05a80e3 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs @@ -74,36 +74,6 @@ getTxFromTxId i = do Nothing -> logWarn (TxNotFound i) >> pure Nothing _ -> pure result --- | Get the 'ChainIndexTxOut' for a 'TxOutRef'. -getTxOutFromRef :: - forall effs. - ( Member (State ChainIndexEmulatorState) effs - , Member (LogMsg ChainIndexLog) effs - ) - => TxOutRef - -> Eff effs (Maybe ChainIndexTxOut) -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 - Nothing -> logWarn (TxOutNotFound ref) >> pure Nothing - Just txout -> do - -- The output might come from a public key address or a script address. - -- We need to handle them differently. - case addressCredential $ txOutAddress txout of - PubKeyCredential _ -> - pure $ Just $ PublicKeyChainIndexTxOut (txOutAddress txout) (txOutValue txout) - ScriptCredential vh@(ValidatorHash h) -> do - case txOutDatumHash txout of - Nothing -> do - -- If the txout comes from a script address, the Datum should not be Nothing - logWarn $ NoDatumScriptAddr txout - pure Nothing - Just dh -> do - let v = maybe (Left vh) (Right . Validator) $ preview (scriptMap . ix (ScriptHash h)) ds - let d = maybe (Left dh) Right $ preview (dataMap . ix dh) ds - pure $ Just $ ScriptChainIndexTxOut (txOutAddress txout) v d (txOutValue txout) - handleQuery :: forall effs. ( Member (State ChainIndexEmulatorState) effs @@ -119,9 +89,7 @@ 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 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 +118,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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index b87cab96ef..0f267445ba 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -82,8 +82,6 @@ handleQuery = \case MintingPolicyFromHash hash -> getScriptFromHash hash RedeemerFromHash hash -> getRedeemerFromHash hash StakeValidatorFromHash hash -> getScriptFromHash hash - TxFromTxId txId -> getTxFromTxId txId - TxOutFromRef tor -> getTxOutFromRef tor UtxoSetMembership r -> do utxoState <- gets @ChainIndexState UtxoState.utxoState case UtxoState.tip utxoState of @@ -93,7 +91,6 @@ handleQuery = \case UtxoSetWithCurrency pageQuery assetClass -> getUtxoSetWithCurrency pageQuery assetClass TxoSetAtAddress pageQuery cred -> getTxoSetAtAddress pageQuery cred - TxsFromTxIds txids -> getTxsFromTxIds txids GetTip -> getTip getTip :: Member BeamEffect effs => Eff effs Tip @@ -102,9 +99,6 @@ getTip = fmap fromDbValue . selectOne . select $ limit_ 1 (orderBy_ (desc_ . _ti getDatumFromHash :: Member BeamEffect effs => DatumHash -> Eff effs (Maybe Datum) getDatumFromHash = queryOne . queryKeyValue datumRows _datumRowHash _datumRowDatum -getTxFromTxId :: Member BeamEffect effs => TxId -> Eff effs (Maybe ChainIndexTx) -getTxFromTxId = queryOne . queryKeyValue txRows _txRowTxId _txRowTx - getScriptFromHash :: ( Member BeamEffect effs , HasDbType i @@ -144,43 +138,6 @@ queryOne :: -> Eff effs (Maybe o) queryOne = fmap (fmap fromDbValue) . selectOne -queryList :: - ( Member BeamEffect effs - , HasDbType o - ) => SqlSelect Sqlite (DbType o) - -> Eff effs [o] -queryList = fmap (fmap fromDbValue) . selectList - --- | Get the 'ChainIndexTxOut' for a 'TxOutRef'. -getTxOutFromRef :: - forall effs. - ( Member BeamEffect effs - , Member (LogMsg ChainIndexLog) effs - ) - => TxOutRef - -> Eff effs (Maybe ChainIndexTxOut) -getTxOutFromRef ref@TxOutRef{txOutRefId, txOutRefIdx} = do - mTx <- getTxFromTxId txOutRefId - -- Find the output in the tx matching the output ref - case mTx ^? _Just . citxOutputs . _ValidTx . ix (fromIntegral txOutRefIdx) of - Nothing -> logWarn (TxOutNotFound ref) >> pure Nothing - Just txout -> do - -- The output might come from a public key address or a script address. - -- We need to handle them differently. - case addressCredential $ txOutAddress txout of - PubKeyCredential _ -> - pure $ Just $ PublicKeyChainIndexTxOut (txOutAddress txout) (txOutValue txout) - ScriptCredential vh -> do - case txOutDatumHash txout of - Nothing -> do - -- If the txout comes from a script address, the Datum should not be Nothing - logWarn $ NoDatumScriptAddr txout - pure Nothing - Just dh -> do - v <- maybe (Left vh) Right <$> getScriptFromHash vh - d <- maybe (Left dh) Right <$> getDatumFromHash dh - pure $ Just $ ScriptChainIndexTxOut (txOutAddress txout) v d (txOutValue txout) - getUtxoSetAtAddress :: forall effs. ( Member (State ChainIndexState) effs @@ -243,23 +200,6 @@ getUtxoSetWithCurrency pageQuery (toDbValue -> assetClass) = do pure (UtxosResponse tp page) -getTxsFromTxIds - :: forall effs. - ( Member BeamEffect effs - ) - => [TxId] - -> Eff effs [ChainIndexTx] -getTxsFromTxIds txIds = - do - let - txIds' = toDbValue <$> txIds - query = - fmap _txRowTx - $ filter_ (\row -> _txRowTxId row `in_` fmap val_ txIds') - $ all_ (txRows db) - txs <- selectList $ select query - pure $ fmap fromDbValue txs - getTxoSetAtAddress :: forall effs. ( Member (State ChainIndexState) effs @@ -329,22 +269,13 @@ handleControl = \case newState <- restoreStateFromDb put newState CollectGarbage -> do - -- Rebuild the index using only transactions that still have at - -- least one output in the UTXO set - utxos <- gets $ - Set.toList - . Set.map txOutRefId - . TxUtxoBalance.unspentOutputs - . UtxoState.utxoState - insertRows <- foldMap fromTx . catMaybes <$> mapM getTxFromTxId utxos combined $ [ DeleteRows $ truncateTable (datumRows db) , DeleteRows $ truncateTable (scriptRows db) , DeleteRows $ truncateTable (redeemerRows db) - , DeleteRows $ truncateTable (txRows db) , DeleteRows $ truncateTable (addressRows db) , DeleteRows $ truncateTable (assetClassRows db) - ] ++ getConst (zipTables Proxy (\tbl (InsertRows rows) -> Const [AddRowsInBatches batchSize tbl rows]) db insertRows) + ] -- ++ getConst (zipTables Proxy (\tbl (InsertRows rows) -> Const [AddRowsInBatches batchSize tbl rows]) db) where truncateTable table = delete table (const (val_ True)) GetDiagnostics -> diagnostics @@ -439,7 +370,6 @@ fromTx tx = mempty { datumRows = fromMap citxData , scriptRows = fromMap citxScripts , redeemerRows = fromMap citxRedeemers - , txRows = InsertRows [toDbValue (_citxTxId tx, tx)] , addressRows = fromPairs (fmap credential . txOutsWithRef) , assetClassRows = fromPairs (concatMap assetClasses . txOutsWithRef) } @@ -470,19 +400,15 @@ diagnostics :: , Member (State ChainIndexState) effs ) => Eff effs Diagnostics diagnostics = do - numTransactions <- selectOne . select $ aggregate_ (const countAll_) (all_ (txRows db)) - txIds <- queryList . select $ _txRowTxId <$> limit_ 10 (all_ (txRows db)) numScripts <- selectOne . select $ aggregate_ (const countAll_) (all_ (scriptRows db)) numAddresses <- selectOne . select $ aggregate_ (const countAll_) $ nub_ $ _addressRowCred <$> all_ (addressRows db) numAssetClasses <- selectOne . select $ aggregate_ (const countAll_) $ nub_ $ _assetClassRowAssetClass <$> all_ (assetClassRows db) TxUtxoBalance outputs inputs <- UtxoState._usTxUtxoData . UtxoState.utxoState <$> get @ChainIndexState pure $ Diagnostics - { numTransactions = fromMaybe (-1) numTransactions - , numScripts = fromMaybe (-1) numScripts + { numScripts = fromMaybe (-1) numScripts , numAddresses = fromMaybe (-1) numAddresses , numAssetClasses = fromMaybe (-1) numAssetClasses , numUnspentOutputs = length outputs , numUnmatchedInputs = length inputs - , someTransactions = txIds } diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs index 79f4f173ce..c69759bde0 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs @@ -61,12 +61,9 @@ serveChainIndex :: serveChainIndex = pure NoContent :<|> serveFromHashApi - :<|> (E.txOutFromRef >=> handleMaybe) - :<|> (E.txFromTxId >=> handleMaybe) :<|> E.utxoSetMembership :<|> (\(UtxoAtAddressRequest pq c) -> E.utxoSetAtAddress (fromMaybe def pq) c) :<|> (\(UtxoWithCurrencyRequest pq c) -> E.utxoSetWithCurrency (fromMaybe def pq) c) - :<|> E.txsFromTxIds :<|> (\(TxoAtAddressRequest pq c) -> E.txoSetAtAddress (fromMaybe def pq) c) :<|> E.getTip :<|> E.collectGarbage *> pure NoContent diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs index f33ca2af99..7235833de5 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs @@ -264,13 +264,11 @@ liftTxOutStatus = void data Diagnostics = Diagnostics - { numTransactions :: Integer - , numScripts :: Integer + { numScripts :: Integer , numAddresses :: Integer , numAssetClasses :: Integer , numUnspentOutputs :: Int , numUnmatchedInputs :: Int - , someTransactions :: [TxId] } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON, FromJSON, OpenApi.ToSchema) diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs index e533ad9e64..9c74cf0ff5 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs @@ -21,14 +21,13 @@ import Data.Sequence (Seq) import Data.Set qualified as S import Generators qualified as Gen import Ledger (outValue) -import Plutus.ChainIndex (ChainIndexLog, Page (pageItems), PageQuery (PageQuery), appendBlock, txFromTxId, - utxoSetMembership, utxoSetWithCurrency) -import Plutus.ChainIndex.Api (IsUtxoResponse (isUtxo), UtxosResponse (UtxosResponse)) +import Plutus.ChainIndex (ChainIndexLog, Page (pageItems), PageQuery (PageQuery), appendBlock, utxoSetWithCurrency) +import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse)) import Plutus.ChainIndex.ChainIndexError (ChainIndexError) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect) import Plutus.ChainIndex.Emulator.Handlers (ChainIndexEmulatorState, handleControl, handleQuery) -import Plutus.ChainIndex.Tx (_ValidTx, citxOutputs, citxTxId) -import Plutus.ChainIndex.Types (ChainSyncBlock (..), TxProcessOption (..)) +import Plutus.ChainIndex.Tx (_ValidTx, citxOutputs) +import Plutus.ChainIndex.Types (ChainSyncBlock (..)) import Plutus.V1.Ledger.Value (AssetClass (AssetClass), flattenValue) import Hedgehog (Property, assert, forAll, property, (===)) @@ -39,37 +38,15 @@ import Util (utxoSetFromBlockAddrs) tests :: TestTree tests = do testGroup "chain index emulator handlers" - [ testGroup "txFromTxId" - [ testProperty "get tx from tx id" txFromTxIdSpec - ] - , testGroup "utxoSetAtAddress" + [ testGroup "utxoSetAtAddress" [ testProperty "each txOutRef should be unspent" eachTxOutRefAtAddressShouldBeUnspentSpec ] , testGroup "utxoSetWithCurrency" [ testProperty "each txOutRef should be unspent" eachTxOutRefWithCurrencyShouldBeUnspentSpec , testProperty "should restrict to non-ADA currencies" cantRequestForTxOutRefsWithAdaSpec ] - , testGroup "BlockProcessOption" - [ testProperty "do not store txs" doNotStoreTxs - ] ] --- | Tests we can correctly query a tx in the database using a tx id. We also --- test with an non-existant tx id. -txFromTxIdSpec :: Property -txFromTxIdSpec = property $ do - (tip, block@(fstTx:_)) <- forAll $ Gen.evalTxGenState Gen.genNonEmptyBlock - unknownTxId <- forAll Gen.genRandomTxId - txs <- liftIO $ runEmulatedChainIndex mempty $ do - appendBlock (Block tip (map (, def) block)) - tx <- txFromTxId (view citxTxId fstTx) - tx' <- txFromTxId unknownTxId - pure (tx, tx') - - case txs of - Right (Just tx, Nothing) -> fstTx === tx - _ -> Hedgehog.assert False - -- | After generating and appending a block in the chain index, verify that -- querying the chain index with each of the addresses in the block returns -- unspent 'TxOutRef's. @@ -130,22 +107,6 @@ cantRequestForTxOutRefsWithAdaSpec = property $ do Left _ -> Hedgehog.assert False Right utxoRefs -> Hedgehog.assert $ null utxoRefs --- | Do not store txs through BlockProcessOption. --- The UTxO set must still be stored. --- But cannot be fetched through addresses as addresses are not stored. -doNotStoreTxs :: Property -doNotStoreTxs = property $ do - ((tip, block), state) <- forAll $ Gen.runTxGenState Gen.genNonEmptyBlock - result <- liftIO $ runEmulatedChainIndex mempty $ do - appendBlock (Block tip (map (, TxProcessOption{tpoStoreTx=False}) block)) - tx <- txFromTxId (view citxTxId (head block)) - utxosFromAddr <- utxoSetFromBlockAddrs block - utxosStored <- traverse utxoSetMembership (S.toList (view Gen.txgsUtxoSet state)) - pure (tx, concat utxosFromAddr, utxosStored) - case result of - Right (Nothing, [], utxosStored) -> Hedgehog.assert $ and (isUtxo <$> utxosStored) - _ -> Hedgehog.assert False - -- | Run an emulated chain index effect against a starting state runEmulatedChainIndex :: ChainIndexEmulatorState diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs index 92809408f9..926a51b07d 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs @@ -25,7 +25,7 @@ import Generators qualified as Gen import Hedgehog (MonadTest, Property, assert, failure, forAll, property, (===)) import Ledger (outValue) import Plutus.ChainIndex (Page (pageItems), PageQuery (PageQuery), RunRequirements (..), appendBlock, citxOutputs, - runChainIndexEffects, txFromTxId, utxoSetMembership, utxoSetWithCurrency) + runChainIndexEffects, utxoSetMembership, utxoSetWithCurrency) import Plutus.ChainIndex.Api (IsUtxoResponse (isUtxo), UtxosResponse (UtxosResponse)) import Plutus.ChainIndex.DbSchema (checkedSqliteDb) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect) @@ -40,37 +40,15 @@ import Util (utxoSetFromBlockAddrs) tests :: TestTree tests = do testGroup "chain-index handlers" - [ testGroup "txFromTxId" - [ testProperty "get tx from tx id" txFromTxIdSpec - ] - , testGroup "utxoSetAtAddress" + [ testGroup "utxoSetAtAddress" [ testProperty "each txOutRef should be unspent" eachTxOutRefAtAddressShouldBeUnspentSpec ] , testGroup "utxoSetWithCurrency" [ testProperty "each txOutRef should be unspent" eachTxOutRefWithCurrencyShouldBeUnspentSpec , testProperty "should restrict to non-ADA currencies" cantRequestForTxOutRefsWithAdaSpec ] - , testGroup "BlockProcessOption" - [ testProperty "do not store txs" doNotStoreTxs - ] ] --- | Tests we can correctly query a tx in the database using a tx id. We also --- test with an non-existant tx id. -txFromTxIdSpec :: Property -txFromTxIdSpec = property $ do - (tip, block@(fstTx:_)) <- forAll $ Gen.evalTxGenState Gen.genNonEmptyBlock - unknownTxId <- forAll Gen.genRandomTxId - txs <- runChainIndexTest $ do - appendBlock (Block tip (map (, def) block)) - tx <- txFromTxId (view citxTxId fstTx) - tx' <- txFromTxId unknownTxId - pure (tx, tx') - - case txs of - (Just tx, Nothing) -> fstTx === tx - _ -> Hedgehog.assert False - -- | After generating and appending a block in the chain index, verify that -- querying the chain index with each of the addresses in the block returns -- unspent 'TxOutRef's. @@ -126,22 +104,6 @@ cantRequestForTxOutRefsWithAdaSpec = property $ do Hedgehog.assert $ null utxoRefs --- | Do not store txs through BlockProcessOption. --- The UTxO set must still be stored. --- But cannot be fetched through addresses as addresses are not stored. -doNotStoreTxs :: Property -doNotStoreTxs = property $ do - ((tip, block), state) <- forAll $ Gen.runTxGenState Gen.genNonEmptyBlock - result <- runChainIndexTest $ do - appendBlock (Block tip (map (, TxProcessOption{tpoStoreTx=False}) block)) - tx <- txFromTxId (view citxTxId (head block)) - utxosFromAddr <- utxoSetFromBlockAddrs block - utxosStored <- traverse utxoSetMembership (S.toList (view Gen.txgsUtxoSet state)) - pure (tx, concat utxosFromAddr, utxosStored) - case result of - (Nothing, [], utxosStored) -> Hedgehog.assert $ and (isUtxo <$> utxosStored) - _ -> Hedgehog.assert False - -- | Run a chain index test against an in-memory SQLite database. runChainIndexTest :: (MonadTest m From b617483815e59d4bc0cfe5a1e48b984d91a67432 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Wed, 16 Feb 2022 18:35:17 +0500 Subject: [PATCH 02/17] get TxOutFromRef back --- .../src/Plutus/ChainIndex/Api.hs | 3 +- .../src/Plutus/ChainIndex/Client.hs | 8 +++-- .../src/Plutus/ChainIndex/Effects.hs | 6 +++- .../Plutus/ChainIndex/Emulator/Handlers.hs | 31 +++++++++++++++++ .../src/Plutus/ChainIndex/Handlers.hs | 34 +++++++++++++++++++ .../src/Plutus/ChainIndex/Server.hs | 1 + .../test/Plutus/ChainIndex/HandlersSpec.hs | 8 ++--- 7 files changed, 83 insertions(+), 8 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs index b2e8aa21f8..883089ece0 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs @@ -27,7 +27,7 @@ import GHC.Generics (Generic) import Ledger (AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, StakeValidatorHash, Validator, ValidatorHash) import Ledger.Credential (Credential) -import Ledger.Tx (TxOutRef) +import Ledger.Tx (ChainIndexTxOut, TxOutRef) import Plutus.ChainIndex.Types (Diagnostics, Tip) import Servant qualified import Servant.API (Description, Get, JSON, NoContent, Post, Put, ReqBody, (:<|>), (:>)) @@ -145,6 +145,7 @@ 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 :<|> "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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs index 444debbc3b..a9babd018b 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs @@ -11,6 +11,7 @@ module Plutus.ChainIndex.Client( , getValidator , getMintingPolicy , getStakeValidator + , getTxOut , getIsUtxo , getUtxoSetAtAddress , getUtxoSetWithCurrency @@ -48,16 +49,18 @@ getMintingPolicy :: MintingPolicyHash -> ClientM MintingPolicy getStakeValidator :: StakeValidatorHash -> ClientM StakeValidator getRedeemer :: RedeemerHash -> ClientM Redeemer +getTxOut :: TxOutRef -> ClientM ChainIndexTxOut getIsUtxo :: TxOutRef -> ClientM IsUtxoResponse getUtxoSetAtAddress :: UtxoAtAddressRequest -> ClientM UtxosResponse getUtxoSetWithCurrency :: UtxoWithCurrencyRequest -> ClientM UtxosResponse getTxoSetAtAddress :: TxoAtAddressRequest -> ClientM TxosResponse getTip :: ClientM Tip -(healthCheck, (getDatum, getValidator, getMintingPolicy, getStakeValidator, getRedeemer), getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxoSetAtAddress, getTip, collectGarbage) = - (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, getTxoSetAtAddress_, getTip_, collectGarbage_) where +(healthCheck, (getDatum, getValidator, getMintingPolicy, getStakeValidator, getRedeemer), getTxOut, getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxoSetAtAddress, getTip, collectGarbage) = + (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getTxOut_, getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, getTxoSetAtAddress_, getTip_, collectGarbage_) where healthCheck_ :<|> (getDatum_ :<|> getValidator_ :<|> getMintingPolicy_ :<|> getStakeValidator_ :<|> getRedeemer_) + :<|> getTxOut_ :<|> getIsUtxo_ :<|> getUtxoSetAtAddress_ :<|> getUtxoSetWithCurrency_ @@ -97,6 +100,7 @@ handleChainIndexClient event = do MintingPolicyFromHash d -> runClientMaybe (getMintingPolicy d) StakeValidatorFromHash d -> runClientMaybe (getStakeValidator d) RedeemerFromHash d -> runClientMaybe (getRedeemer d) + TxOutFromRef r -> runClientMaybe (getTxOut r) UtxoSetMembership r -> runClient (getIsUtxo r) UtxoSetAtAddress pq a -> runClient (getUtxoSetAtAddress $ UtxoAtAddressRequest (Just pq) a) UtxoSetWithCurrency pq a -> runClient (getUtxoSetWithCurrency $ UtxoWithCurrencyRequest (Just pq) a) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs index 2a5218b5f3..ce0a79c2cd 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs @@ -11,6 +11,7 @@ module Plutus.ChainIndex.Effects( , mintingPolicyFromHash , stakeValidatorFromHash , redeemerFromHash + , txOutFromRef , utxoSetMembership , utxoSetAtAddress , utxoSetWithCurrency @@ -30,7 +31,7 @@ import Control.Monad.Freer.TH (makeEffect) import Ledger (AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, StakeValidatorHash, TxId, Validator, ValidatorHash) import Ledger.Credential (Credential) -import Ledger.Tx (TxOutRef) +import Ledger.Tx (ChainIndexTxOut, TxOutRef) import Plutus.ChainIndex.Api (IsUtxoResponse, TxosResponse, UtxosResponse) import Plutus.ChainIndex.Types (ChainSyncBlock, Diagnostics, Point, Tip) @@ -51,6 +52,9 @@ data ChainIndexQueryEffect r where -- | Get the stake validator from a stake validator hash (if available) StakeValidatorFromHash :: StakeValidatorHash -> ChainIndexQueryEffect (Maybe StakeValidator) + -- | Get the TxOut from a TxOutRef (if available) + TxOutFromRef :: TxOutRef -> ChainIndexQueryEffect (Maybe ChainIndexTxOut) + -- | Whether a tx output is part of the UTXO set UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs index 91d05a80e3..f0ba118901 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs @@ -74,6 +74,36 @@ getTxFromTxId i = do Nothing -> logWarn (TxNotFound i) >> pure Nothing _ -> pure result +-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'. +getTxOutFromRef :: + forall effs. + ( Member (State ChainIndexEmulatorState) effs + , Member (LogMsg ChainIndexLog) effs + ) + => TxOutRef + -> Eff effs (Maybe ChainIndexTxOut) +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 + Nothing -> logWarn (TxOutNotFound ref) >> pure Nothing + Just txout -> do + -- The output might come from a public key address or a script address. + -- We need to handle them differently. + case addressCredential $ txOutAddress txout of + PubKeyCredential _ -> + pure $ Just $ PublicKeyChainIndexTxOut (txOutAddress txout) (txOutValue txout) + ScriptCredential vh@(ValidatorHash h) -> do + case txOutDatumHash txout of + Nothing -> do + -- If the txout comes from a script address, the Datum should not be Nothing + logWarn $ NoDatumScriptAddr txout + pure Nothing + Just dh -> do + let v = maybe (Left vh) (Right . Validator) $ preview (scriptMap . ix (ScriptHash h)) ds + let d = maybe (Left dh) Right $ preview (dataMap . ix dh) ds + pure $ Just $ ScriptChainIndexTxOut (txOutAddress txout) v d (txOutValue txout) + handleQuery :: forall effs. ( Member (State ChainIndexEmulatorState) effs @@ -89,6 +119,7 @@ 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 RedeemerFromHash h -> gets (view $ diskState . redeemerMap . at h) UtxoSetMembership r -> do utxo <- gets (utxoState . view utxoIndex) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index 0f267445ba..4331238e27 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -82,6 +82,7 @@ handleQuery = \case MintingPolicyFromHash hash -> getScriptFromHash hash RedeemerFromHash hash -> getRedeemerFromHash hash StakeValidatorFromHash hash -> getScriptFromHash hash + TxOutFromRef tor -> getTxOutFromRef tor UtxoSetMembership r -> do utxoState <- gets @ChainIndexState UtxoState.utxoState case UtxoState.tip utxoState of @@ -99,6 +100,9 @@ getTip = fmap fromDbValue . selectOne . select $ limit_ 1 (orderBy_ (desc_ . _ti getDatumFromHash :: Member BeamEffect effs => DatumHash -> Eff effs (Maybe Datum) getDatumFromHash = queryOne . queryKeyValue datumRows _datumRowHash _datumRowDatum +getTxFromTxId :: Member BeamEffect effs => TxId -> Eff effs (Maybe ChainIndexTx) +getTxFromTxId = undefined -- queryOne . queryKeyValue txRows _txRowTxId _txRowTx + getScriptFromHash :: ( Member BeamEffect effs , HasDbType i @@ -138,6 +142,36 @@ queryOne :: -> Eff effs (Maybe o) queryOne = fmap (fmap fromDbValue) . selectOne +-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'. +getTxOutFromRef :: + forall effs. + ( Member BeamEffect effs + , Member (LogMsg ChainIndexLog) effs + ) + => TxOutRef + -> Eff effs (Maybe ChainIndexTxOut) +getTxOutFromRef ref@TxOutRef{txOutRefId, txOutRefIdx} = do + mTx <- getTxFromTxId txOutRefId + -- Find the output in the tx matching the output ref + case mTx ^? _Just . citxOutputs . _ValidTx . ix (fromIntegral txOutRefIdx) of + Nothing -> logWarn (TxOutNotFound ref) >> pure Nothing + Just txout -> do + -- The output might come from a public key address or a script address. + -- We need to handle them differently. + case addressCredential $ txOutAddress txout of + PubKeyCredential _ -> + pure $ Just $ PublicKeyChainIndexTxOut (txOutAddress txout) (txOutValue txout) + ScriptCredential vh -> do + case txOutDatumHash txout of + Nothing -> do + -- If the txout comes from a script address, the Datum should not be Nothing + logWarn $ NoDatumScriptAddr txout + pure Nothing + Just dh -> do + v <- maybe (Left vh) Right <$> getScriptFromHash vh + d <- maybe (Left dh) Right <$> getDatumFromHash dh + pure $ Just $ ScriptChainIndexTxOut (txOutAddress txout) v d (txOutValue txout) + getUtxoSetAtAddress :: forall effs. ( Member (State ChainIndexState) effs diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs index c69759bde0..b5b46b7e14 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs @@ -61,6 +61,7 @@ serveChainIndex :: serveChainIndex = pure NoContent :<|> serveFromHashApi + :<|> (E.txOutFromRef >=> handleMaybe) :<|> E.utxoSetMembership :<|> (\(UtxoAtAddressRequest pq c) -> E.utxoSetAtAddress (fromMaybe def pq) c) :<|> (\(UtxoWithCurrencyRequest pq c) -> E.utxoSetWithCurrency (fromMaybe def pq) c) diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs index 926a51b07d..689b2a20bd 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs @@ -25,12 +25,12 @@ import Generators qualified as Gen import Hedgehog (MonadTest, Property, assert, failure, forAll, property, (===)) import Ledger (outValue) import Plutus.ChainIndex (Page (pageItems), PageQuery (PageQuery), RunRequirements (..), appendBlock, citxOutputs, - runChainIndexEffects, utxoSetMembership, utxoSetWithCurrency) -import Plutus.ChainIndex.Api (IsUtxoResponse (isUtxo), UtxosResponse (UtxosResponse)) + runChainIndexEffects, utxoSetWithCurrency) +import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse)) import Plutus.ChainIndex.DbSchema (checkedSqliteDb) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect) -import Plutus.ChainIndex.Tx (_ValidTx, citxTxId) -import Plutus.ChainIndex.Types (ChainSyncBlock (..), TxProcessOption (..)) +import Plutus.ChainIndex.Tx (_ValidTx) +import Plutus.ChainIndex.Types (ChainSyncBlock (..)) import Plutus.V1.Ledger.Ada qualified as Ada import Plutus.V1.Ledger.Value (AssetClass (AssetClass), flattenValue) import Test.Tasty (TestTree, testGroup) From fb84e9592a75683a1248e834a7733b6d41904488 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Thu, 17 Feb 2022 12:56:00 +0500 Subject: [PATCH 03/17] Add utxoOutRefRows table --- .../src/Plutus/ChainIndex/DbSchema.hs | 26 +++++++++++-- .../src/Plutus/ChainIndex/Handlers.hs | 37 ++++--------------- 2 files changed, 30 insertions(+), 33 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs index 8c4f109c41..b6614518d8 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs +++ b/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 (..), TxOutRef (..), Validator, ValidatorHash (..)) import Plutus.ChainIndex.Tx (ChainIndexTx) import Plutus.ChainIndex.Types (BlockNumber (..), Tip (..)) import Plutus.V1.Ledger.Api (Credential) @@ -77,6 +77,17 @@ instance Table RedeemerRowT where data PrimaryKey RedeemerRowT f = RedeemerRowId (Columnar f ByteString) deriving (Generic, Beamable) primaryKey = RedeemerRowId . _redeemerRowHash +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 AddressRowT f = AddressRow { _addressRowCred :: Columnar f ByteString , _addressRowOutRef :: Columnar f ByteString @@ -153,6 +164,7 @@ data Db f = Db { datumRows :: f (TableEntity DatumRowT) , scriptRows :: f (TableEntity ScriptRowT) , redeemerRows :: f (TableEntity RedeemerRowT) + , utxoOutRefRows :: f (TableEntity UtxoRowT) , addressRows :: f (TableEntity AddressRowT) , assetClassRows :: f (TableEntity AssetClassRowT) , tipRows :: f (TableEntity TipRowT) @@ -164,6 +176,7 @@ type AllTables (c :: * -> Constraint) f = ( c (f (TableEntity DatumRowT)) , c (f (TableEntity ScriptRowT)) , c (f (TableEntity RedeemerRowT)) + , c (f (TableEntity UtxoRowT)) , c (f (TableEntity AddressRowT)) , c (f (TableEntity AssetClassRowT)) , c (f (TableEntity TipRowT)) @@ -182,6 +195,7 @@ checkedSqliteDb = defaultMigratableDbSettings { datumRows = renameCheckedEntity (const "datums") , scriptRows = renameCheckedEntity (const "scripts") , redeemerRows = renameCheckedEntity (const "redeemers") + , utxoOutRefRows = renameCheckedEntity (const "utxo_out_refs") , addressRows = renameCheckedEntity (const "addresses") , assetClassRows = renameCheckedEntity (const "asset_classes") , tipRows = renameCheckedEntity (const "tips") @@ -226,6 +240,7 @@ 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 Credential instance HasDbType Credential deriving via Serialisable AssetClass instance HasDbType AssetClass @@ -263,6 +278,11 @@ instance HasDbType (RedeemerHash, Redeemer) where toDbValue (hash, redeemer) = RedeemerRow (toDbValue hash) (toDbValue redeemer) fromDbValue (RedeemerRow hash redeemer) = (fromDbValue hash, fromDbValue redeemer) +-- 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 toDbValue (cred, outRef) = AddressRow (toDbValue cred) (toDbValue outRef) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index 4331238e27..bb45f4d359 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -20,7 +20,7 @@ module Plutus.ChainIndex.Handlers import Cardano.Api qualified as C import Control.Applicative (Const (..)) -import Control.Lens (Lens', _Just, ix, view, (^?)) +import Control.Lens (Lens', view) import Control.Monad.Freer (Eff, Member, type (~>)) import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Extras.Beam (BeamEffect (..), BeamableSqlite, addRowsInBatches, combined, deleteRows, @@ -38,13 +38,13 @@ import Data.Proxy (Proxy (..)) import Data.Set qualified as Set import Data.Word (Word64) import Database.Beam (Columnar, Identity, SqlSelect, TableEntity, aggregate_, all_, countAll_, delete, filter_, guard_, - in_, limit_, not_, nub_, select, val_) + limit_, not_, nub_, select, val_) import Database.Beam.Backend.SQL (BeamSqlBackendCanSerialize) import Database.Beam.Query (HasSqlEqualityCheck, asc_, desc_, exists_, orderBy_, update, (&&.), (<-.), (<.), (==.), (>.)) import Database.Beam.Schema.Tables (zipTables) import Database.Beam.Sqlite (Sqlite) -import Ledger (Address (..), ChainIndexTxOut (..), Datum, DatumHash (..), TxId (..), TxOut (..), TxOutRef (..)) +import Ledger (Address (..), ChainIndexTxOut (..), Datum, DatumHash (..), TxOut (..), TxOutRef (..)) import Ledger.Value (AssetClass (AssetClass), flattenValue) import Plutus.ChainIndex.Api (IsUtxoResponse (IsUtxoResponse), TxosResponse (TxosResponse), UtxosResponse (UtxosResponse)) @@ -60,7 +60,7 @@ import Plutus.ChainIndex.Types (ChainSyncBlock (..), Depth (..), Diagnostics (.. import Plutus.ChainIndex.UtxoState (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex) import Plutus.ChainIndex.UtxoState qualified as UtxoState import Plutus.V1.Ledger.Ada qualified as Ada -import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential)) +import Plutus.V1.Ledger.Api (Credential) type ChainIndexState = UtxoIndex TxUtxoBalance @@ -100,9 +100,6 @@ getTip = fmap fromDbValue . selectOne . select $ limit_ 1 (orderBy_ (desc_ . _ti getDatumFromHash :: Member BeamEffect effs => DatumHash -> Eff effs (Maybe Datum) getDatumFromHash = queryOne . queryKeyValue datumRows _datumRowHash _datumRowDatum -getTxFromTxId :: Member BeamEffect effs => TxId -> Eff effs (Maybe ChainIndexTx) -getTxFromTxId = undefined -- queryOne . queryKeyValue txRows _txRowTxId _txRowTx - getScriptFromHash :: ( Member BeamEffect effs , HasDbType i @@ -146,31 +143,10 @@ queryOne = fmap (fmap fromDbValue) . selectOne getTxOutFromRef :: forall effs. ( Member BeamEffect effs - , Member (LogMsg ChainIndexLog) effs ) => TxOutRef -> Eff effs (Maybe ChainIndexTxOut) -getTxOutFromRef ref@TxOutRef{txOutRefId, txOutRefIdx} = do - mTx <- getTxFromTxId txOutRefId - -- Find the output in the tx matching the output ref - case mTx ^? _Just . citxOutputs . _ValidTx . ix (fromIntegral txOutRefIdx) of - Nothing -> logWarn (TxOutNotFound ref) >> pure Nothing - Just txout -> do - -- The output might come from a public key address or a script address. - -- We need to handle them differently. - case addressCredential $ txOutAddress txout of - PubKeyCredential _ -> - pure $ Just $ PublicKeyChainIndexTxOut (txOutAddress txout) (txOutValue txout) - ScriptCredential vh -> do - case txOutDatumHash txout of - Nothing -> do - -- If the txout comes from a script address, the Datum should not be Nothing - logWarn $ NoDatumScriptAddr txout - pure Nothing - Just dh -> do - v <- maybe (Left vh) Right <$> getScriptFromHash vh - d <- maybe (Left dh) Right <$> getDatumFromHash dh - pure $ Just $ ScriptChainIndexTxOut (txOutAddress txout) v d (txOutValue txout) +getTxOutFromRef = queryOne . queryKeyValue utxoOutRefRows _utxoRowOutRef _utxoRowTxOut getUtxoSetAtAddress :: forall effs. @@ -307,9 +283,10 @@ handleControl = \case [ DeleteRows $ truncateTable (datumRows db) , DeleteRows $ truncateTable (scriptRows db) , DeleteRows $ truncateTable (redeemerRows db) + , DeleteRows $ truncateTable (utxoOutRefRows db) , DeleteRows $ truncateTable (addressRows db) , DeleteRows $ truncateTable (assetClassRows db) - ] -- ++ getConst (zipTables Proxy (\tbl (InsertRows rows) -> Const [AddRowsInBatches batchSize tbl rows]) db) + ] where truncateTable table = delete table (const (val_ True)) GetDiagnostics -> diagnostics From 1fe3b855c3410ce2f37d6ebae56e7baed0c20e9b Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Thu, 17 Feb 2022 20:37:10 +0500 Subject: [PATCH 04/17] Adapt plutus-contract to changes --- plutus-contract/src/Plutus/Contract.hs | 2 - .../src/Plutus/Contract/Effects.hs | 8 -- .../src/Plutus/Contract/Request.hs | 104 +----------------- .../src/Plutus/Contract/StateMachine.hs | 42 +++---- .../Plutus/Contract/Trace/RequestHandler.hs | 6 +- 5 files changed, 25 insertions(+), 137 deletions(-) diff --git a/plutus-contract/src/Plutus/Contract.hs b/plutus-contract/src/Plutus/Contract.hs index bfe9811105..243f8f4b44 100644 --- a/plutus-contract/src/Plutus/Contract.hs +++ b/plutus-contract/src/Plutus/Contract.hs @@ -54,12 +54,10 @@ module Plutus.Contract( , Request.mintingPolicyFromHash , Request.stakeValidatorFromHash , Request.txOutFromRef - , Request.txFromTxId , Request.utxoRefMembership , Request.utxoRefsAt , Request.utxoRefsWithCurrency , Request.utxosAt - , Request.utxosTxOutTxAt , Request.utxosTxOutTxFromTx , Request.getTip -- * Wallet's own public key diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index b1b5495905..09045699ec 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -30,11 +30,9 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _MintingPolicyFromHash, _RedeemerFromHash, _TxOutFromRef, - _TxFromTxId, _UtxoSetMembership, _UtxoSetAtAddress, _UtxoSetWithCurrency, - _TxsFromTxIds, _TxoSetAtAddress, _GetTip, -- * Plutus application backend response effect types @@ -213,11 +211,9 @@ chainIndexMatches q r = case (q, r) of (StakeValidatorFromHash{}, StakeValidatorHashResponse{}) -> True (RedeemerFromHash{}, RedeemerHashResponse{}) -> True (TxOutFromRef{}, TxOutRefResponse{}) -> True - (TxFromTxId{}, TxIdResponse{}) -> True (UtxoSetMembership{}, UtxoSetMembershipResponse{}) -> True (UtxoSetAtAddress{}, UtxoSetAtResponse{}) -> True (UtxoSetWithCurrency{}, UtxoSetWithCurrencyResponse{}) -> True - (TxsFromTxIds{}, TxIdsResponse{}) -> True (TxoSetAtAddress{}, TxoSetAtResponse{}) -> True (GetTip{}, GetTipResponse{}) -> True _ -> False @@ -232,11 +228,9 @@ data ChainIndexQuery = | StakeValidatorFromHash StakeValidatorHash | RedeemerFromHash RedeemerHash | TxOutFromRef TxOutRef - | TxFromTxId TxId | UtxoSetMembership TxOutRef | UtxoSetAtAddress (PageQuery TxOutRef) Credential | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass - | TxsFromTxIds [TxId] | TxoSetAtAddress (PageQuery TxOutRef) Credential | GetTip deriving stock (Eq, Show, Generic) @@ -250,11 +244,9 @@ instance Pretty ChainIndexQuery where StakeValidatorFromHash h -> "requesting stake validator from hash" <+> pretty h RedeemerFromHash h -> "requesting redeemer from hash" <+> pretty h TxOutFromRef r -> "requesting utxo from utxo reference" <+> pretty r - TxFromTxId i -> "requesting chain index tx from id" <+> pretty i UtxoSetMembership txOutRef -> "whether tx output is part of the utxo set" <+> pretty txOutRef UtxoSetAtAddress _ c -> "requesting utxos located at addresses with the credential" <+> pretty c UtxoSetWithCurrency _ ac -> "requesting utxos containing the asset class" <+> pretty ac - TxsFromTxIds i -> "requesting chain index txs from ids" <+> pretty i TxoSetAtAddress _ c -> "requesting txos located at addresses with the credential" <+> pretty c GetTip -> "requesting the tip of the chain index" diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index 08d8f43e94..1e4f638721 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -34,16 +34,12 @@ module Plutus.Contract.Request( , stakeValidatorFromHash , redeemerFromHash , txOutFromRef - , txFromTxId , utxoRefMembership , utxoRefsAt , utxoRefsWithCurrency , utxosAt - , utxosTxOutTxAt , utxosTxOutTxFromTx - , txsFromTxIds , txoRefsAt - , txsAt , getTip -- ** Waiting for changes to the UTXO set , fundsAtAddressGt @@ -115,8 +111,8 @@ import GHC.Generics (Generic) import GHC.Natural (Natural) import GHC.TypeLits (Symbol, symbolVal) import Ledger (Address, AssetClass, Datum, DatumHash, DiffMilliSeconds, MintingPolicy, MintingPolicyHash, POSIXTime, - PaymentPubKeyHash, Redeemer, RedeemerHash, Slot, StakeValidator, StakeValidatorHash, TxId, - TxOutRef (txOutRefId), Validator, ValidatorHash, Value, addressCredential, fromMilliSeconds) + PaymentPubKeyHash, Redeemer, RedeemerHash, Slot, StakeValidator, StakeValidatorHash, TxId, TxOutRef, + Validator, ValidatorHash, Value, addressCredential, fromMilliSeconds) import Ledger.Constraints (TxConstraints) import Ledger.Constraints.OffChain (ScriptLookups, UnbalancedTx) import Ledger.Constraints.OffChain qualified as Constraints @@ -328,18 +324,6 @@ txOutFromRef ref = do E.TxOutRefResponse r -> pure r r -> throwError $ review _ChainIndexContractError ("TxOutRefResponse", r) -txFromTxId :: - forall w s e. - ( AsContractError e - ) - => TxId - -> Contract w s e (Maybe ChainIndexTx) -txFromTxId txid = do - cir <- pabReq (ChainIndexQueryReq $ E.TxFromTxId txid) E._ChainIndexQueryResp - case cir of - E.TxIdResponse r -> pure r - r -> throwError $ review _ChainIndexContractError ("TxIdResponse", r) - utxoRefMembership :: forall w s e. ( AsContractError e @@ -416,45 +400,6 @@ utxosAt addr = do $ zip utxoRefs txOuts pure $ acc <> utxos --- | Get unspent transaction outputs with transaction from address. -utxosTxOutTxAt :: - forall w s e. - ( AsContractError e - ) - => Address - -> Contract w s e (Map TxOutRef (ChainIndexTxOut, ChainIndexTx)) -utxosTxOutTxAt addr = do - snd <$> foldUtxoRefsAt (\acc page -> go acc (pageItems page)) (mempty, mempty) addr - where - go :: (Map TxId ChainIndexTx, Map TxOutRef (ChainIndexTxOut, ChainIndexTx)) - -> [TxOutRef] - -> Contract w s e (Map TxId ChainIndexTx, Map TxOutRef (ChainIndexTxOut, ChainIndexTx)) - go acc [] = pure acc - go (lookupTx, oldResult) (ref:refs) = do - outM <- txOutFromRef ref - case outM of - Just out -> do - let txid = txOutRefId ref - -- Lookup the txid in the lookup table. If it's present, we don't need - -- to query the chain index again. If it's not, we query the chain - -- index and store the result in the lookup table. - case Map.lookup txid lookupTx of - Just tx -> do - let result = oldResult <> Map.singleton ref (out, tx) - go (lookupTx, result) refs - Nothing -> do - -- We query the chain index for the tx and store it in the lookup - -- table if it is found. - txM <- txFromTxId txid - case txM of - Just tx -> do - let newLookupTx = lookupTx <> Map.singleton txid tx - let result = oldResult <> Map.singleton ref (out, tx) - go (newLookupTx, result) refs - Nothing -> - go (lookupTx, oldResult) refs - Nothing -> go (lookupTx, oldResult) refs - -- | Get the unspent transaction outputs from a 'ChainIndexTx'. utxosTxOutTxFromTx :: AsContractError e @@ -467,38 +412,6 @@ utxosTxOutTxFromTx tx = ciTxOutM <- txOutFromRef txOutRef pure $ ciTxOutM >>= \ciTxOut -> pure (txOutRef, (ciTxOut, tx)) -foldTxoRefsAt :: - forall w s e a. - ( AsContractError e - ) - => (a -> Page TxOutRef -> Contract w s e a) - -> a - -> Address - -> Contract w s e a -foldTxoRefsAt f ini addr = go ini (Just def) - where - go acc Nothing = pure acc - go acc (Just pq) = do - page <- paget <$> txoRefsAt pq addr - newAcc <- f acc page - go newAcc (nextPageQuery page) - --- | Get the transactions at an address. -txsAt :: - forall w s e. - ( AsContractError e - ) - => Address - -> Contract w s e [ChainIndexTx] -txsAt addr = do - foldTxoRefsAt f [] addr - where - f acc page = do - let txoRefs = pageItems page - let txIds = txOutRefId <$> txoRefs - txs <- txsFromTxIds txIds - pure $ acc <> txs - -- | Get the transaction outputs at an address. txoRefsAt :: forall w s e. @@ -513,19 +426,6 @@ txoRefsAt pq addr = do E.TxoSetAtResponse r -> pure r r -> throwError $ review _ChainIndexContractError ("TxoSetAtAddress", r) --- | Get the transactions for a list of transaction ids. -txsFromTxIds :: - forall w s e. - ( AsContractError e - ) - => [TxId] - -> Contract w s e [ChainIndexTx] -txsFromTxIds txid = do - cir <- pabReq (ChainIndexQueryReq $ E.TxsFromTxIds txid) E._ChainIndexQueryResp - case cir of - E.TxIdsResponse r -> pure r - r -> throwError $ review _ChainIndexContractError ("TxIdsResponse", r) - getTip :: forall w s e. ( AsContractError e diff --git a/plutus-contract/src/Plutus/Contract/StateMachine.hs b/plutus-contract/src/Plutus/Contract/StateMachine.hs index 3a08a27268..216de29d27 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine.hs @@ -82,7 +82,7 @@ import Ledger.Value qualified as Value import Plutus.ChainIndex (ChainIndexTx (_citxInputs)) import Plutus.Contract (AsContractError (_ConstraintResolutionContractError, _ContractError), Contract, ContractError, Promise, awaitPromise, isSlot, isTime, logWarn, mapError, never, ownPaymentPubKeyHash, - promiseBind, select, submitTxConfirmed, utxoIsProduced, utxoIsSpent, utxosAt, utxosTxOutTxAt, + promiseBind, select, submitTxConfirmed, utxoIsProduced, utxoIsSpent, utxosAt, utxosTxOutTxFromTx) import Plutus.Contract.Request (mkTxContract) import Plutus.Contract.StateMachine.MintingPolarity (MintingPolarity (Burn, Mint)) @@ -116,7 +116,6 @@ data OnChainState s i = OnChainState { ocsTxOut :: Typed.TypedScriptTxOut (SM.StateMachine s i) -- ^ Typed transaction output , ocsTxOutRef :: Typed.TypedScriptTxOutRef (SM.StateMachine s i) -- ^ Typed UTXO - , ocsTx :: ChainIndexTx -- ^ Transaction that produced the output } getInput :: @@ -133,13 +132,13 @@ getStates :: forall s i . (PlutusTx.FromData s, PlutusTx.ToData s) => SM.StateMachineInstance s i - -> Map Tx.TxOutRef (Tx.ChainIndexTxOut, ChainIndexTx) + -> Map Tx.TxOutRef Tx.ChainIndexTxOut -> [OnChainState s i] getStates (SM.StateMachineInstance _ si) refMap = - let lkp (ref, (out, tx)) = do - ocsTxOutRef <- Typed.typeScriptTxOutRef (\r -> fst <$> Map.lookup r refMap) si ref + let lkp (ref, out) = do + ocsTxOutRef <- Typed.typeScriptTxOutRef (\r -> Map.lookup r refMap) si ref ocsTxOut <- Typed.typeScriptTxOut si ref out - pure OnChainState{ocsTxOut, ocsTxOutRef, ocsTx = tx} + pure OnChainState{ocsTxOut, ocsTxOutRef} in rights $ fmap lkp $ Map.toList refMap -- | An invalid transition @@ -228,20 +227,20 @@ getOnChainState :: => StateMachineClient state i -> Contract w schema e (Maybe (OnChainState state i, Map TxOutRef Tx.ChainIndexTxOut)) getOnChainState StateMachineClient{scInstance, scChooser} = mapError (review _SMContractError) $ do - utxoTx <- utxosTxOutTxAt (SM.machineAddress scInstance) + utxoTx <- utxosAt (SM.machineAddress scInstance) let states = getStates scInstance utxoTx case states of [] -> pure Nothing _ -> case scChooser states of Left err -> throwing _SMContractError err - Right state -> pure $ Just (state, fmap fst utxoTx) + Right state -> pure $ Just (state, utxoTx) -- | The outcome of 'waitForUpdateTimeout' data WaitingResult t i s = Timeout t -- ^ The timeout happened before any change of the on-chain state was detected - | ContractEnded ChainIndexTx i -- ^ The state machine instance ended - | Transition ChainIndexTx i s -- ^ The state machine instance transitioned to a new state - | InitialState ChainIndexTx s -- ^ The state machine instance was initialised + | ContractEnded i -- ^ The state machine instance ended + | Transition i s -- ^ The state machine instance transitioned to a new state + | InitialState s -- ^ The state machine instance was initialised deriving stock (Show,Generic,Functor) deriving anyclass (ToJSON, FromJSON) @@ -291,10 +290,10 @@ waitForUpdate :: => StateMachineClient state i -> Contract w schema e (Maybe (OnChainState state i)) waitForUpdate client = waitForUpdateTimeout client never >>= awaitPromise >>= \case - Timeout t -> absurd t - ContractEnded{} -> pure Nothing - InitialState _ r -> pure (Just r) - Transition _ _ r -> pure (Just r) + Timeout t -> absurd t + ContractEnded{} -> pure Nothing + InitialState r -> pure (Just r) + Transition _ r -> pure (Just r) -- | Construct a 'Promise' that waits for an update to the state machine's -- on-chain state, or a user-defined timeout (whichever happens first). @@ -311,6 +310,7 @@ waitForUpdateTimeout :: -> Contract w schema e (Promise w schema e (WaitingResult t i (OnChainState state i))) waitForUpdateTimeout client@StateMachineClient{scInstance, scChooser} timeout = do currentState <- getOnChainState client + let projectFst = (\(a, (b, _)) -> (a, b)) let success = case currentState of Nothing -> -- There is no on-chain state, so we wait for an output to appear @@ -319,20 +319,20 @@ waitForUpdateTimeout client@StateMachineClient{scInstance, scChooser} timeout = let addr = Scripts.validatorAddress $ typedValidator scInstance in promiseBind (utxoIsProduced addr) $ \txns -> do outRefMaps <- traverse utxosTxOutTxFromTx txns - let produced = getStates @state @i scInstance (Map.fromList $ concat outRefMaps) + let produced = getStates @state @i scInstance (Map.fromList $ map projectFst $ concat outRefMaps) case scChooser produced of Left e -> throwing _SMContractError e - Right onChainState -> pure $ InitialState (ocsTx onChainState) onChainState - Just (OnChainState{ocsTxOutRef=Typed.TypedScriptTxOutRef{Typed.tyTxOutRefRef}, ocsTx}, _) -> + Right onChainState -> pure $ InitialState onChainState + Just (OnChainState{ocsTxOutRef=Typed.TypedScriptTxOutRef{Typed.tyTxOutRefRef}}, _) -> promiseBind (utxoIsSpent tyTxOutRefRef) $ \txn -> do - outRefMap <- Map.fromList <$> utxosTxOutTxFromTx txn + outRefMap <- Map.fromList . map projectFst <$> utxosTxOutTxFromTx txn let newStates = getStates @state @i scInstance outRefMap inp = getInput tyTxOutRefRef txn case (newStates, inp) of - ([], Just i) -> pure (ContractEnded ocsTx i) + ([], Just i) -> pure (ContractEnded i) (xs, Just i) -> case scChooser xs of Left e -> throwing _SMContractError e - Right newState -> pure (Transition ocsTx i newState) + Right newState -> pure (Transition i newState) _ -> throwing_ _UnableToExtractTransition pure $ select success (Timeout <$> timeout) diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs index b2f5ba3348..96c85d6c4e 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -53,8 +53,8 @@ import Ledger.TimeSlot qualified as TimeSlot import Ledger.Tx (CardanoTx) import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.ChainIndex.Effects qualified as ChainIndexEff -import Plutus.Contract.Effects (ChainIndexQuery (DatumFromHash, GetTip, MintingPolicyFromHash, RedeemerFromHash, StakeValidatorFromHash, TxFromTxId, TxOutFromRef, TxoSetAtAddress, TxsFromTxIds, UtxoSetAtAddress, UtxoSetMembership, UtxoSetWithCurrency, ValidatorFromHash), - ChainIndexResponse (DatumHashResponse, GetTipResponse, MintingPolicyHashResponse, RedeemerHashResponse, StakeValidatorHashResponse, TxIdResponse, TxIdsResponse, TxOutRefResponse, TxoSetAtResponse, UtxoSetAtResponse, UtxoSetMembershipResponse, UtxoSetWithCurrencyResponse, ValidatorHashResponse)) +import Plutus.Contract.Effects (ChainIndexQuery (DatumFromHash, GetTip, MintingPolicyFromHash, RedeemerFromHash, StakeValidatorFromHash, TxOutFromRef, TxoSetAtAddress, UtxoSetAtAddress, UtxoSetMembership, UtxoSetWithCurrency, ValidatorFromHash), + ChainIndexResponse (DatumHashResponse, GetTipResponse, MintingPolicyHashResponse, RedeemerHashResponse, StakeValidatorHashResponse, TxOutRefResponse, TxoSetAtResponse, UtxoSetAtResponse, UtxoSetMembershipResponse, UtxoSetWithCurrencyResponse, ValidatorHashResponse)) import Plutus.Contract.Wallet qualified as Wallet import Wallet.API (WalletAPIError) import Wallet.Effects (NodeClientEffect, WalletEffect) @@ -229,11 +229,9 @@ handleChainIndexQueries = RequestHandler $ \chainIndexQuery -> StakeValidatorFromHash h -> StakeValidatorHashResponse <$> ChainIndexEff.stakeValidatorFromHash h RedeemerFromHash h -> RedeemerHashResponse <$> ChainIndexEff.redeemerFromHash h TxOutFromRef txOutRef -> TxOutRefResponse <$> ChainIndexEff.txOutFromRef txOutRef - TxFromTxId txid -> TxIdResponse <$> ChainIndexEff.txFromTxId txid UtxoSetMembership txOutRef -> UtxoSetMembershipResponse <$> ChainIndexEff.utxoSetMembership txOutRef UtxoSetAtAddress pq c -> UtxoSetAtResponse <$> ChainIndexEff.utxoSetAtAddress pq c UtxoSetWithCurrency pq ac -> UtxoSetWithCurrencyResponse <$> ChainIndexEff.utxoSetWithCurrency pq ac - TxsFromTxIds txids -> TxIdsResponse <$> ChainIndexEff.txsFromTxIds txids TxoSetAtAddress pq c -> TxoSetAtResponse <$> ChainIndexEff.txoSetAtAddress pq c GetTip -> GetTipResponse <$> ChainIndexEff.getTip From 6cbb2a668de9dc50e395f0d18d705d50fc982782 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Thu, 17 Feb 2022 20:46:35 +0500 Subject: [PATCH 05/17] remove import --- plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs index ce0a79c2cd..8e07d9ed3f 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs @@ -29,7 +29,7 @@ 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) From 4aa86aa69894c76192cb92d166e718f8b170f270 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Fri, 18 Feb 2022 12:05:55 +0500 Subject: [PATCH 06/17] fi --- plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs index a9babd018b..2d249abf25 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs @@ -26,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) From 884116402bfd6ee996579120722c231209c2d143 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Fri, 18 Feb 2022 13:02:50 +0500 Subject: [PATCH 07/17] fix --- plutus-contract/src/Plutus/Contract/Request.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index 1e4f638721..ca5e509ec2 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -132,7 +132,7 @@ import Wallet.Types (ContractInstanceId, EndpointDescription (EndpointDescriptio EndpointValue (EndpointValue, unEndpointValue)) import Plutus.ChainIndex (ChainIndexTx, Page (nextPageQuery, pageItems), PageQuery, txOutRefs) -import Plutus.ChainIndex.Api (IsUtxoResponse, TxosResponse (paget), UtxosResponse (page)) +import Plutus.ChainIndex.Api (IsUtxoResponse, TxosResponse, UtxosResponse (page)) import Plutus.ChainIndex.Types (RollbackState (Unknown), Tip, TxOutStatus, TxStatus) import Plutus.Contract.Error (AsContractError (_ChainIndexContractError, _ConstraintResolutionContractError, _EndpointDecodeContractError, _ResumableContractError, _WalletContractError)) import Plutus.Contract.Resumable (prompt) From 73bf56bc6d8717ff002b42574aa33e00b8330c23 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Fri, 18 Feb 2022 14:18:55 +0500 Subject: [PATCH 08/17] fix pab and use cases --- plutus-pab/src/Plutus/PAB/Simulator.hs | 4 +--- plutus-use-cases/src/Plutus/Contracts/Auction.hs | 6 +++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index df34ebf1a1..a8394efd53 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -108,7 +108,7 @@ import Ledger.Index qualified as UtxoIndex import Ledger.TimeSlot (SlotConfig (SlotConfig, scSlotLength)) import Ledger.Value (Value, flattenValue) import Plutus.ChainIndex.Emulator (ChainIndexControlEffect, ChainIndexEmulatorState, ChainIndexError, ChainIndexLog, - ChainIndexQueryEffect (DatumFromHash, GetTip, MintingPolicyFromHash, RedeemerFromHash, StakeValidatorFromHash, TxFromTxId, TxOutFromRef, TxoSetAtAddress, TxsFromTxIds, UtxoSetAtAddress, UtxoSetMembership, UtxoSetWithCurrency, ValidatorFromHash), + ChainIndexQueryEffect (DatumFromHash, GetTip, MintingPolicyFromHash, RedeemerFromHash, StakeValidatorFromHash, TxOutFromRef, TxoSetAtAddress, UtxoSetAtAddress, UtxoSetMembership, UtxoSetWithCurrency, ValidatorFromHash), TxOutStatus, TxStatus, getTip) import Plutus.ChainIndex.Emulator qualified as ChainIndex import Plutus.PAB.Core (EffectHandlers (EffectHandlers, handleContractDefinitionEffect, handleContractEffect, handleContractStoreEffect, handleLogMessages, handleServicesEffects, initialiseEnvironment, onShutdown, onStartup)) @@ -581,11 +581,9 @@ handleChainIndexEffect = runChainIndexEffects @t . \case StakeValidatorFromHash h -> ChainIndex.stakeValidatorFromHash h RedeemerFromHash h -> ChainIndex.redeemerFromHash h TxOutFromRef ref -> ChainIndex.txOutFromRef ref - TxFromTxId txid -> ChainIndex.txFromTxId txid UtxoSetMembership ref -> ChainIndex.utxoSetMembership ref UtxoSetAtAddress pq addr -> ChainIndex.utxoSetAtAddress pq addr UtxoSetWithCurrency pq ac -> ChainIndex.utxoSetWithCurrency pq ac - TxsFromTxIds txids -> ChainIndex.txsFromTxIds txids TxoSetAtAddress pq addr -> ChainIndex.txoSetAtAddress pq addr GetTip -> ChainIndex.getTip diff --git a/plutus-use-cases/src/Plutus/Contracts/Auction.hs b/plutus-use-cases/src/Plutus/Contracts/Auction.hs index 4ce32b96ad..81ec6f82d0 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Auction.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Auction.hs @@ -358,6 +358,6 @@ auctionBuyer currency params = do -- If the state can't be found we wait for it to appear. Nothing -> SM.waitForUpdateUntilTime client (apEndTime params) >>= \case - Transition _ _ (Ongoing s) -> loop s - InitialState _ (Ongoing s) -> loop s - _ -> logWarn CurrentStateNotFound + Transition _ (Ongoing s) -> loop s + InitialState (Ongoing s) -> loop s + _ -> logWarn CurrentStateNotFound From 352420443e3f33db708c9942d16f0176846b8278 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Fri, 18 Feb 2022 14:57:32 +0500 Subject: [PATCH 09/17] update purs --- .../generated/Plutus/Contract/Effects.purs | 16 ---------------- .../generated/Plutus/Contract/Effects.purs | 16 ---------------- 2 files changed, 32 deletions(-) diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs index 3d59b57d66..0004ebdb75 100644 --- a/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs +++ b/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs @@ -126,11 +126,9 @@ data ChainIndexQuery | StakeValidatorFromHash String | RedeemerFromHash String | TxOutFromRef TxOutRef - | TxFromTxId TxId | UtxoSetMembership TxOutRef | UtxoSetAtAddress (PageQuery TxOutRef) Credential | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass - | TxsFromTxIds (Array TxId) | TxoSetAtAddress (PageQuery TxOutRef) Credential | GetTip @@ -147,11 +145,9 @@ instance EncodeJson ChainIndexQuery where StakeValidatorFromHash a -> E.encodeTagged "StakeValidatorFromHash" a E.value RedeemerFromHash a -> E.encodeTagged "RedeemerFromHash" a E.value TxOutFromRef a -> E.encodeTagged "TxOutFromRef" a E.value - TxFromTxId a -> E.encodeTagged "TxFromTxId" a E.value UtxoSetMembership a -> E.encodeTagged "UtxoSetMembership" a E.value UtxoSetAtAddress a b -> E.encodeTagged "UtxoSetAtAddress" (a /\ b) (E.tuple (E.value >/\< E.value)) UtxoSetWithCurrency a b -> E.encodeTagged "UtxoSetWithCurrency" (a /\ b) (E.tuple (E.value >/\< E.value)) - TxsFromTxIds a -> E.encodeTagged "TxsFromTxIds" a E.value TxoSetAtAddress a b -> E.encodeTagged "TxoSetAtAddress" (a /\ b) (E.tuple (E.value >/\< E.value)) GetTip -> encodeJson { tag: "GetTip", contents: jsonNull } @@ -165,11 +161,9 @@ instance DecodeJson ChainIndexQuery where , "StakeValidatorFromHash" /\ D.content (StakeValidatorFromHash <$> D.value) , "RedeemerFromHash" /\ D.content (RedeemerFromHash <$> D.value) , "TxOutFromRef" /\ D.content (TxOutFromRef <$> D.value) - , "TxFromTxId" /\ D.content (TxFromTxId <$> D.value) , "UtxoSetMembership" /\ D.content (UtxoSetMembership <$> D.value) , "UtxoSetAtAddress" /\ D.content (D.tuple $ UtxoSetAtAddress D.value D.value) , "UtxoSetWithCurrency" /\ D.content (D.tuple $ UtxoSetWithCurrency D.value D.value) - , "TxsFromTxIds" /\ D.content (TxsFromTxIds <$> D.value) , "TxoSetAtAddress" /\ D.content (D.tuple $ TxoSetAtAddress D.value D.value) , "GetTip" /\ pure GetTip ] @@ -208,11 +202,6 @@ _TxOutFromRef = prism' TxOutFromRef case _ of (TxOutFromRef a) -> Just a _ -> Nothing -_TxFromTxId :: Prism' ChainIndexQuery TxId -_TxFromTxId = prism' TxFromTxId case _ of - (TxFromTxId a) -> Just a - _ -> Nothing - _UtxoSetMembership :: Prism' ChainIndexQuery TxOutRef _UtxoSetMembership = prism' UtxoSetMembership case _ of (UtxoSetMembership a) -> Just a @@ -228,11 +217,6 @@ _UtxoSetWithCurrency = prism' (\{ a, b } -> (UtxoSetWithCurrency a b)) case _ of (UtxoSetWithCurrency a b) -> Just { a, b } _ -> Nothing -_TxsFromTxIds :: Prism' ChainIndexQuery (Array TxId) -_TxsFromTxIds = prism' TxsFromTxIds case _ of - (TxsFromTxIds a) -> Just a - _ -> Nothing - _TxoSetAtAddress :: Prism' ChainIndexQuery { a :: PageQuery TxOutRef, b :: Credential } _TxoSetAtAddress = prism' (\{ a, b } -> (TxoSetAtAddress a b)) case _ of (TxoSetAtAddress a b) -> Just { a, b } diff --git a/plutus-playground-client/generated/Plutus/Contract/Effects.purs b/plutus-playground-client/generated/Plutus/Contract/Effects.purs index 3d59b57d66..0004ebdb75 100644 --- a/plutus-playground-client/generated/Plutus/Contract/Effects.purs +++ b/plutus-playground-client/generated/Plutus/Contract/Effects.purs @@ -126,11 +126,9 @@ data ChainIndexQuery | StakeValidatorFromHash String | RedeemerFromHash String | TxOutFromRef TxOutRef - | TxFromTxId TxId | UtxoSetMembership TxOutRef | UtxoSetAtAddress (PageQuery TxOutRef) Credential | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass - | TxsFromTxIds (Array TxId) | TxoSetAtAddress (PageQuery TxOutRef) Credential | GetTip @@ -147,11 +145,9 @@ instance EncodeJson ChainIndexQuery where StakeValidatorFromHash a -> E.encodeTagged "StakeValidatorFromHash" a E.value RedeemerFromHash a -> E.encodeTagged "RedeemerFromHash" a E.value TxOutFromRef a -> E.encodeTagged "TxOutFromRef" a E.value - TxFromTxId a -> E.encodeTagged "TxFromTxId" a E.value UtxoSetMembership a -> E.encodeTagged "UtxoSetMembership" a E.value UtxoSetAtAddress a b -> E.encodeTagged "UtxoSetAtAddress" (a /\ b) (E.tuple (E.value >/\< E.value)) UtxoSetWithCurrency a b -> E.encodeTagged "UtxoSetWithCurrency" (a /\ b) (E.tuple (E.value >/\< E.value)) - TxsFromTxIds a -> E.encodeTagged "TxsFromTxIds" a E.value TxoSetAtAddress a b -> E.encodeTagged "TxoSetAtAddress" (a /\ b) (E.tuple (E.value >/\< E.value)) GetTip -> encodeJson { tag: "GetTip", contents: jsonNull } @@ -165,11 +161,9 @@ instance DecodeJson ChainIndexQuery where , "StakeValidatorFromHash" /\ D.content (StakeValidatorFromHash <$> D.value) , "RedeemerFromHash" /\ D.content (RedeemerFromHash <$> D.value) , "TxOutFromRef" /\ D.content (TxOutFromRef <$> D.value) - , "TxFromTxId" /\ D.content (TxFromTxId <$> D.value) , "UtxoSetMembership" /\ D.content (UtxoSetMembership <$> D.value) , "UtxoSetAtAddress" /\ D.content (D.tuple $ UtxoSetAtAddress D.value D.value) , "UtxoSetWithCurrency" /\ D.content (D.tuple $ UtxoSetWithCurrency D.value D.value) - , "TxsFromTxIds" /\ D.content (TxsFromTxIds <$> D.value) , "TxoSetAtAddress" /\ D.content (D.tuple $ TxoSetAtAddress D.value D.value) , "GetTip" /\ pure GetTip ] @@ -208,11 +202,6 @@ _TxOutFromRef = prism' TxOutFromRef case _ of (TxOutFromRef a) -> Just a _ -> Nothing -_TxFromTxId :: Prism' ChainIndexQuery TxId -_TxFromTxId = prism' TxFromTxId case _ of - (TxFromTxId a) -> Just a - _ -> Nothing - _UtxoSetMembership :: Prism' ChainIndexQuery TxOutRef _UtxoSetMembership = prism' UtxoSetMembership case _ of (UtxoSetMembership a) -> Just a @@ -228,11 +217,6 @@ _UtxoSetWithCurrency = prism' (\{ a, b } -> (UtxoSetWithCurrency a b)) case _ of (UtxoSetWithCurrency a b) -> Just { a, b } _ -> Nothing -_TxsFromTxIds :: Prism' ChainIndexQuery (Array TxId) -_TxsFromTxIds = prism' TxsFromTxIds case _ of - (TxsFromTxIds a) -> Just a - _ -> Nothing - _TxoSetAtAddress :: Prism' ChainIndexQuery { a :: PageQuery TxOutRef, b :: Credential } _TxoSetAtAddress = prism' (\{ a, b } -> (TxoSetAtAddress a b)) case _ of (TxoSetAtAddress a b) -> Just { a, b } From 598111896b3212e5e17bad0405447f44ab0a20b1 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Mon, 21 Feb 2022 15:08:07 +0500 Subject: [PATCH 10/17] Insert txOuts --- .../src/Plutus/ChainIndex/DbSchema.hs | 3 ++- .../src/Plutus/ChainIndex/Handlers.hs | 14 +++++++++----- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs index b6614518d8..b767777193 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs @@ -38,7 +38,7 @@ import Database.Beam.Migrate (CheckedDatabaseSettings, defaultMigratableDbSettin import Database.Beam.Sqlite (Sqlite) import Ledger (AssetClass, BlockId (..), ChainIndexTxOut (..), Datum, DatumHash (..), MintingPolicy, MintingPolicyHash (..), Redeemer, RedeemerHash (..), Script, ScriptHash (..), Slot, StakeValidator, - StakeValidatorHash (..), TxId (..), TxOutRef (..), Validator, ValidatorHash (..)) + StakeValidatorHash (..), TxId (..), TxOut, TxOutRef (..), Validator, ValidatorHash (..)) import Plutus.ChainIndex.Tx (ChainIndexTx) import Plutus.ChainIndex.Types (BlockNumber (..), Tip (..)) import Plutus.V1.Ledger.Api (Credential) @@ -242,6 +242,7 @@ 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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index bb45f4d359..04c460826a 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -247,7 +247,8 @@ handleControl :: handleControl = \case AppendBlock (Block tip_ transactions) -> do oldIndex <- get @ChainIndexState - let newUtxoState = TxUtxoBalance.fromBlock tip_ (map fst transactions) + let txs = map fst transactions + let newUtxoState = TxUtxoBalance.fromBlock tip_ txs case UtxoState.insert newUtxoState oldIndex of Left err -> do let reason = InsertionFailed err @@ -261,7 +262,7 @@ handleControl = \case put $ UtxoState.reducedIndex lbcResult reduceOldUtxoDb $ UtxoState._usTip $ UtxoState.combinedState lbcResult insert $ foldMap (\(tx, opt) -> if tpoStoreTx opt then fromTx tx else mempty) transactions - insertUtxoDb newUtxoState + insertUtxoDb txs newUtxoState logDebug $ InsertionSuccess tip_ insertPosition Rollback tip_ -> do oldIndex <- get @ChainIndexState @@ -301,16 +302,19 @@ insertUtxoDb :: ( Member BeamEffect effs , Member (Error ChainIndexError) effs ) - => UtxoState.UtxoState TxUtxoBalance + => [ChainIndexTx] + -> UtxoState.UtxoState TxUtxoBalance -> Eff effs () -insertUtxoDb (UtxoState.UtxoState _ TipAtGenesis) = throwError $ InsertionFailed UtxoState.InsertUtxoNoTip -insertUtxoDb (UtxoState.UtxoState (TxUtxoBalance outputs inputs) tip) +insertUtxoDb _ (UtxoState.UtxoState _ TipAtGenesis) = throwError $ InsertionFailed UtxoState.InsertUtxoNoTip +insertUtxoDb txs (UtxoState.UtxoState (TxUtxoBalance outputs inputs) tip) = insert $ mempty { tipRows = InsertRows $ catMaybes [toDbValue tip] , unspentOutputRows = InsertRows $ UnspentOutputRow tipRowId . toDbValue <$> Set.toList outputs , unmatchedInputRows = InsertRows $ UnmatchedInputRow tipRowId . toDbValue <$> Set.toList inputs + , utxoOutRefRows = InsertRows $ (\(txOut, txOutRef) -> UtxoRow (toDbValue txOutRef) (toDbValue txOut)) <$> txOuts } where + txOuts = concatMap txOutsWithRef txs tipRowId = TipRowId (toDbValue (tipSlot tip)) reduceOldUtxoDb :: Member BeamEffect effs => Tip -> Eff effs () From aa421e320cdb82511ccb25baaf500a2fe8bb8201 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Mon, 21 Feb 2022 17:24:33 +0500 Subject: [PATCH 11/17] Delete rows in reduceOldUtxoDb and rollbackUtxoDb --- .../src/Plutus/ChainIndex/DbSchema.hs | 22 +++++++++---------- .../src/Plutus/ChainIndex/Handlers.hs | 15 +++++++++++++ 2 files changed, 26 insertions(+), 11 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs index b767777193..bf4de73cf4 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs @@ -77,17 +77,6 @@ instance Table RedeemerRowT where data PrimaryKey RedeemerRowT f = RedeemerRowId (Columnar f ByteString) deriving (Generic, Beamable) primaryKey = RedeemerRowId . _redeemerRowHash -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 AddressRowT f = AddressRow { _addressRowCred :: Columnar f ByteString , _addressRowOutRef :: Columnar f ByteString @@ -160,6 +149,17 @@ 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) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index 04c460826a..545c977804 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -333,6 +333,14 @@ reduceOldUtxoDb (Tip (toDbValue -> slot) _ _) = do (\row -> unTipRowId (_unmatchedInputRowTip row) <. val_ slot) -- Among these older changes, delete the matching input/output pairs -- We're deleting only the outputs here, the matching input is deleted by a trigger (See Main.hs) + deleteRows $ delete + (utxoOutRefRows db) + (\utxoRow -> + exists_ (filter_ + (\input -> + (unTipRowId (_unmatchedInputRowTip input) ==. val_ slot) &&. + (_utxoRowOutRef utxoRow ==. _unmatchedInputRowOutRef input)) + (all_ (unmatchedInputRows db)))) deleteRows $ delete (unspentOutputRows db) (\output -> unTipRowId (_unspentOutputRowTip output) ==. val_ slot &&. @@ -346,6 +354,13 @@ rollbackUtxoDb :: Member BeamEffect effs => Point -> Eff effs () rollbackUtxoDb PointAtGenesis = deleteRows $ delete (tipRows db) (const (val_ True)) rollbackUtxoDb (Point (toDbValue -> slot) _) = do deleteRows $ delete (tipRows db) (\row -> _tipRowSlot row >. val_ slot) + deleteRows $ delete (utxoOutRefRows db) + (\utxoRow -> + exists_ (filter_ + (\output -> + (unTipRowId (_unspentOutputRowTip output) >. val_ slot) &&. + (_utxoRowOutRef utxoRow ==. _unspentOutputRowOutRef output)) + (all_ (unspentOutputRows db)))) deleteRows $ delete (unspentOutputRows db) (\row -> unTipRowId (_unspentOutputRowTip row) >. val_ slot) deleteRows $ delete (unmatchedInputRows db) (\row -> unTipRowId (_unmatchedInputRowTip row) >. val_ slot) From e5850640cdc2ea85847dc749b9b1d03d482d4e11 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 22 Feb 2022 12:23:22 +0500 Subject: [PATCH 12/17] Fix review comments --- plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs | 2 +- .../src/Plutus/ChainIndex/Client.hs | 12 ++++++------ .../src/Plutus/ChainIndex/Effects.hs | 4 ++-- .../src/Plutus/ChainIndex/Emulator/Handlers.hs | 6 +++--- .../src/Plutus/ChainIndex/Handlers.hs | 6 +++--- .../src/Plutus/ChainIndex/Server.hs | 2 +- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs index 883089ece0..130ef2fb29 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs @@ -145,7 +145,7 @@ 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 + :<|> "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 diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs index 2d249abf25..2e3f0f1c66 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs @@ -11,7 +11,7 @@ module Plutus.ChainIndex.Client( , getValidator , getMintingPolicy , getStakeValidator - , getTxOut + , getUnspentTxOut , getIsUtxo , getUtxoSetAtAddress , getUtxoSetWithCurrency @@ -48,18 +48,18 @@ getMintingPolicy :: MintingPolicyHash -> ClientM MintingPolicy getStakeValidator :: StakeValidatorHash -> ClientM StakeValidator getRedeemer :: RedeemerHash -> ClientM Redeemer -getTxOut :: TxOutRef -> ClientM ChainIndexTxOut +getUnspentTxOut :: TxOutRef -> ClientM ChainIndexTxOut getIsUtxo :: TxOutRef -> ClientM IsUtxoResponse getUtxoSetAtAddress :: UtxoAtAddressRequest -> ClientM UtxosResponse getUtxoSetWithCurrency :: UtxoWithCurrencyRequest -> ClientM UtxosResponse getTxoSetAtAddress :: TxoAtAddressRequest -> ClientM TxosResponse getTip :: ClientM Tip -(healthCheck, (getDatum, getValidator, getMintingPolicy, getStakeValidator, getRedeemer), getTxOut, getIsUtxo, getUtxoSetAtAddress, getUtxoSetWithCurrency, getTxoSetAtAddress, getTip, collectGarbage) = - (healthCheck_, (getDatum_, getValidator_, getMintingPolicy_, getStakeValidator_, getRedeemer_), getTxOut_, getIsUtxo_, getUtxoSetAtAddress_, getUtxoSetWithCurrency_, 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_ + :<|> getUnspentTxOut_ :<|> getIsUtxo_ :<|> getUtxoSetAtAddress_ :<|> getUtxoSetWithCurrency_ @@ -99,7 +99,7 @@ handleChainIndexClient event = do MintingPolicyFromHash d -> runClientMaybe (getMintingPolicy d) StakeValidatorFromHash d -> runClientMaybe (getStakeValidator d) RedeemerFromHash d -> runClientMaybe (getRedeemer d) - 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) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs index 8e07d9ed3f..3da77bb0ee 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs @@ -11,7 +11,7 @@ module Plutus.ChainIndex.Effects( , mintingPolicyFromHash , stakeValidatorFromHash , redeemerFromHash - , txOutFromRef + , unspentTxOutFromRef , utxoSetMembership , utxoSetAtAddress , utxoSetWithCurrency @@ -53,7 +53,7 @@ data ChainIndexQueryEffect r where StakeValidatorFromHash :: StakeValidatorHash -> ChainIndexQueryEffect (Maybe StakeValidator) -- | Get the TxOut from a TxOutRef (if available) - TxOutFromRef :: TxOutRef -> ChainIndexQueryEffect (Maybe ChainIndexTxOut) + UnspentTxOutFromRef :: TxOutRef -> ChainIndexQueryEffect (Maybe ChainIndexTxOut) -- | Whether a tx output is part of the UTXO set UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs index f0ba118901..0255873d34 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs +++ b/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,7 +119,7 @@ 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) UtxoSetMembership r -> do utxo <- gets (utxoState . view utxoIndex) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index 545c977804..99cb1f50fb 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -82,7 +82,7 @@ handleQuery = \case MintingPolicyFromHash hash -> getScriptFromHash hash RedeemerFromHash hash -> getRedeemerFromHash hash StakeValidatorFromHash hash -> getScriptFromHash hash - TxOutFromRef tor -> getTxOutFromRef tor + UnspentTxOutFromRef tor -> getUtxoutFromRef tor UtxoSetMembership r -> do utxoState <- gets @ChainIndexState UtxoState.utxoState case UtxoState.tip utxoState of @@ -140,13 +140,13 @@ queryOne :: queryOne = fmap (fmap fromDbValue) . selectOne -- | Get the 'ChainIndexTxOut' for a 'TxOutRef'. -getTxOutFromRef :: +getUtxoutFromRef :: forall effs. ( Member BeamEffect effs ) => TxOutRef -> Eff effs (Maybe ChainIndexTxOut) -getTxOutFromRef = queryOne . queryKeyValue utxoOutRefRows _utxoRowOutRef _utxoRowTxOut +getUtxoutFromRef = queryOne . queryKeyValue utxoOutRefRows _utxoRowOutRef _utxoRowTxOut getUtxoSetAtAddress :: forall effs. diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs index b5b46b7e14..49ab80ec76 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Server.hs @@ -61,7 +61,7 @@ serveChainIndex :: serveChainIndex = pure NoContent :<|> serveFromHashApi - :<|> (E.txOutFromRef >=> handleMaybe) + :<|> (E.unspentTxOutFromRef >=> handleMaybe) :<|> E.utxoSetMembership :<|> (\(UtxoAtAddressRequest pq c) -> E.utxoSetAtAddress (fromMaybe def pq) c) :<|> (\(UtxoWithCurrencyRequest pq c) -> E.utxoSetWithCurrency (fromMaybe def pq) c) From 347fbb21f097e814e3d2af767f74757c3a5e9f9f Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 22 Feb 2022 13:40:30 +0500 Subject: [PATCH 13/17] Add unspentTxOutFromRef tests --- .../ChainIndex/Emulator/HandlersSpec.hs | 24 ++++++++++++++++++- .../test/Plutus/ChainIndex/HandlersSpec.hs | 21 +++++++++++++++- 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs index 9c74cf0ff5..cf101e0fe4 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs @@ -17,11 +17,13 @@ import Control.Monad.Freer.State (State, runState) import Control.Monad.Freer.Writer (runWriter) import Control.Monad.IO.Class (liftIO) import Data.Default (def) +import Data.Maybe (isJust) import Data.Sequence (Seq) import Data.Set qualified as S import Generators qualified as Gen import Ledger (outValue) -import Plutus.ChainIndex (ChainIndexLog, Page (pageItems), PageQuery (PageQuery), appendBlock, utxoSetWithCurrency) +import Plutus.ChainIndex (ChainIndexLog, Page (pageItems), PageQuery (PageQuery), appendBlock, unspentTxOutFromRef, + utxoSetWithCurrency) import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse)) import Plutus.ChainIndex.ChainIndexError (ChainIndexError) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect) @@ -41,6 +43,9 @@ tests = do [ testGroup "utxoSetAtAddress" [ testProperty "each txOutRef should be unspent" eachTxOutRefAtAddressShouldBeUnspentSpec ] + , testGroup "unspentTxOutFromRef" + [ testProperty "get unspent tx out from ref" eachTxOutRefAtAddressShouldHaveTxOutSpec + ] , testGroup "utxoSetWithCurrency" [ testProperty "each txOutRef should be unspent" eachTxOutRefWithCurrencyShouldBeUnspentSpec , testProperty "should restrict to non-ADA currencies" cantRequestForTxOutRefsWithAdaSpec @@ -63,6 +68,23 @@ eachTxOutRefAtAddressShouldBeUnspentSpec = property $ do Left _ -> Hedgehog.assert False Right utxoGroups -> S.fromList (concat utxoGroups) === view Gen.txgsUtxoSet state +-- | After generating and appending a block in the chain index, verify that +-- querying the chain index with each of the addresses in the block returns +-- unspent 'TxOutRef's with presented 'TxOut's. +eachTxOutRefAtAddressShouldHaveTxOutSpec :: Property +eachTxOutRefAtAddressShouldHaveTxOutSpec = property $ do + ((tip, block), _) <- forAll $ Gen.runTxGenState Gen.genNonEmptyBlock + + result <- liftIO $ runEmulatedChainIndex mempty $ do + -- Append the generated block in the chain index + appendBlock (Block tip (map (, def) block)) + utxos <- utxoSetFromBlockAddrs block + traverse unspentTxOutFromRef (concat utxos) + + case result of + Left _ -> Hedgehog.assert False + Right utxouts -> Hedgehog.assert $ and $ map isJust utxouts + -- | After generating and appending a block in the chain index, verify that -- querying the chain index with each of the asset classes in the block returns -- unspent 'TxOutRef's. diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs index 689b2a20bd..94bebbaafd 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs @@ -16,6 +16,7 @@ import Control.Monad.Freer.Extras.Beam (BeamEffect) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Tracer (nullTracer) import Data.Default (def) +import Data.Maybe (isJust) import Data.Set qualified as S import Database.Beam.Migrate.Simple (autoMigrate) import Database.Beam.Sqlite qualified as Sqlite @@ -25,7 +26,7 @@ import Generators qualified as Gen import Hedgehog (MonadTest, Property, assert, failure, forAll, property, (===)) import Ledger (outValue) import Plutus.ChainIndex (Page (pageItems), PageQuery (PageQuery), RunRequirements (..), appendBlock, citxOutputs, - runChainIndexEffects, utxoSetWithCurrency) + runChainIndexEffects, unspentTxOutFromRef, utxoSetWithCurrency) import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse)) import Plutus.ChainIndex.DbSchema (checkedSqliteDb) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect) @@ -43,6 +44,9 @@ tests = do [ testGroup "utxoSetAtAddress" [ testProperty "each txOutRef should be unspent" eachTxOutRefAtAddressShouldBeUnspentSpec ] + , testGroup "unspentTxOutFromRef" + [ testProperty "get unspent tx out from ref" eachTxOutRefAtAddressShouldHaveTxOutSpec + ] , testGroup "utxoSetWithCurrency" [ testProperty "each txOutRef should be unspent" eachTxOutRefWithCurrencyShouldBeUnspentSpec , testProperty "should restrict to non-ADA currencies" cantRequestForTxOutRefsWithAdaSpec @@ -63,6 +67,21 @@ eachTxOutRefAtAddressShouldBeUnspentSpec = property $ do S.fromList (concat utxoGroups) === view Gen.txgsUtxoSet state +-- | After generating and appending a block in the chain index, verify that +-- querying the chain index with each of the addresses in the block returns +-- unspent 'TxOutRef's with presented 'TxOut's. +eachTxOutRefAtAddressShouldHaveTxOutSpec :: Property +eachTxOutRefAtAddressShouldHaveTxOutSpec = property $ do + ((tip, block), _) <- forAll $ Gen.runTxGenState Gen.genNonEmptyBlock + + utxouts <- runChainIndexTest $ do + -- Append the generated block in the chain index + appendBlock (Block tip (map (, def) block)) + utxos <- utxoSetFromBlockAddrs block + traverse unspentTxOutFromRef (concat utxos) + + Hedgehog.assert $ and $ map isJust utxouts + -- | After generating and appending a block in the chain index, verify that -- querying the chain index with each of the addresses in the block returns -- unspent 'TxOutRef's. From 581812ade2cf03f07342b6e59e89f47944616622 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 22 Feb 2022 14:18:45 +0500 Subject: [PATCH 14/17] fix plutus-contract --- plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs | 2 +- plutus-contract/src/Wallet/Emulator/Wallet.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs index 96c85d6c4e..cad6c92bcb 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -228,7 +228,7 @@ handleChainIndexQueries = RequestHandler $ \chainIndexQuery -> MintingPolicyFromHash h -> MintingPolicyHashResponse <$> ChainIndexEff.mintingPolicyFromHash h StakeValidatorFromHash h -> StakeValidatorHashResponse <$> ChainIndexEff.stakeValidatorFromHash h RedeemerFromHash h -> RedeemerHashResponse <$> ChainIndexEff.redeemerFromHash h - TxOutFromRef txOutRef -> TxOutRefResponse <$> ChainIndexEff.txOutFromRef txOutRef + TxOutFromRef txOutRef -> TxOutRefResponse <$> ChainIndexEff.unspentTxOutFromRef txOutRef UtxoSetMembership txOutRef -> UtxoSetMembershipResponse <$> ChainIndexEff.utxoSetMembership txOutRef UtxoSetAtAddress pq c -> UtxoSetAtResponse <$> ChainIndexEff.utxoSetAtAddress pq c UtxoSetWithCurrency pq ac -> UtxoSetWithCurrencyResponse <$> ChainIndexEff.utxoSetWithCurrency pq ac diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index 5dde43fd04..42de1f8a61 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -309,7 +309,7 @@ ownOutputs WalletState{_mockWallet} = do pure $ ChainIndex.pageItems refPage ++ nextItems txOutRefTxOutFromRef :: TxOutRef -> Eff effs (Maybe (TxOutRef, ChainIndexTxOut)) - txOutRefTxOutFromRef ref = fmap (ref,) <$> ChainIndex.txOutFromRef ref + txOutRefTxOutFromRef ref = fmap (ref,) <$> ChainIndex.unspentTxOutFromRef ref validateTxAndAddFees :: ( Member (Error WAPI.WalletAPIError) effs @@ -342,7 +342,7 @@ lookupValue :: => Tx.TxIn -> Eff effs Value lookupValue outputRef@TxIn {txInRef} = do - txoutMaybe <- ChainIndex.txOutFromRef txInRef + txoutMaybe <- ChainIndex.unspentTxOutFromRef txInRef case txoutMaybe of Just txout -> pure $ view Ledger.ciTxOutValue txout Nothing -> From 35aabf0dd2dda5aca1d0d265a8588521169ae9f1 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 22 Feb 2022 14:46:26 +0500 Subject: [PATCH 15/17] fix plutus-pab --- plutus-pab/src/Plutus/PAB/Core.hs | 2 +- plutus-pab/src/Plutus/PAB/Simulator.hs | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/plutus-pab/src/Plutus/PAB/Core.hs b/plutus-pab/src/Plutus/PAB/Core.hs index 3e73ff69cf..546d535429 100644 --- a/plutus-pab/src/Plutus/PAB/Core.hs +++ b/plutus-pab/src/Plutus/PAB/Core.hs @@ -584,7 +584,7 @@ valueAt :: Wallet -> PABAction t env Value valueAt wallet = do handleAgentThread wallet Nothing $ do utxoRefs <- getAllUtxoRefs def - txOutsM <- traverse ChainIndex.txOutFromRef utxoRefs + txOutsM <- traverse ChainIndex.unspentTxOutFromRef utxoRefs pure $ foldMap (view ciTxOutValue) $ catMaybes txOutsM where cred = addressCredential $ mockWalletAddress wallet diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index a8394efd53..a24a9e15c8 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -108,8 +108,7 @@ import Ledger.Index qualified as UtxoIndex import Ledger.TimeSlot (SlotConfig (SlotConfig, scSlotLength)) import Ledger.Value (Value, flattenValue) import Plutus.ChainIndex.Emulator (ChainIndexControlEffect, ChainIndexEmulatorState, ChainIndexError, ChainIndexLog, - ChainIndexQueryEffect (DatumFromHash, GetTip, MintingPolicyFromHash, RedeemerFromHash, StakeValidatorFromHash, TxOutFromRef, TxoSetAtAddress, UtxoSetAtAddress, UtxoSetMembership, UtxoSetWithCurrency, ValidatorFromHash), - TxOutStatus, TxStatus, getTip) + ChainIndexQueryEffect (..), TxOutStatus, TxStatus, getTip) import Plutus.ChainIndex.Emulator qualified as ChainIndex import Plutus.PAB.Core (EffectHandlers (EffectHandlers, handleContractDefinitionEffect, handleContractEffect, handleContractStoreEffect, handleLogMessages, handleServicesEffects, initialiseEnvironment, onShutdown, onStartup)) import Plutus.PAB.Core qualified as Core @@ -580,7 +579,7 @@ handleChainIndexEffect = runChainIndexEffects @t . \case MintingPolicyFromHash h -> ChainIndex.mintingPolicyFromHash h StakeValidatorFromHash h -> ChainIndex.stakeValidatorFromHash h RedeemerFromHash h -> ChainIndex.redeemerFromHash h - TxOutFromRef ref -> ChainIndex.txOutFromRef ref + UnspentTxOutFromRef ref -> ChainIndex.unspentTxOutFromRef ref UtxoSetMembership ref -> ChainIndex.utxoSetMembership ref UtxoSetAtAddress pq addr -> ChainIndex.utxoSetAtAddress pq addr UtxoSetWithCurrency pq ac -> ChainIndex.utxoSetWithCurrency pq ac From 95ae6c55e7e80cdd7762b092136e06436491d888 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 22 Feb 2022 15:13:34 +0500 Subject: [PATCH 16/17] fix --- plutus-contract/src/Plutus/Contract.hs | 2 +- plutus-contract/src/Plutus/Contract/Effects.hs | 14 +++++++------- plutus-contract/src/Plutus/Contract/Request.hs | 16 ++++++++-------- .../src/Plutus/Contract/Trace/RequestHandler.hs | 5 ++--- plutus-contract/test/Spec/Contract.hs | 2 +- plutus-use-cases/src/Plutus/Contracts/PubKey.hs | 2 +- 6 files changed, 20 insertions(+), 21 deletions(-) diff --git a/plutus-contract/src/Plutus/Contract.hs b/plutus-contract/src/Plutus/Contract.hs index 243f8f4b44..18909d4821 100644 --- a/plutus-contract/src/Plutus/Contract.hs +++ b/plutus-contract/src/Plutus/Contract.hs @@ -53,7 +53,7 @@ module Plutus.Contract( , Request.validatorFromHash , Request.mintingPolicyFromHash , Request.stakeValidatorFromHash - , Request.txOutFromRef + , Request.unspentTxOutFromRef , Request.utxoRefMembership , Request.utxoRefsAt , Request.utxoRefsWithCurrency diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index 09045699ec..654e84b96b 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -29,7 +29,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _ValidatorFromHash, _MintingPolicyFromHash, _RedeemerFromHash, - _TxOutFromRef, + _UnspentTxOutFromRef, _UtxoSetMembership, _UtxoSetAtAddress, _UtxoSetWithCurrency, @@ -59,7 +59,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _ValidatorHashResponse, _MintingPolicyHashResponse, _RedeemerHashResponse, - _TxOutRefResponse, + _UnspentTxOutResponse, _TxIdResponse, _UtxoSetMembershipResponse, _UtxoSetAtResponse, @@ -210,7 +210,7 @@ chainIndexMatches q r = case (q, r) of (MintingPolicyFromHash{}, MintingPolicyHashResponse{}) -> True (StakeValidatorFromHash{}, StakeValidatorHashResponse{}) -> True (RedeemerFromHash{}, RedeemerHashResponse{}) -> True - (TxOutFromRef{}, TxOutRefResponse{}) -> True + (UnspentTxOutFromRef{}, UnspentTxOutResponse{}) -> True (UtxoSetMembership{}, UtxoSetMembershipResponse{}) -> True (UtxoSetAtAddress{}, UtxoSetAtResponse{}) -> True (UtxoSetWithCurrency{}, UtxoSetWithCurrencyResponse{}) -> True @@ -227,7 +227,7 @@ data ChainIndexQuery = | MintingPolicyFromHash MintingPolicyHash | StakeValidatorFromHash StakeValidatorHash | RedeemerFromHash RedeemerHash - | TxOutFromRef TxOutRef + | UnspentTxOutFromRef TxOutRef | UtxoSetMembership TxOutRef | UtxoSetAtAddress (PageQuery TxOutRef) Credential | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass @@ -243,7 +243,7 @@ instance Pretty ChainIndexQuery where MintingPolicyFromHash h -> "requesting minting policy from hash" <+> pretty h StakeValidatorFromHash h -> "requesting stake validator from hash" <+> pretty h RedeemerFromHash h -> "requesting redeemer from hash" <+> pretty h - TxOutFromRef r -> "requesting utxo from utxo reference" <+> pretty r + UnspentTxOutFromRef r -> "requesting utxo from utxo reference" <+> pretty r UtxoSetMembership txOutRef -> "whether tx output is part of the utxo set" <+> pretty txOutRef UtxoSetAtAddress _ c -> "requesting utxos located at addresses with the credential" <+> pretty c UtxoSetWithCurrency _ ac -> "requesting utxos containing the asset class" <+> pretty ac @@ -258,7 +258,7 @@ data ChainIndexResponse = | ValidatorHashResponse (Maybe Validator) | MintingPolicyHashResponse (Maybe MintingPolicy) | StakeValidatorHashResponse (Maybe StakeValidator) - | TxOutRefResponse (Maybe ChainIndexTxOut) + | UnspentTxOutResponse (Maybe ChainIndexTxOut) | RedeemerHashResponse (Maybe Redeemer) | TxIdResponse (Maybe ChainIndexTx) | UtxoSetMembershipResponse IsUtxoResponse @@ -277,7 +277,7 @@ instance Pretty ChainIndexResponse where MintingPolicyHashResponse m -> "Chain index minting policy from hash response:" <+> pretty m StakeValidatorHashResponse m -> "Chain index stake validator from hash response:" <+> pretty m RedeemerHashResponse r -> "Chain index redeemer from hash response:" <+> pretty r - TxOutRefResponse t -> "Chain index utxo from utxo ref response:" <+> pretty t + UnspentTxOutResponse t -> "Chain index utxo from utxo ref response:" <+> pretty t TxIdResponse t -> "Chain index tx from tx id response:" <+> pretty (_citxTxId <$> t) UtxoSetMembershipResponse (IsUtxoResponse tip b) -> "Chain index response whether tx output ref is part of the UTxO set:" diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index ca5e509ec2..17ca96a00c 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -33,7 +33,7 @@ module Plutus.Contract.Request( , mintingPolicyFromHash , stakeValidatorFromHash , redeemerFromHash - , txOutFromRef + , unspentTxOutFromRef , utxoRefMembership , utxoRefsAt , utxoRefsWithCurrency @@ -312,17 +312,17 @@ redeemerFromHash h = do E.RedeemerHashResponse r -> pure r r -> throwError $ review _ChainIndexContractError ("RedeemerHashResponse", r) -txOutFromRef :: +unspentTxOutFromRef :: forall w s e. ( AsContractError e ) => TxOutRef -> Contract w s e (Maybe ChainIndexTxOut) -txOutFromRef ref = do - cir <- pabReq (ChainIndexQueryReq $ E.TxOutFromRef ref) E._ChainIndexQueryResp +unspentTxOutFromRef ref = do + cir <- pabReq (ChainIndexQueryReq $ E.UnspentTxOutFromRef ref) E._ChainIndexQueryResp case cir of - E.TxOutRefResponse r -> pure r - r -> throwError $ review _ChainIndexContractError ("TxOutRefResponse", r) + E.UnspentTxOutResponse r -> pure r + r -> throwError $ review _ChainIndexContractError ("UnspentTxOutResponse", r) utxoRefMembership :: forall w s e. @@ -394,7 +394,7 @@ utxosAt addr = do where f acc page = do let utxoRefs = pageItems page - txOuts <- traverse txOutFromRef utxoRefs + txOuts <- traverse unspentTxOutFromRef utxoRefs let utxos = Map.fromList $ mapMaybe (\(ref, txOut) -> fmap (ref,) txOut) $ zip utxoRefs txOuts @@ -409,7 +409,7 @@ utxosTxOutTxFromTx tx = catMaybes <$> mapM mkOutRef (txOutRefs tx) where mkOutRef txOutRef = do - ciTxOutM <- txOutFromRef txOutRef + ciTxOutM <- unspentTxOutFromRef txOutRef pure $ ciTxOutM >>= \ciTxOut -> pure (txOutRef, (ciTxOut, tx)) -- | Get the transaction outputs at an address. diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs index cad6c92bcb..9277fd63e9 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -53,8 +53,7 @@ import Ledger.TimeSlot qualified as TimeSlot import Ledger.Tx (CardanoTx) import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.ChainIndex.Effects qualified as ChainIndexEff -import Plutus.Contract.Effects (ChainIndexQuery (DatumFromHash, GetTip, MintingPolicyFromHash, RedeemerFromHash, StakeValidatorFromHash, TxOutFromRef, TxoSetAtAddress, UtxoSetAtAddress, UtxoSetMembership, UtxoSetWithCurrency, ValidatorFromHash), - ChainIndexResponse (DatumHashResponse, GetTipResponse, MintingPolicyHashResponse, RedeemerHashResponse, StakeValidatorHashResponse, TxOutRefResponse, TxoSetAtResponse, UtxoSetAtResponse, UtxoSetMembershipResponse, UtxoSetWithCurrencyResponse, ValidatorHashResponse)) +import Plutus.Contract.Effects (ChainIndexQuery (..), ChainIndexResponse (..)) import Plutus.Contract.Wallet qualified as Wallet import Wallet.API (WalletAPIError) import Wallet.Effects (NodeClientEffect, WalletEffect) @@ -228,7 +227,7 @@ handleChainIndexQueries = RequestHandler $ \chainIndexQuery -> MintingPolicyFromHash h -> MintingPolicyHashResponse <$> ChainIndexEff.mintingPolicyFromHash h StakeValidatorFromHash h -> StakeValidatorHashResponse <$> ChainIndexEff.stakeValidatorFromHash h RedeemerFromHash h -> RedeemerHashResponse <$> ChainIndexEff.redeemerFromHash h - TxOutFromRef txOutRef -> TxOutRefResponse <$> ChainIndexEff.unspentTxOutFromRef txOutRef + UnspentTxOutFromRef ref -> UnspentTxOutResponse <$> ChainIndexEff.unspentTxOutFromRef ref UtxoSetMembership txOutRef -> UtxoSetMembershipResponse <$> ChainIndexEff.utxoSetMembership txOutRef UtxoSetAtAddress pq c -> UtxoSetAtResponse <$> ChainIndexEff.utxoSetAtAddress pq c UtxoSetWithCurrency pq ac -> UtxoSetWithCurrencyResponse <$> ChainIndexEff.utxoSetWithCurrency pq ac diff --git a/plutus-contract/test/Spec/Contract.hs b/plutus-contract/test/Spec/Contract.hs index a8d4ab13fa..c0334cfec4 100644 --- a/plutus-contract/test/Spec/Contract.hs +++ b/plutus-contract/test/Spec/Contract.hs @@ -268,7 +268,7 @@ tests = -- contract's caller. It's status should be changed eventually -- to confirmed spent. pubKeyHash <- ownPaymentPubKeyHash - ciTxOutM <- txOutFromRef utxo + ciTxOutM <- unspentTxOutFromRef utxo let lookups = Constraints.unspentOutputs (maybe mempty (Map.singleton utxo) ciTxOutM) submitTxConstraintsWith @Void lookups $ Constraints.mustSpendPubKeyOutput utxo <> Constraints.mustBeSignedBy pubKeyHash diff --git a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs index 6ad0ac8acf..c62d7fd238 100644 --- a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs +++ b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs @@ -84,6 +84,6 @@ pubKeyContract pk vl = mapError (review _PubKeyError ) $ do case refs of [] -> throwing _ScriptOutputMissing pk [outRef] -> do - ciTxOut <- txOutFromRef outRef + ciTxOut <- unspentTxOutFromRef outRef pure (outRef, ciTxOut, inst) _ -> throwing _MultipleScriptOutputs pk From ede21f045a6adc3bba698501c34ed74d97f7b50b Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 22 Feb 2022 15:32:37 +0500 Subject: [PATCH 17/17] update purs --- .../generated/Plutus/Contract/Effects.purs | 24 +++++++++---------- .../generated/Plutus/Contract/Effects.purs | 24 +++++++++---------- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs index 0004ebdb75..f514021e44 100644 --- a/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs +++ b/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs @@ -125,7 +125,7 @@ data ChainIndexQuery | MintingPolicyFromHash String | StakeValidatorFromHash String | RedeemerFromHash String - | TxOutFromRef TxOutRef + | UnspentTxOutFromRef TxOutRef | UtxoSetMembership TxOutRef | UtxoSetAtAddress (PageQuery TxOutRef) Credential | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass @@ -144,7 +144,7 @@ instance EncodeJson ChainIndexQuery where MintingPolicyFromHash a -> E.encodeTagged "MintingPolicyFromHash" a E.value StakeValidatorFromHash a -> E.encodeTagged "StakeValidatorFromHash" a E.value RedeemerFromHash a -> E.encodeTagged "RedeemerFromHash" a E.value - TxOutFromRef a -> E.encodeTagged "TxOutFromRef" a E.value + UnspentTxOutFromRef a -> E.encodeTagged "UnspentTxOutFromRef" a E.value UtxoSetMembership a -> E.encodeTagged "UtxoSetMembership" a E.value UtxoSetAtAddress a b -> E.encodeTagged "UtxoSetAtAddress" (a /\ b) (E.tuple (E.value >/\< E.value)) UtxoSetWithCurrency a b -> E.encodeTagged "UtxoSetWithCurrency" (a /\ b) (E.tuple (E.value >/\< E.value)) @@ -160,7 +160,7 @@ instance DecodeJson ChainIndexQuery where , "MintingPolicyFromHash" /\ D.content (MintingPolicyFromHash <$> D.value) , "StakeValidatorFromHash" /\ D.content (StakeValidatorFromHash <$> D.value) , "RedeemerFromHash" /\ D.content (RedeemerFromHash <$> D.value) - , "TxOutFromRef" /\ D.content (TxOutFromRef <$> D.value) + , "UnspentTxOutFromRef" /\ D.content (UnspentTxOutFromRef <$> D.value) , "UtxoSetMembership" /\ D.content (UtxoSetMembership <$> D.value) , "UtxoSetAtAddress" /\ D.content (D.tuple $ UtxoSetAtAddress D.value D.value) , "UtxoSetWithCurrency" /\ D.content (D.tuple $ UtxoSetWithCurrency D.value D.value) @@ -197,9 +197,9 @@ _RedeemerFromHash = prism' RedeemerFromHash case _ of (RedeemerFromHash a) -> Just a _ -> Nothing -_TxOutFromRef :: Prism' ChainIndexQuery TxOutRef -_TxOutFromRef = prism' TxOutFromRef case _ of - (TxOutFromRef a) -> Just a +_UnspentTxOutFromRef :: Prism' ChainIndexQuery TxOutRef +_UnspentTxOutFromRef = prism' UnspentTxOutFromRef case _ of + (UnspentTxOutFromRef a) -> Just a _ -> Nothing _UtxoSetMembership :: Prism' ChainIndexQuery TxOutRef @@ -234,7 +234,7 @@ data ChainIndexResponse | ValidatorHashResponse (Maybe Validator) | MintingPolicyHashResponse (Maybe MintingPolicy) | StakeValidatorHashResponse (Maybe StakeValidator) - | TxOutRefResponse (Maybe ChainIndexTxOut) + | UnspentTxOutResponse (Maybe ChainIndexTxOut) | RedeemerHashResponse (Maybe String) | TxIdResponse (Maybe ChainIndexTx) | UtxoSetMembershipResponse IsUtxoResponse @@ -255,7 +255,7 @@ instance EncodeJson ChainIndexResponse where ValidatorHashResponse a -> E.encodeTagged "ValidatorHashResponse" a (E.maybe E.value) MintingPolicyHashResponse a -> E.encodeTagged "MintingPolicyHashResponse" a (E.maybe E.value) StakeValidatorHashResponse a -> E.encodeTagged "StakeValidatorHashResponse" a (E.maybe E.value) - TxOutRefResponse a -> E.encodeTagged "TxOutRefResponse" a (E.maybe E.value) + UnspentTxOutResponse a -> E.encodeTagged "UnspentTxOutResponse" a (E.maybe E.value) RedeemerHashResponse a -> E.encodeTagged "RedeemerHashResponse" a (E.maybe E.value) TxIdResponse a -> E.encodeTagged "TxIdResponse" a (E.maybe E.value) UtxoSetMembershipResponse a -> E.encodeTagged "UtxoSetMembershipResponse" a E.value @@ -273,7 +273,7 @@ instance DecodeJson ChainIndexResponse where , "ValidatorHashResponse" /\ D.content (ValidatorHashResponse <$> (D.maybe D.value)) , "MintingPolicyHashResponse" /\ D.content (MintingPolicyHashResponse <$> (D.maybe D.value)) , "StakeValidatorHashResponse" /\ D.content (StakeValidatorHashResponse <$> (D.maybe D.value)) - , "TxOutRefResponse" /\ D.content (TxOutRefResponse <$> (D.maybe D.value)) + , "UnspentTxOutResponse" /\ D.content (UnspentTxOutResponse <$> (D.maybe D.value)) , "RedeemerHashResponse" /\ D.content (RedeemerHashResponse <$> (D.maybe D.value)) , "TxIdResponse" /\ D.content (TxIdResponse <$> (D.maybe D.value)) , "UtxoSetMembershipResponse" /\ D.content (UtxoSetMembershipResponse <$> D.value) @@ -308,9 +308,9 @@ _StakeValidatorHashResponse = prism' StakeValidatorHashResponse case _ of (StakeValidatorHashResponse a) -> Just a _ -> Nothing -_TxOutRefResponse :: Prism' ChainIndexResponse (Maybe ChainIndexTxOut) -_TxOutRefResponse = prism' TxOutRefResponse case _ of - (TxOutRefResponse a) -> Just a +_UnspentTxOutResponse :: Prism' ChainIndexResponse (Maybe ChainIndexTxOut) +_UnspentTxOutResponse = prism' UnspentTxOutResponse case _ of + (UnspentTxOutResponse a) -> Just a _ -> Nothing _RedeemerHashResponse :: Prism' ChainIndexResponse (Maybe String) diff --git a/plutus-playground-client/generated/Plutus/Contract/Effects.purs b/plutus-playground-client/generated/Plutus/Contract/Effects.purs index 0004ebdb75..f514021e44 100644 --- a/plutus-playground-client/generated/Plutus/Contract/Effects.purs +++ b/plutus-playground-client/generated/Plutus/Contract/Effects.purs @@ -125,7 +125,7 @@ data ChainIndexQuery | MintingPolicyFromHash String | StakeValidatorFromHash String | RedeemerFromHash String - | TxOutFromRef TxOutRef + | UnspentTxOutFromRef TxOutRef | UtxoSetMembership TxOutRef | UtxoSetAtAddress (PageQuery TxOutRef) Credential | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass @@ -144,7 +144,7 @@ instance EncodeJson ChainIndexQuery where MintingPolicyFromHash a -> E.encodeTagged "MintingPolicyFromHash" a E.value StakeValidatorFromHash a -> E.encodeTagged "StakeValidatorFromHash" a E.value RedeemerFromHash a -> E.encodeTagged "RedeemerFromHash" a E.value - TxOutFromRef a -> E.encodeTagged "TxOutFromRef" a E.value + UnspentTxOutFromRef a -> E.encodeTagged "UnspentTxOutFromRef" a E.value UtxoSetMembership a -> E.encodeTagged "UtxoSetMembership" a E.value UtxoSetAtAddress a b -> E.encodeTagged "UtxoSetAtAddress" (a /\ b) (E.tuple (E.value >/\< E.value)) UtxoSetWithCurrency a b -> E.encodeTagged "UtxoSetWithCurrency" (a /\ b) (E.tuple (E.value >/\< E.value)) @@ -160,7 +160,7 @@ instance DecodeJson ChainIndexQuery where , "MintingPolicyFromHash" /\ D.content (MintingPolicyFromHash <$> D.value) , "StakeValidatorFromHash" /\ D.content (StakeValidatorFromHash <$> D.value) , "RedeemerFromHash" /\ D.content (RedeemerFromHash <$> D.value) - , "TxOutFromRef" /\ D.content (TxOutFromRef <$> D.value) + , "UnspentTxOutFromRef" /\ D.content (UnspentTxOutFromRef <$> D.value) , "UtxoSetMembership" /\ D.content (UtxoSetMembership <$> D.value) , "UtxoSetAtAddress" /\ D.content (D.tuple $ UtxoSetAtAddress D.value D.value) , "UtxoSetWithCurrency" /\ D.content (D.tuple $ UtxoSetWithCurrency D.value D.value) @@ -197,9 +197,9 @@ _RedeemerFromHash = prism' RedeemerFromHash case _ of (RedeemerFromHash a) -> Just a _ -> Nothing -_TxOutFromRef :: Prism' ChainIndexQuery TxOutRef -_TxOutFromRef = prism' TxOutFromRef case _ of - (TxOutFromRef a) -> Just a +_UnspentTxOutFromRef :: Prism' ChainIndexQuery TxOutRef +_UnspentTxOutFromRef = prism' UnspentTxOutFromRef case _ of + (UnspentTxOutFromRef a) -> Just a _ -> Nothing _UtxoSetMembership :: Prism' ChainIndexQuery TxOutRef @@ -234,7 +234,7 @@ data ChainIndexResponse | ValidatorHashResponse (Maybe Validator) | MintingPolicyHashResponse (Maybe MintingPolicy) | StakeValidatorHashResponse (Maybe StakeValidator) - | TxOutRefResponse (Maybe ChainIndexTxOut) + | UnspentTxOutResponse (Maybe ChainIndexTxOut) | RedeemerHashResponse (Maybe String) | TxIdResponse (Maybe ChainIndexTx) | UtxoSetMembershipResponse IsUtxoResponse @@ -255,7 +255,7 @@ instance EncodeJson ChainIndexResponse where ValidatorHashResponse a -> E.encodeTagged "ValidatorHashResponse" a (E.maybe E.value) MintingPolicyHashResponse a -> E.encodeTagged "MintingPolicyHashResponse" a (E.maybe E.value) StakeValidatorHashResponse a -> E.encodeTagged "StakeValidatorHashResponse" a (E.maybe E.value) - TxOutRefResponse a -> E.encodeTagged "TxOutRefResponse" a (E.maybe E.value) + UnspentTxOutResponse a -> E.encodeTagged "UnspentTxOutResponse" a (E.maybe E.value) RedeemerHashResponse a -> E.encodeTagged "RedeemerHashResponse" a (E.maybe E.value) TxIdResponse a -> E.encodeTagged "TxIdResponse" a (E.maybe E.value) UtxoSetMembershipResponse a -> E.encodeTagged "UtxoSetMembershipResponse" a E.value @@ -273,7 +273,7 @@ instance DecodeJson ChainIndexResponse where , "ValidatorHashResponse" /\ D.content (ValidatorHashResponse <$> (D.maybe D.value)) , "MintingPolicyHashResponse" /\ D.content (MintingPolicyHashResponse <$> (D.maybe D.value)) , "StakeValidatorHashResponse" /\ D.content (StakeValidatorHashResponse <$> (D.maybe D.value)) - , "TxOutRefResponse" /\ D.content (TxOutRefResponse <$> (D.maybe D.value)) + , "UnspentTxOutResponse" /\ D.content (UnspentTxOutResponse <$> (D.maybe D.value)) , "RedeemerHashResponse" /\ D.content (RedeemerHashResponse <$> (D.maybe D.value)) , "TxIdResponse" /\ D.content (TxIdResponse <$> (D.maybe D.value)) , "UtxoSetMembershipResponse" /\ D.content (UtxoSetMembershipResponse <$> D.value) @@ -308,9 +308,9 @@ _StakeValidatorHashResponse = prism' StakeValidatorHashResponse case _ of (StakeValidatorHashResponse a) -> Just a _ -> Nothing -_TxOutRefResponse :: Prism' ChainIndexResponse (Maybe ChainIndexTxOut) -_TxOutRefResponse = prism' TxOutRefResponse case _ of - (TxOutRefResponse a) -> Just a +_UnspentTxOutResponse :: Prism' ChainIndexResponse (Maybe ChainIndexTxOut) +_UnspentTxOutResponse = prism' UnspentTxOutResponse case _ of + (UnspentTxOutResponse a) -> Just a _ -> Nothing _RedeemerHashResponse :: Prism' ChainIndexResponse (Maybe String)