This repository has been archived by the owner on Dec 2, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 214
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add script equivalence context test for the V2 context. (#588)
- Loading branch information
Showing
6 changed files
with
319 additions
and
69 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
154 changes: 154 additions & 0 deletions
154
plutus-example/src/PlutusExample/PlutusVersion2/RedeemerContextEquivalence.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,154 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
|
|
||
|
|
||
| module PlutusExample.PlutusVersion2.RedeemerContextEquivalence | ||
| ( PV2CustomRedeemer (..) | ||
| , v2ScriptContextEquivalenceScript | ||
| , v2ScriptContextEquivalenceSbs | ||
| ) where | ||
|
|
||
| import Prelude hiding (($)) | ||
|
|
||
| import Cardano.Api.Shelley | ||
| import Prelude hiding (($), (&&)) | ||
|
|
||
| import Codec.Serialise | ||
| import Data.ByteString.Lazy qualified as LBS | ||
| import Data.ByteString.Short qualified as SBS | ||
|
|
||
|
|
||
| import Plutus.Script.Utils.V2.Typed.Scripts.Validators as V2 | ||
| import Plutus.V2.Ledger.Api qualified as V2 | ||
| import Plutus.V2.Ledger.Contexts as V2 | ||
| import PlutusTx qualified | ||
| import PlutusTx.Prelude as PlutusPrelude hiding (Semigroup (..), unless, (.)) | ||
|
|
||
| newtype MyCustomDatumV2 = MyCustomDatumV2 Integer | ||
|
|
||
| data PV2CustomRedeemer | ||
| = PV2CustomRedeemer | ||
| { pv2Inputs :: [V2.TxInInfo] | ||
| , pv2RefInputs :: [V2.TxInInfo] | ||
| , pv2Outputs :: [V2.TxOut] | ||
| , pv2Fee :: V2.Value | ||
| , pv2Mint :: V2.Value | ||
| , pv2DCert :: [V2.DCert] | ||
| , pv2Wdrl :: V2.Map V2.StakingCredential Integer | ||
| , pv2ValidRange :: V2.POSIXTimeRange | ||
| , pv2Signatories :: [V2.PubKeyHash] | ||
| , pv2Redeemers :: V2.Map ScriptPurpose V2.Redeemer | ||
| , pv2Data :: V2.Map V2.DatumHash V2.Datum | ||
| } deriving (Prelude.Eq, Show) | ||
|
|
||
| PlutusTx.unstableMakeIsData ''MyCustomDatumV2 | ||
| PlutusTx.unstableMakeIsData ''PV2CustomRedeemer | ||
|
|
||
| -- @(PV2CustomRedeemer inputs refInputs outputs fee mint dCert wdrl validRange signatories redeemers data) | ||
|
|
||
| {-# INLINABLE mkValidator #-} | ||
| mkValidator :: MyCustomDatumV2 -> PV2CustomRedeemer -> V2.ScriptContext -> Bool | ||
| mkValidator _ redeemer scriptContext = | ||
| -- These all work fine | ||
| inputsAreEquivalent redeemer txInfo PlutusPrelude.&& | ||
| referenceInputsAreEquivalent redeemer txInfo PlutusPrelude.&& | ||
| certsAreEquivalent redeemer txInfo PlutusPrelude.&& | ||
| reqSignersAreEquivalent redeemer txInfo PlutusPrelude.&& | ||
| datumHashMapsAreEquivalent redeemer txInfo PlutusPrelude.&& | ||
| outputsAreEquivalent redeemer txInfo PlutusPrelude.&& | ||
| correctNumberOfRedeemers redeemer txInfo | ||
| -- These below are failing | ||
| -- validtyIntervalsAreEquivalent redeemer txInfo | ||
| -- Inequality for validity interval doesnt work. Also the interval reported by the script context is a little ahead of | ||
| -- what is in the transaction | ||
| -- TODO: You can't check the fee with the build command due to how it's constructed | ||
| -- These below have not been tested | ||
| -- withdrawalsAreEquivalent redeemer txInfo | ||
| where | ||
| txInfo :: V2.TxInfo | ||
| txInfo = V2.scriptContextTxInfo scriptContext | ||
|
|
||
| inputsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| inputsAreEquivalent (PV2CustomRedeemer inputs _ _ _ _ _ _ _ _ _ _) tInfo = | ||
| (PlutusPrelude.map txInInfoResolved $ V2.txInfoInputs tInfo) PlutusPrelude.== | ||
| PlutusPrelude.map txInInfoResolved inputs | ||
|
|
||
| referenceInputsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| referenceInputsAreEquivalent (PV2CustomRedeemer _ refInputs _ _ _ _ _ _ _ _ _) tInfo = | ||
| (PlutusPrelude.map txInInfoResolved $ V2.txInfoReferenceInputs tInfo) PlutusPrelude.== | ||
| PlutusPrelude.map txInInfoResolved refInputs | ||
|
|
||
| outputsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| outputsAreEquivalent (PV2CustomRedeemer _ _ outputs _ _ _ _ _ _ _ _) tInfo = | ||
| let scOuts = V2.txInfoOutputs tInfo | ||
| scOutAddrs = PlutusPrelude.map V2.txOutAddress scOuts | ||
| scOutValue = PlutusPrelude.map V2.txOutValue scOuts | ||
| scOutDatums = PlutusPrelude.map V2.txOutDatum scOuts | ||
| scOutReferenceScripts = PlutusPrelude.map V2.txOutReferenceScript scOuts | ||
|
|
||
| redeemerOutAddrs = PlutusPrelude.map V2.txOutAddress outputs | ||
| redeemerOutValue = PlutusPrelude.map V2.txOutValue outputs | ||
| redeemerOutDatums = PlutusPrelude.map V2.txOutDatum outputs | ||
| redeemerOutReferenceScripts = PlutusPrelude.map V2.txOutReferenceScript outputs | ||
| in (scOutAddrs PlutusPrelude.== redeemerOutAddrs) PlutusPrelude.&& | ||
| (scOutDatums PlutusPrelude.== redeemerOutDatums) PlutusPrelude.&& | ||
| (scOutReferenceScripts PlutusPrelude.== redeemerOutReferenceScripts) PlutusPrelude.&& | ||
| -- We want to see if out tx out specified in our tx is equal to one of the txouts in the | ||
| -- script context. So we have a total of 4 outputs when we combine the outputs in the script | ||
| -- context and the redeemer. This would be the two "normal" outputs and the two "change outputs" | ||
| (PlutusPrelude.length (scOutValue PlutusPrelude.++ redeemerOutValue) PlutusPrelude.== 4) PlutusPrelude.&& | ||
| -- You would expect calling nub on the combined values, we should expect a length of 2. However | ||
| -- the change outputs will be different because of how we construct the redeemer. Essentially we | ||
| -- use an idential tx to generate our redeemer (and the redeemer in this tx is a default redeemer with nothing in it) | ||
| -- and then we add that redeemer to a new transaction built with the `build` command. The problem is | ||
| -- the fee and the change outputs created from the initial tx will be different because the size of | ||
| -- the total tx is now different. Therefore we expect the length to be 3 since only the "normal" | ||
| -- txouts are equivalent but the change outputs are different! | ||
| (PlutusPrelude.length (nub $ scOutValue PlutusPrelude.++ redeemerOutValue) PlutusPrelude.== 3) | ||
|
|
||
| certsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| certsAreEquivalent (PV2CustomRedeemer _ _ _ _ _ certs _ _ _ _ _) tInfo = | ||
| V2.txInfoDCert tInfo PlutusPrelude.== certs | ||
|
|
||
| --validtyIntervalsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| --validtyIntervalsAreEquivalent (PV2CustomRedeemer _ _ _ _ _ _ _ validInterval _ _ _) tInfo = | ||
| -- (V2.txInfoValidRange tInfo) PlutusPrelude./= validInterval | ||
| -- V2.ivFrom (V2.txInfoValidRange tInfo) PlutusPrelude.== V2.ivFrom validInterval Fails | ||
|
|
||
| reqSignersAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| reqSignersAreEquivalent (PV2CustomRedeemer _ _ _ _ _ _ _ _ reqSigners _ _) tInfo = | ||
| V2.txInfoSignatories tInfo PlutusPrelude.== reqSigners | ||
|
|
||
| datumHashMapsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| datumHashMapsAreEquivalent (PV2CustomRedeemer _ _ _ _ _ _ _ _ _ _ datumHashMap) tInfo = | ||
| V2.txInfoData tInfo PlutusPrelude.== datumHashMap | ||
|
|
||
| correctNumberOfRedeemers :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| correctNumberOfRedeemers (PV2CustomRedeemer _ _ _ _ _ _ _ _ _ redeemers _) tInfo = | ||
| PlutusPrelude.length (V2.txInfoRedeemers tInfo) PlutusPrelude.== PlutusPrelude.length redeemers | ||
|
|
||
| -- TODO: not done yet | ||
| --withdrawalsAreEquivalent :: PV2CustomRedeemer -> V2.TxInfo -> Bool | ||
| --withdrawalsAreEquivalent (PV2CustomRedeemer _ _ _ _ _ _ wdrwls _ _ _ _) tInfo = | ||
| -- V2.txInfoWdrl tInfo PlutusPrelude.== wdrwls | ||
| -- TODO: Also need to do separate minting script | ||
|
|
||
| validator :: V2.Validator | ||
| validator = V2.mkValidatorScript | ||
| $$(PlutusTx.compile [|| wrap ||]) | ||
| where | ||
| wrap = V2.mkUntypedValidator mkValidator | ||
|
|
||
| v2ScriptContextEquivalencePlutusScript :: V2.Script | ||
| v2ScriptContextEquivalencePlutusScript = V2.unValidatorScript validator | ||
|
|
||
| v2ScriptContextEquivalenceSbs :: SBS.ShortByteString | ||
| v2ScriptContextEquivalenceSbs = | ||
| SBS.toShort . LBS.toStrict $ serialise v2ScriptContextEquivalencePlutusScript | ||
|
|
||
| v2ScriptContextEquivalenceScript :: PlutusScript PlutusScriptV2 | ||
| v2ScriptContextEquivalenceScript = PlutusScriptSerialised v2ScriptContextEquivalenceSbs | ||
|
|
Oops, something went wrong.