|
| 1 | +{-# LANGUAGE DataKinds #-} |
| 2 | +{-# LANGUAGE NumericUnderscores #-} |
| 3 | +{-# LANGUAGE OverloadedStrings #-} |
| 4 | +{-# LANGUAGE RecordWildCards #-} |
| 5 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 6 | +{-# LANGUAGE TemplateHaskell #-} |
| 7 | +{-# LANGUAGE TypeApplications #-} |
| 8 | + |
| 9 | +{-# OPTIONS_GHC -Wno-missing-fields #-} |
| 10 | +{-# OPTIONS_GHC -Wno-deprecations #-} |
| 11 | + |
| 12 | +module PlutusScripts.V2TxInfo ( |
| 13 | + txInfoInputs |
| 14 | + , txInfoOutputs |
| 15 | + , txInfoFee |
| 16 | + , txInfoMint |
| 17 | + , txInfoSigs |
| 18 | + , txInfoData |
| 19 | + , checkV2TxInfoScriptV2 |
| 20 | + , checkV2TxInfoAssetIdV2 |
| 21 | + , checkV2TxInfoRedeemer |
| 22 | + , checkV2TxInfoMintWitnessV2 |
| 23 | + ) where |
| 24 | + |
| 25 | +import Cardano.Api qualified as C |
| 26 | +import Ledger.Tx.CardanoAPI.Internal (fromCardanoPaymentKeyHash, fromCardanoScriptData, fromCardanoTxIn, |
| 27 | + fromCardanoTxOutToPV2TxInfoTxOut, fromCardanoTxOutToPV2TxInfoTxOut', |
| 28 | + fromCardanoValue) |
| 29 | +import Plutus.Script.Utils.Typed (IsScriptContext (mkUntypedMintingPolicy)) |
| 30 | +import Plutus.V1.Ledger.Api (mkMintingPolicyScript) |
| 31 | +import Plutus.V1.Ledger.Interval qualified as P |
| 32 | +import Plutus.V2.Ledger.Api qualified as PlutusV2 |
| 33 | +import Plutus.V2.Ledger.Contexts (ownCurrencySymbol) |
| 34 | +import PlutusScripts.Helpers (mintScriptWitness', plutusL2, policyIdV2, policyScript, toScriptData) |
| 35 | +import PlutusTx qualified |
| 36 | +import PlutusTx.AssocMap qualified as AMap |
| 37 | +import PlutusTx.Builtins qualified as P |
| 38 | +import PlutusTx.Prelude qualified as P |
| 39 | + |
| 40 | +data V2TxInfo = V2TxInfo |
| 41 | + { expTxInfoInputs :: [PlutusV2.TxInInfo] -- ^ Transaction inputs; cannot be an empty list |
| 42 | + , expTxInfoReferenceInputs :: [PlutusV2.TxInInfo] -- ^ /Added in V2:/ Transaction reference inputs |
| 43 | + , expTxInfoOutputs :: [PlutusV2.TxOut] -- ^ Transaction outputs |
| 44 | + , expTxInfoFee :: PlutusV2.Value -- ^ The fee paid by this transaction. |
| 45 | + , expTxInfoMint :: PlutusV2.Value -- ^ The 'Value' minted by this transaction. |
| 46 | + , expTxInfoDCert :: [PlutusV2.DCert] -- ^ Digests of certificates included in this transaction |
| 47 | + , expTxInfoWdrl :: PlutusV2.Map PlutusV2.StakingCredential Integer -- ^ Withdrawals |
| 48 | + , expTxInfoValidRange :: PlutusV2.POSIXTimeRange -- ^ The valid range for the transaction. |
| 49 | + , expTxInfoSignatories :: [PlutusV2.PubKeyHash] -- ^ Signatures provided with the transaction, attested that they all signed the tx |
| 50 | + , expTxInfoRedeemers :: PlutusV2.Map PlutusV2.ScriptPurpose PlutusV2.Redeemer |
| 51 | + , expTxInfoData :: PlutusV2.Map PlutusV2.DatumHash PlutusV2.Datum -- ^ The lookup table of datums attached to the transaction |
| 52 | + -- , expTxInfoId :: PlutusV2.TxId -- ^ Hash of the pending transaction body (i.e. transaction excluding witnesses). Cannot be verified onchain. |
| 53 | + } |
| 54 | +PlutusTx.unstableMakeIsData ''V2TxInfo |
| 55 | + |
| 56 | +checkV2TxInfoRedeemer :: |
| 57 | + [PlutusV2.TxInInfo] -> |
| 58 | + [PlutusV2.TxInInfo] -> |
| 59 | + [PlutusV2.TxOut] -> |
| 60 | + PlutusV2.Value -> |
| 61 | + PlutusV2.Value -> |
| 62 | + [PlutusV2.DCert] -> |
| 63 | + PlutusV2.Map PlutusV2.StakingCredential Integer -> |
| 64 | + PlutusV2.POSIXTimeRange -> |
| 65 | + [PlutusV2.PubKeyHash] -> |
| 66 | + PlutusV2.Map PlutusV2.ScriptPurpose PlutusV2.Redeemer -> |
| 67 | + PlutusV2.Map PlutusV2.DatumHash PlutusV2.Datum -> |
| 68 | + C.ScriptData |
| 69 | +checkV2TxInfoRedeemer expIns expRefIns expOuts expFee expMint expDCert expWdrl expRange expSigs expReds expData = |
| 70 | + toScriptData $ V2TxInfo expIns expRefIns expOuts expFee expMint expDCert expWdrl expRange expSigs expReds expData |
| 71 | + |
| 72 | +txInfoInputs :: (C.TxIn, C.TxOut C.CtxUTxO era) -> PlutusV2.TxInInfo |
| 73 | +txInfoInputs (txIn, txOut) = do PlutusV2.TxInInfo { |
| 74 | + PlutusV2.txInInfoOutRef = fromCardanoTxIn txIn |
| 75 | + , PlutusV2.txInInfoResolved = fromCardanoTxOutToPV2TxInfoTxOut' txOut |
| 76 | + } |
| 77 | + |
| 78 | +txInfoOutputs :: [C.TxOut C.CtxTx era] -> [PlutusV2.TxOut] |
| 79 | +txInfoOutputs = map fromCardanoTxOutToPV2TxInfoTxOut |
| 80 | + |
| 81 | +txInfoFee :: C.Lovelace -> PlutusV2.Value |
| 82 | +txInfoFee = fromCardanoValue . C.lovelaceToValue |
| 83 | + |
| 84 | +txInfoMint :: C.Value -> PlutusV2.Value |
| 85 | +txInfoMint = fromCardanoValue |
| 86 | + |
| 87 | +txInfoSigs :: [C.VerificationKey C.PaymentKey] -> [PlutusV2.PubKeyHash] |
| 88 | +txInfoSigs = map (fromCardanoPaymentKeyHash . C.verificationKeyHash) |
| 89 | + |
| 90 | +txInfoData :: [C.ScriptData] -> PlutusV2.Map PlutusV2.DatumHash PlutusV2.Datum |
| 91 | +txInfoData = PlutusV2.fromList . map (\ datum -> |
| 92 | + (PlutusV2.DatumHash $ PlutusV2.toBuiltin $ C.serialiseToRawBytes $ C.hashScriptData datum, |
| 93 | + PlutusV2.Datum $ fromCardanoScriptData datum)) |
| 94 | + |
| 95 | +-- minting policy -- |
| 96 | + |
| 97 | +{-# INLINABLE mkCheckV2TxInfo #-} |
| 98 | +mkCheckV2TxInfo :: V2TxInfo -> PlutusV2.ScriptContext -> Bool |
| 99 | +mkCheckV2TxInfo V2TxInfo{..} ctx = |
| 100 | + P.traceIfFalse "unexpected txInfoInputs" checkTxInfoInputs && |
| 101 | + P.traceIfFalse "unexpected txInfoReferenceInputs" checkTxInfoReferenceInputs && |
| 102 | + P.traceIfFalse "unexpected txInfoOutputs" checkTxInfoOutputs && |
| 103 | + P.traceIfFalse "unexpected txInfoFee" checkTxInfoFee && |
| 104 | + P.traceIfFalse "unexpected txInfoMint" checkTxInfoMint && |
| 105 | + P.traceIfFalse "unexpected txInfoDCert" checkTxInfoDCert && |
| 106 | + P.traceIfFalse "unexpected txInfoWdrl" checkTxInfoWdrl && |
| 107 | + P.traceIfFalse "provided range doesn't contain txInfoValidRange" checkTxInfoValidRange && |
| 108 | + P.traceIfFalse "unexpected txInfoSignatories" checkTxInfoSignatories && |
| 109 | + P.traceIfFalse "unexpected txInfoRedeemers" checkTxInfoRedeemers && |
| 110 | + P.traceIfFalse "unexpected txInfoData" checkTxInfoData && |
| 111 | + P.traceIfFalse "txInfoId isn't the expected TxId length" checkTxInfoId |
| 112 | + where |
| 113 | + info :: PlutusV2.TxInfo |
| 114 | + info = PlutusV2.scriptContextTxInfo ctx |
| 115 | + |
| 116 | + checkTxInfoInputs = expTxInfoInputs P.== PlutusV2.txInfoInputs info |
| 117 | + checkTxInfoReferenceInputs = expTxInfoReferenceInputs P.== PlutusV2.txInfoReferenceInputs info |
| 118 | + checkTxInfoOutputs = expTxInfoOutputs P.== PlutusV2.txInfoOutputs info |
| 119 | + checkTxInfoFee = expTxInfoFee P.== PlutusV2.txInfoFee info |
| 120 | + checkTxInfoMint = expTxInfoMint P.== PlutusV2.txInfoMint info |
| 121 | + checkTxInfoDCert = expTxInfoDCert P.== PlutusV2.txInfoDCert info |
| 122 | + checkTxInfoWdrl = expTxInfoWdrl P.== PlutusV2.txInfoWdrl info |
| 123 | + checkTxInfoValidRange = expTxInfoValidRange `P.contains` PlutusV2.txInfoValidRange info |
| 124 | + checkTxInfoSignatories = expTxInfoSignatories P.== PlutusV2.txInfoSignatories info |
| 125 | + checkTxInfoRedeemers = do |
| 126 | + let ownScriptPurpose = PlutusV2.Minting (ownCurrencySymbol ctx) |
| 127 | + withoutOwnRedeemer = AMap.delete ownScriptPurpose (PlutusV2.txInfoRedeemers info) |
| 128 | + expTxInfoRedeemers P.== withoutOwnRedeemer -- cannot check own redeemer so only check other script's redeemer |
| 129 | + checkTxInfoData = expTxInfoData P.== PlutusV2.txInfoData info |
| 130 | + checkTxInfoId = P.equalsInteger 32 (P.lengthOfByteString P.$ PlutusV2.getTxId P.$ PlutusV2.txInfoId info) |
| 131 | + |
| 132 | +checkV2TxInfoV2 :: PlutusV2.MintingPolicy |
| 133 | +checkV2TxInfoV2 = mkMintingPolicyScript |
| 134 | + $$(PlutusTx.compile [|| wrap ||]) |
| 135 | + where |
| 136 | + wrap = mkUntypedMintingPolicy @PlutusV2.ScriptContext mkCheckV2TxInfo |
| 137 | + |
| 138 | +checkV2TxInfoScriptV2 :: C.PlutusScript C.PlutusScriptV2 |
| 139 | +checkV2TxInfoScriptV2 = policyScript checkV2TxInfoV2 |
| 140 | + |
| 141 | +checkV2TxInfoAssetIdV2 :: C.AssetId |
| 142 | +checkV2TxInfoAssetIdV2 = C.AssetId (policyIdV2 checkV2TxInfoV2) "V2TxInfo" |
| 143 | + |
| 144 | +checkV2TxInfoMintWitnessV2 :: C.CardanoEra era |
| 145 | + -> C.ScriptData |
| 146 | + -> C.ExecutionUnits |
| 147 | + -> (C.PolicyId, C.ScriptWitness C.WitCtxMint era) |
| 148 | +checkV2TxInfoMintWitnessV2 era redeemer exunits = |
| 149 | + (policyIdV2 checkV2TxInfoV2, |
| 150 | + mintScriptWitness' era plutusL2 (Left checkV2TxInfoScriptV2) redeemer exunits) |
0 commit comments