From 75789b86d69acf1829bbba43ad72051d86665d79 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 24 Jan 2025 16:40:46 +0100 Subject: [PATCH 1/2] Add function `collectScriptHashes` to collect script hashes needed to validate a given transaction --- cardano-api/internal/Cardano/Api/Plutus.hs | 63 ++++++++++++++++++++-- cardano-api/src/Cardano/Api.hs | 2 + 2 files changed, 60 insertions(+), 5 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Plutus.hs b/cardano-api/internal/Cardano/Api/Plutus.hs index 6ca64ecbc0..abc1f01eb8 100644 --- a/cardano-api/internal/Cardano/Api/Plutus.hs +++ b/cardano-api/internal/Cardano/Api/Plutus.hs @@ -1,26 +1,46 @@ --- | This module provides an error to conveniently render plutus related failures. +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} + +-- | This module provides utilities to render the result of plutus execution. module Cardano.Api.Plutus ( DebugPlutusFailure (..) , renderDebugPlutusFailure + , collectScriptHashes ) where -import Cardano.Api.Pretty +import Cardano.Api.Eon.AlonzoEraOnwards (AlonzoEraOnwards (..), + alonzoEraOnwardsConstraints) +import Cardano.Api.Eon.Convert (convert) +import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra) +import Cardano.Api.Pretty (Pretty (pretty), docToText) +import Cardano.Api.Query (UTxO, toLedgerUTxO) +import qualified Cardano.Api.ReexposeLedger as L +import Cardano.Api.Script (ScriptHash, fromShelleyScriptHash) +import qualified Cardano.Api.Script as Api +import Cardano.Api.Tx.Body (ScriptWitnessIndex (..), TxBody, toScriptIndex) +import Cardano.Api.Tx.Sign (Tx (..), makeSignedTransaction) -import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.Alonzo.Scripts as L +import qualified Cardano.Ledger.Alonzo.UTxO as Alonzo import Cardano.Ledger.Binary.Encoding (serialize') import Cardano.Ledger.Binary.Plain (serializeAsHexText) import qualified Cardano.Ledger.Plutus.Evaluate as Plutus import qualified Cardano.Ledger.Plutus.ExUnits as Plutus import qualified Cardano.Ledger.Plutus.Language as Plutus +import qualified Cardano.Ledger.UTxO as L import qualified PlutusLedgerApi.V1 as Plutus +import Data.Bifunctor (Bifunctor (..)) import qualified Data.ByteString.Base64 as B64 -import Data.ByteString.Short as BSS +import qualified Data.ByteString.Short as BSS +import Data.Map (Map) +import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Prettyprinter +import Lens.Micro ((^.)) +import Prettyprinter (indent, line) -- | A structured representation of Plutus script validation failures, -- providing detailed information about the failed execution for debugging purposes. @@ -80,3 +100,36 @@ lookupPlutusErrorCode code = Just err -> Text.pack err Nothing -> "Unknown error code: " <> code -} + +-- | Collect all script hashes that are needed to validate the given transaction +-- and return them in a map with their corresponding 'ScriptWitnessIndex' as key. +collectScriptHashes + :: AlonzoEraOnwards era + -> TxBody era + -> UTxO era + -> Map ScriptWitnessIndex ScriptHash +collectScriptHashes aeo tb utxo = + alonzoEraOnwardsConstraints aeo $ + let ShelleyTx _ ledgerTx' = makeSignedTransaction [] tb + ledgerUTxO = toLedgerUTxO (convert aeo) utxo + in getPurpouses aeo $ L.getScriptsNeeded ledgerUTxO (ledgerTx' ^. L.bodyTxL) + where + getPurpouses + :: L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto + => AlonzoEraOnwards era + -> Alonzo.AlonzoScriptsNeeded (ShelleyLedgerEra era) + -> Map ScriptWitnessIndex Api.ScriptHash + getPurpouses aeo' (Alonzo.AlonzoScriptsNeeded purpouses) = + alonzoEraOnwardsConstraints aeo $ + Map.fromList $ + Prelude.map + (bimap (toScriptIndex aeo' . purpouseAsIxItemToAsIx aeo') fromShelleyScriptHash) + purpouses + + purpouseAsIxItemToAsIx + :: AlonzoEraOnwards era + -> L.PlutusPurpose L.AsIxItem (ShelleyLedgerEra era) + -> L.PlutusPurpose L.AsIx (ShelleyLedgerEra era) + purpouseAsIxItemToAsIx onwards purpose = + alonzoEraOnwardsConstraints onwards $ + L.hoistPlutusPurpose L.toAsIx purpose diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 02498e5324..6b5146c734 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -611,6 +611,7 @@ module Cardano.Api , examplePlutusScriptAlwaysFails -- ** Script data + , collectScriptHashes , HashableScriptData , hashScriptDataBytes , getOriginalScriptDataBytes @@ -1121,6 +1122,7 @@ import Cardano.Api.Monad.Error import Cardano.Api.NetworkId import Cardano.Api.OperationalCertificate import Cardano.Api.Orphans () +import Cardano.Api.Plutus (collectScriptHashes) import Cardano.Api.Pretty import Cardano.Api.Protocol import Cardano.Api.ProtocolParameters From 2d9f90706aa03aeaa3954d487dd15520538f96f2 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 27 Jan 2025 12:40:19 +0100 Subject: [PATCH 2/2] Fix typo on "purposes" MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Clément Hurlin --- cardano-api/internal/Cardano/Api/Plutus.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Plutus.hs b/cardano-api/internal/Cardano/Api/Plutus.hs index abc1f01eb8..0e7bb977e4 100644 --- a/cardano-api/internal/Cardano/Api/Plutus.hs +++ b/cardano-api/internal/Cardano/Api/Plutus.hs @@ -112,24 +112,24 @@ collectScriptHashes aeo tb utxo = alonzoEraOnwardsConstraints aeo $ let ShelleyTx _ ledgerTx' = makeSignedTransaction [] tb ledgerUTxO = toLedgerUTxO (convert aeo) utxo - in getPurpouses aeo $ L.getScriptsNeeded ledgerUTxO (ledgerTx' ^. L.bodyTxL) + in getPurposes aeo $ L.getScriptsNeeded ledgerUTxO (ledgerTx' ^. L.bodyTxL) where - getPurpouses + getPurposes :: L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto => AlonzoEraOnwards era -> Alonzo.AlonzoScriptsNeeded (ShelleyLedgerEra era) -> Map ScriptWitnessIndex Api.ScriptHash - getPurpouses aeo' (Alonzo.AlonzoScriptsNeeded purpouses) = + getPurposes aeo' (Alonzo.AlonzoScriptsNeeded purposes) = alonzoEraOnwardsConstraints aeo $ Map.fromList $ Prelude.map - (bimap (toScriptIndex aeo' . purpouseAsIxItemToAsIx aeo') fromShelleyScriptHash) - purpouses + (bimap (toScriptIndex aeo' . purposeAsIxItemToAsIx aeo') fromShelleyScriptHash) + purposes - purpouseAsIxItemToAsIx + purposeAsIxItemToAsIx :: AlonzoEraOnwards era -> L.PlutusPurpose L.AsIxItem (ShelleyLedgerEra era) -> L.PlutusPurpose L.AsIx (ShelleyLedgerEra era) - purpouseAsIxItemToAsIx onwards purpose = + purposeAsIxItemToAsIx onwards purpose = alonzoEraOnwardsConstraints onwards $ L.hoistPlutusPurpose L.toAsIx purpose