From 8b9e4cd4021ad6985fcd06da5b6b1c2d3e5f16d4 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 27 Feb 2025 15:22:08 -0400 Subject: [PATCH] Trim --- .../Internal/Experimental/Plutus/Script.hs | 9 ++- .../Experimental/Plutus/ScriptWitness.hs | 70 +++++++------------ 2 files changed, 29 insertions(+), 50 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/Script.hs b/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/Script.hs index be56430a9..9bc87d920 100644 --- a/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/Script.hs +++ b/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/Script.hs @@ -20,9 +20,9 @@ import Cardano.Ledger.Plutus.Language qualified as L -- The deserialization of this type looks at the -- major protocol version and the script language to determine if -- indeed the script is runnable. This is a dramatic improvement over the old api --- which essentially read a 'ByteString'. Any failures due to malformed/invalid scripts --- were caught upon transaction submission or running the script when attempting to --- predict the necessary execution units. +-- which essentially read a 'ByteString' and hoped for the best. +-- Any failures due to malformed/invalid scripts were caught upon transaction +-- submission or running the script when attempting to predict the necessary execution units. -- -- Where do we get the major protocol version from? -- In order to access the major protocol version we pass in an 'era` type parameter which @@ -32,8 +32,7 @@ import Cardano.Ledger.Plutus.Language qualified as L -- The serialized version of 'PlutusRunnable' encodes the script language. -- See `DecCBOR (PlutusRunnable l)` in cardano-ledger for more details. data PlutusScriptInEra (lang :: L.Language) era where - PlutusScriptInEra - :: PlutusRunnable lang -> PlutusScriptInEra lang era + PlutusScriptInEra :: PlutusRunnable lang -> PlutusScriptInEra lang era deriving instance Show (PlutusScriptInEra lang era) diff --git a/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/ScriptWitness.hs b/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/ScriptWitness.hs index 471a3be57..34ec4df61 100644 --- a/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/ScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Internal/Experimental/Plutus/ScriptWitness.hs @@ -276,6 +276,7 @@ getAnyWitnessScriptData eon (AnyPlutusScriptWitness (PlutusScriptWitness l _ scr Nothing -> alonzoEraOnwardsConstraints eon mempty Just d -> alonzoEraOnwardsConstraints eon $ L.TxDats $ fromList [(L.hashData d, d)] +-- | This type collects all the requirements for script witnesses in a transaction. data TxScriptWitnessRequirements era = TxScriptWitnessRequirements (Set L.Language) @@ -331,10 +332,6 @@ obtainMonoidConstraint eon = case eon of AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id --- So how would the new api look? We would paramterize on data Era and --- always have two cases instead of multipl cases --- We could also parameterize on the IsEra era type class for exposed functions - getAnyWitnessScript :: ShelleyBasedEra era -> AnyWitness (ShelleyLedgerEra era) -> Maybe (L.Script (ShelleyLedgerEra era)) getAnyWitnessScript _ AnyKeyWitness = Nothing @@ -361,38 +358,37 @@ fromPlutusRunnable -> AlonzoEraOnwards era -> L.PlutusRunnable lang -> Maybe (L.PlutusScript (ShelleyLedgerEra era)) -fromPlutusRunnable l@L.SPlutusV1 eon runnable = +fromPlutusRunnable L.SPlutusV1 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> - let plutusScript = plutusFromRunnableAssist l runnable + let plutusScript = L.plutusFromRunnable runnable in Just $ L.AlonzoPlutusV1 plutusScript AlonzoEraOnwardsBabbage -> - let plutusScript = plutusFromRunnableAssist l runnable + let plutusScript = L.plutusFromRunnable runnable in Just $ L.BabbagePlutusV1 plutusScript AlonzoEraOnwardsConway -> - let plutusScript = plutusFromRunnableAssist l runnable + let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV1 plutusScript -fromPlutusRunnable l@L.SPlutusV2 eon runnable = +fromPlutusRunnable L.SPlutusV2 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> Nothing AlonzoEraOnwardsBabbage -> - let plutusScript = plutusFromRunnableAssist l runnable + let plutusScript = L.plutusFromRunnable runnable in Just $ L.BabbagePlutusV2 plutusScript AlonzoEraOnwardsConway -> - let plutusScript = plutusFromRunnableAssist l runnable + let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV2 plutusScript -fromPlutusRunnable l@L.SPlutusV3 eon runnable = +fromPlutusRunnable L.SPlutusV3 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> Nothing AlonzoEraOnwardsBabbage -> Nothing AlonzoEraOnwardsConway -> - let plutusScript = plutusFromRunnableAssist l runnable + let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV3 plutusScript --- Created purely to help type inference -plutusFromRunnableAssist :: L.SLanguage lang -> L.PlutusRunnable lang -> L.Plutus lang -plutusFromRunnableAssist _ = L.plutusFromRunnable - +-- | These are all of the "things" a plutus script can witness. We include the relevant +-- type class constraint to avoid boilerplate when creating the 'PlutusPurpose' in +-- the 'GetPlutusScriptPurpose' instances. data Witnessable thing era where WitTxIn :: L.AlonzoEraScript era => TxIn -> Witnessable TxIn era WitTxCert :: L.AlonzoEraScript era => Cert -> Witnessable Cert era @@ -418,14 +414,16 @@ type Voter = Api.AnyVoter type Proposal = Api.AnyProposal --- | In order to reduce boilerplate we reuse cardano-ledger's PlutusPurpose type. This --- type is used in the construction of the redeemer pointers map. The redeemer pointers map --- connects the redeemer and execution units to the thing being witnessed. The map is --- indexed by redeemer pointer! --- So the natural question is how do the Plutus script witnesses know what --- execution units and redeemer is paired with it? The ledger constructs a pointer --- for every Plutus script and this pointer corresponds to the pointer constructed --- in the redeemer pointer map. See 'collectPlutusScriptsWithContext' in 'cardano-ledger'. +-- | To reduce boilerplate, we reuse the `PlutusPurpose` type from `cardano-ledger`. +-- This type is utilized in constructing the redeemer pointers map, which +-- links the redeemer and execution units with the entity being witnessed. +-- The map is indexed by the redeemer pointer. +-- +-- A natural question arises: How do Plutus scripts determine which +-- execution units and redeemer are paired with them? The ledger constructs a redeemer pointer +-- for every Plutus script, and this pointer corresponds to the one in the transaction's +-- redeemer pointers map. For more details, refer to `collectPlutusScriptsWithContext` +-- in `cardano-ledger`. class GetPlutusScriptPurpose era where toPlutusScriptPurpose :: Word32 @@ -466,17 +464,8 @@ createIndexedPlutusScriptWitnesses witnessableThings = | (index, (thing, AnyPlutusScriptWitness sWit)) <- zip [0 ..] witnessableThings ] -{- -The transaction redeemer pointer map allows the ledger to connect a redeemer and execution unit pairing to the relevant -script. The ledger basically reconstructs the indicies of this map can then look up the relevant pairing. --} --- This is the smoking gun. The truth is in Conway votes and proposals were introduced. --- Therefore only in conway we should be allowed to get votes and props being paired with --- witnesses. Can we express this in the type system? Witnessable will have to be parameterized --- on era and we would need a type family to enforce this relation ship --- Witnessable era witnessable -> AnyWitness era -> (Witnessable era witnessable, AnyWitness era) --- And we can be explict about the pairings! We would need the result type of the family to be CanBePaired era witnessable - +-- | The transaction redeemer pointer map allows the ledger to connect a redeemer and execution unit pairing to the relevant +-- script. The ledger basically reconstructs the indicies of this map can then look up the relevant pairing. getAnyWitnessRedeemerPointerMap :: AlonzoEraOnwards era -> (Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era)) @@ -505,10 +494,6 @@ constructRedeemerPointer eon (AnyIndexedPlutusScriptWitness (IndexedPlutusScript L.Redeemers $ fromList [(purpose, (toAlonzoData redeemer, toAlonzoExUnits execUnits))] ----------------------------------------------- --- TEST ----------------------------------------------- - mkPlutusScriptWitness :: AlonzoEraOnwards era -> L.SLanguage plutuslang @@ -524,8 +509,3 @@ mkPlutusScriptWitness _ l plutusScriptRunnable datum scriptRedeemer execUnits = datum scriptRedeemer execUnits - --- PROPOSED REPLACEMENT ------------------------------------------------ - -------------------------------------------------