|
| 1 | +{-# LANGUAGE DataKinds #-} |
| 2 | +{-# LANGUAGE GADTs #-} |
| 3 | +{-# LANGUAGE KindSignatures #-} |
| 4 | + |
| 5 | +module Cardano.Api.Internal.Experimental.Plutus.IndexedPlutusScriptWitness |
| 6 | + ( -- * Constuct an indexed plutus script witness. |
| 7 | + AnyIndexedPlutusScriptWitness (..) |
| 8 | + , IndexedPlutusScriptWitness (..) |
| 9 | + , createIndexedPlutusScriptWitnesses |
| 10 | + , getAnyWitnessRedeemerPointerMap |
| 11 | + ) |
| 12 | +where |
| 13 | + |
| 14 | +import Cardano.Api.Internal.Eon.AlonzoEraOnwards |
| 15 | +import Cardano.Api.Internal.Eon.ShelleyBasedEra |
| 16 | +import Cardano.Api.Internal.Experimental.Plutus.ScriptWitness |
| 17 | +import Cardano.Api.Internal.Experimental.Witness.AnyWitness |
| 18 | +import Cardano.Api.Internal.Script (toAlonzoExUnits) |
| 19 | +import Cardano.Api.Internal.ScriptData |
| 20 | +import Cardano.Api.Ledger qualified as L |
| 21 | + |
| 22 | +import Cardano.Ledger.Alonzo.TxWits qualified as L |
| 23 | + |
| 24 | +import Data.Word |
| 25 | +import GHC.Exts |
| 26 | + |
| 27 | +-- | A Plutus script witness along the thing it is witnessing and the index of that thing. |
| 28 | +-- E.g transaction input, certificate, withdrawal, minting policy, etc. |
| 29 | +-- A Plutus script witness only makes sense in the context of what it is witnessing |
| 30 | +-- and the index of the thing it is witnessing. |
| 31 | +data IndexedPlutusScriptWitness witnessable (lang :: L.Language) (purpose :: PlutusScriptPurpose) era where |
| 32 | + IndexedPlutusScriptWitness |
| 33 | + :: Witnessable witnessable era |
| 34 | + -> (L.PlutusPurpose L.AsIx era) |
| 35 | + -> (PlutusScriptWitness lang purpose era) |
| 36 | + -> IndexedPlutusScriptWitness witnessable lang purpose era |
| 37 | + |
| 38 | +data AnyIndexedPlutusScriptWitness era where |
| 39 | + AnyIndexedPlutusScriptWitness |
| 40 | + :: GetPlutusScriptPurpose era |
| 41 | + => IndexedPlutusScriptWitness witnessable lang purpose era |
| 42 | + -> AnyIndexedPlutusScriptWitness era |
| 43 | + |
| 44 | +createIndexedPlutusScriptWitness |
| 45 | + :: Word32 |
| 46 | + -> Witnessable witnessable era |
| 47 | + -> PlutusScriptWitness lang purpose era |
| 48 | + -> IndexedPlutusScriptWitness witnessable lang purpose era |
| 49 | +createIndexedPlutusScriptWitness index witnessable pSwit = |
| 50 | + IndexedPlutusScriptWitness witnessable (toPlutusScriptPurpose index witnessable) pSwit |
| 51 | + |
| 52 | +createIndexedPlutusScriptWitnesses |
| 53 | + :: [(Witnessable witnessable era, AnyWitness era)] |
| 54 | + -> [AnyIndexedPlutusScriptWitness era] |
| 55 | +createIndexedPlutusScriptWitnesses witnessableThings = |
| 56 | + [ AnyIndexedPlutusScriptWitness $ createIndexedPlutusScriptWitness index thing sWit |
| 57 | + | (index, (thing, AnyPlutusScriptWitness sWit)) <- zip [0 ..] witnessableThings |
| 58 | + ] |
| 59 | + |
| 60 | +-- | The transaction's redeemer pointer map allows the ledger to connect a redeemer and execution unit pairing to the relevant |
| 61 | +-- script. The ledger basically reconstructs the indicies (redeemer pointers) of this map can then look up the relevant |
| 62 | +-- execution units/redeemer pairing. NB the redeemer pointer has been renamed to 'PlutusPurpose AsIndex' in the ledger. |
| 63 | +getAnyWitnessRedeemerPointerMap |
| 64 | + :: AlonzoEraOnwards era |
| 65 | + -> (Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era)) |
| 66 | + -> L.Redeemers (ShelleyLedgerEra era) |
| 67 | +getAnyWitnessRedeemerPointerMap eon (_, AnyKeyWitness) = alonzoEraOnwardsConstraints eon mempty |
| 68 | +getAnyWitnessRedeemerPointerMap eon (_, AnySimpleScriptWitness{}) = alonzoEraOnwardsConstraints eon mempty |
| 69 | +getAnyWitnessRedeemerPointerMap eon anyWit = |
| 70 | + constructRedeeemerPointerMap eon $ |
| 71 | + createIndexedPlutusScriptWitnesses [anyWit] |
| 72 | + |
| 73 | +-- | An 'IndexedPlutusScriptWitness' contains everything we need to construct a single |
| 74 | +-- entry in the redeemer pointer map. |
| 75 | +constructRedeemerPointer |
| 76 | + :: AlonzoEraOnwards era |
| 77 | + -> AnyIndexedPlutusScriptWitness (ShelleyLedgerEra era) |
| 78 | + -> L.Redeemers (ShelleyLedgerEra era) |
| 79 | +constructRedeemerPointer eon (AnyIndexedPlutusScriptWitness (IndexedPlutusScriptWitness _ purpose scriptWit)) = |
| 80 | + let PlutusScriptWitness _ _ _ redeemer execUnits = scriptWit |
| 81 | + in alonzoEraOnwardsConstraints eon $ |
| 82 | + L.Redeemers $ |
| 83 | + fromList [(purpose, (toAlonzoData redeemer, toAlonzoExUnits execUnits))] |
| 84 | + |
| 85 | +constructRedeeemerPointerMap |
| 86 | + :: AlonzoEraOnwards era |
| 87 | + -> [AnyIndexedPlutusScriptWitness ((ShelleyLedgerEra era))] |
| 88 | + -> L.Redeemers (ShelleyLedgerEra era) |
| 89 | +constructRedeeemerPointerMap eon scriptWits = |
| 90 | + let redeemerPointers = map (constructRedeemerPointer eon) scriptWits |
| 91 | + in alonzoEraOnwardsConstraints eon $ mconcat redeemerPointers |
0 commit comments