├── .gitignore ├── cabal.project ├── plutus-scripts.cabal └── src ├── CheckDatumMapPolicy.hs ├── CheckDatumPolicy.hs ├── CheckRedeemersPolicy.hs ├── CheckReferenceInputs.hs ├── CheckReferenceScriptPolicy.hs ├── CheckSameInlineDatumAtAllInputs.hs ├── CheckSameInlineDatumAtMultipleInputs.hs ├── CheckTxInDatumPolicyV1.hs ├── CheckWitnessPolicy.hs ├── CountDatumMapPolicy.hs ├── CountRedeemersPolicy.hs ├── CountReferenceInputsPolicy.hs ├── Deadline.hs ├── DeadlinePolicy.hs ├── DeadlineRedeemerPolicy.hs ├── EcdsaSecp256k1LoopValidator.hs ├── EcdsaSecp256k1Validator.hs ├── NFTMint.hs ├── ParamPolicy.hs ├── SchnorrSecp256k1LoopValidator.hs ├── SchnorrSecp256k1Validator.hs ├── TokenNamePolicy.hs ├── TxInfoDataEquivalence.hs ├── TypedDatumRedeemer42.hs ├── UntypedHelloWorld.hs └── ValidRangeEquivilance.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle 2 | *.plutus 3 | *.swp 4 | .vscode* 5 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | -- Custom repository for cardano haskell packages 2 | -- See https://github.com/input-output-hk/cardano-haskell-packages on how to use CHaP in a Haskell project. 3 | repository cardano-haskell-packages 4 | url: https://input-output-hk.github.io/cardano-haskell-packages 5 | secure: True 6 | root-keys: 7 | 3e0cce471cf09815f930210f7827266fd09045445d65923e6d0238a6cd15126f 8 | 443abb7fb497a134c343faf52f0b659bd7999bc06b7f63fa76dc99d631f9bea1 9 | a86a1f6ce86c449c46666bda44268677abf29b5b2d2eb5ec7af903ec2f117a82 10 | bcec67e8e99cabfa7764d75ad9b158d72bfacf70ca1d0ec8bc6b4406d1bf8413 11 | c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56 12 | d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee 13 | 14 | packages: plutus-scripts.cabal 15 | 16 | index-state: 2022-11-14T00:20:02Z 17 | 18 | index-state: 19 | , hackage.haskell.org 2022-11-14T00:20:02Z 20 | , cardano-haskell-packages 2022-11-17T04:56:26Z 21 | 22 | -- We never, ever, want this. 23 | write-ghc-environment-files: never 24 | 25 | allow-newer: 26 | -- cardano-ledger packages need aeson >2, the following packages have a 27 | -- too restictive upper bounds on aeson, so we relax them here. The hackage 28 | -- trustees can make a revision to these packages cabal file to solve the 29 | -- issue permanently. 30 | , ekg:aeson 31 | , ekg-json:aeson 32 | , openapi3:aeson 33 | , servant:aeson 34 | , servant-client-core:aeson 35 | , servant-server:aeson 36 | 37 | constraints: 38 | -- cardano-prelude-0.1.0.0 needs 39 | , protolude <0.3.1 40 | 41 | -- cardano-ledger-byron-0.1.0.0 needs 42 | , cardano-binary <1.5.0.1 43 | 44 | -- plutus-core-1.0.0.1 needs 45 | , cardano-crypto-class >2.0.0.0 46 | , algebraic-graphs <0.7 47 | 48 | -- cardano-ledger-core-0.1.0.0 needs 49 | , cardano-crypto-class <2.0.0.1 50 | 51 | -- cardano-crypto-class-2.0.0.0.1 needs 52 | , cardano-prelude <0.1.0.1 53 | 54 | -- dbvar from cardano-wallet needs 55 | , io-classes <0.3.0.0 56 | 57 | -- newer typed-protocols need io-classes>=0.3.0.0 which is incompatible with dbvar's constraint above 58 | , typed-protocols==0.1.0.0 59 | 60 | -- DELETE 61 | -- The plugin will typically fail when producing Haddock documentation. However, 62 | -- in this instance you can simply tell it to defer any errors to runtime (which 63 | -- will never happen since you're building documentation). 64 | -- 65 | -- So, any package using 'PlutusTx.compile' in the code for which you need to 66 | -- generate haddock documentation should use the following 'haddock-options'. 67 | --package plutus-ledger 68 | -- haddock-options: "--optghc=-fplugin-opt PlutusTx.Plugin:defer-errors" 69 | --package plutus-script-utils 70 | -- haddock-options: "--optghc=-fplugin-opt PlutusTx.Plugin:defer-errors" 71 | --package plutus-contract 72 | -- haddock-options: "--optghc=-fplugin-opt PlutusTx.Plugin:defer-errors" 73 | 74 | -- These packages appear in our dependency tree and are very slow to build. 75 | -- Empirically, turning off optimization shaves off ~50% build time. 76 | -- It also mildly improves recompilation avoidance. 77 | -- For dev work we don't care about performance so much, so this is okay. 78 | -- package cardano-ledger-alonzo 79 | -- optimization: False 80 | -- package ouroboros-consensus-shelley 81 | -- optimization: False 82 | -- package ouroboros-consensus-cardano 83 | -- optimization: False 84 | -- package cardano-api 85 | -- optimization: False 86 | -- package cardano-wallet 87 | -- optimization: False 88 | -- package cardano-wallet-core 89 | -- optimization: False 90 | -- package cardano-wallet-cli 91 | -- optimization: False 92 | -- package cardano-wallet-launcher 93 | -- optimization: False 94 | -- package cardano-wallet-core-integration 95 | -- optimization: False 96 | 97 | -- Waiting for plutus-apps CHaP to be published 98 | source-repository-package 99 | type: git 100 | location: https://github.com/input-output-hk/plutus-apps.git 101 | tag: 65ddfa5d467ed64f8709d7db9faf96151942da82 102 | subdir: 103 | cardano-streaming 104 | doc 105 | freer-extras 106 | marconi 107 | marconi-mamba 108 | playground-common 109 | pab-blockfrost 110 | plutus-chain-index 111 | plutus-chain-index-core 112 | plutus-contract 113 | plutus-contract-certification 114 | plutus-example 115 | plutus-ledger 116 | plutus-ledger-constraints 117 | plutus-pab 118 | plutus-pab-executables 119 | plutus-script-utils 120 | plutus-tx-constraints 121 | plutus-use-cases 122 | rewindable-index 123 | 124 | -- Direct dependency. 125 | source-repository-package 126 | type: git 127 | location: https://github.com/input-output-hk/quickcheck-dynamic 128 | tag: c272906361471d684440f76c297e29ab760f6a1e 129 | 130 | -- Should follow cardano-wallet. 131 | source-repository-package 132 | type: git 133 | location: https://github.com/input-output-hk/cardano-addresses 134 | tag: b7273a5d3c21f1a003595ebf1e1f79c28cd72513 135 | subdir: 136 | -- cardano-addresses-cli 137 | command-line 138 | -- cardano-addresses 139 | core 140 | 141 | -- Direct dependency. 142 | -- Compared to others, cardano-wallet doesn't bump dependencies very often. 143 | -- Making it a good place to start when bumping dependencies. 144 | -- As, for example, bumping the node first highly risks breaking API with the wallet. 145 | -- Unless early bug fixes are required, this is fine as the wallet tracks stable releases of the node. 146 | -- And it is indeed nice for plutus-apps to track stable releases of the node too. 147 | -- 148 | -- The current version is dated 2022/08/10 149 | source-repository-package 150 | type: git 151 | location: https://github.com/input-output-hk/cardano-wallet 152 | tag: 18a931648550246695c790578d4a55ee2f10463e 153 | subdir: 154 | lib/cli 155 | lib/core 156 | lib/core-integration 157 | lib/dbvar 158 | lib/launcher 159 | lib/numeric 160 | lib/shelley 161 | lib/strict-non-empty-containers 162 | lib/test-utils 163 | lib/text-class 164 | 165 | -- This is needed because we rely on an unreleased feature 166 | -- https://github.com/input-output-hk/cardano-ledger/pull/3111 167 | source-repository-package 168 | type: git 169 | location: https://github.com/input-output-hk/cardano-ledger 170 | tag: da3e9ae10cf9ef0b805a046c84745f06643583c2 171 | subdir: 172 | eras/alonzo/impl 173 | eras/alonzo/test-suite 174 | eras/babbage/impl 175 | eras/babbage/test-suite 176 | eras/byron/chain/executable-spec 177 | eras/byron/crypto 178 | eras/byron/crypto/test 179 | eras/byron/ledger/executable-spec 180 | eras/byron/ledger/impl 181 | eras/byron/ledger/impl/test 182 | eras/shelley/impl 183 | eras/shelley/test-suite 184 | eras/shelley-ma/impl 185 | eras/shelley-ma/test-suite 186 | libs/cardano-ledger-core 187 | libs/cardano-ledger-pretty 188 | libs/cardano-protocol-tpraos 189 | libs/cardano-data 190 | libs/vector-map 191 | libs/set-algebra 192 | libs/small-steps 193 | libs/small-steps-test 194 | libs/non-integral 195 | -------------------------------------------------------------------------------- /plutus-scripts.cabal: -------------------------------------------------------------------------------- 1 | Cabal-Version: 2.4 2 | Name: plutus-script 3 | Version: 0.1.0.0 4 | Author: James Browning 5 | Maintainer: james.browning@iohk.io 6 | Build-Type: Simple 7 | Copyright: © 2022 James Browning 8 | License: Apache-2.0 9 | License-files: LICENSE 10 | 11 | library 12 | hs-source-dirs: src 13 | exposed-modules: UntypedHelloWorld 14 | , TypedDatumRedeemer42 15 | , Deadline 16 | , DeadlinePolicy 17 | , DeadlineRedeemerPolicy 18 | , TokenNamePolicy 19 | , CheckDatumPolicy 20 | , CheckSameInlineDatumAtMultipleInputs 21 | , CheckSameInlineDatumAtAllInputs 22 | , CheckReferenceInputs 23 | , CheckReferenceScriptPolicy 24 | , CheckRedeemersPolicy 25 | , CheckWitnessPolicy 26 | , CountRedeemersPolicy 27 | , CountDatumMapPolicy 28 | , CheckDatumMapPolicy 29 | , CountReferenceInputsPolicy 30 | , CheckTxInDatumPolicyV1 31 | , NFTMint 32 | , ValidRangeEquivilance 33 | , TxInfoDataEquivalence 34 | , EcdsaSecp256k1Validator 35 | , SchnorrSecp256k1Validator 36 | , EcdsaSecp256k1LoopValidator 37 | , SchnorrSecp256k1LoopValidator 38 | build-depends: aeson 39 | , base ^>=4.14.1.0 40 | , bytestring 41 | , containers 42 | , cardano-api 43 | , data-default 44 | , freer-extras 45 | , plutus-contract 46 | , plutus-ledger 47 | , plutus-ledger-api 48 | , plutus-ledger-constraints 49 | , plutus-script-utils 50 | , plutus-tx-plugin 51 | , plutus-tx 52 | , text 53 | , serialise 54 | default-language: Haskell2010 55 | ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise -------------------------------------------------------------------------------- /src/CheckDatumMapPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module CheckDatumMapPolicy 17 | ( printRedeemer, 18 | serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript, 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScript, 26 | PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (..), 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 39 | import qualified Plutus.V2.Ledger.Api as PlutusV2 40 | import qualified PlutusTx 41 | import qualified PlutusTx.Builtins as BI 42 | import PlutusTx.Prelude as P hiding 43 | (Semigroup (..), 44 | unless, (.)) 45 | import Prelude (IO, Semigroup (..), 46 | print, (.)) 47 | 48 | {- 49 | Redeemers 50 | -} 51 | 52 | --data ExpRedeemers = ExpRedeemers {redeemers :: [Plutus.Redeemer]} 53 | 54 | --PlutusTx.unstableMakeIsData ''ExpRedeemers 55 | 56 | asDatum :: PlutusTx.ToData a => a -> PlutusV2.Datum 57 | asDatum a = PlutusV2.Datum $ PlutusTx.dataToBuiltinData $ PlutusTx.toData a 58 | 59 | intAsDatum :: Integer -> PlutusV2.Datum 60 | intAsDatum = asDatum @Integer 61 | 62 | redeemer :: [PlutusV2.Datum] 63 | redeemer = [intAsDatum 42, intAsDatum 43, asDatum @BI.BuiltinByteString "d"] 64 | 65 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 66 | 67 | {- 68 | The validator script 69 | -} 70 | 71 | {-# INLINEABLE checkDatumsPolicy #-} 72 | checkDatumsPolicy :: [PlutusV2.Datum] -> PlutusV2.ScriptContext -> Bool 73 | checkDatumsPolicy expRedeemers ctx = traceIfFalse "Datums in txInfoData do not match expected" $ P.all ((P.== True) . findD) expRedeemers 74 | where 75 | info :: PlutusV2.TxInfo 76 | info = PlutusV2.scriptContextTxInfo ctx 77 | 78 | findD :: PlutusV2.Datum -> Bool 79 | findD r = P.isJust $ P.find (P.== r) (PlutusV2.txInfoData info) 80 | {- 81 | As a Minting Policy 82 | -} 83 | 84 | policy :: Scripts.MintingPolicy 85 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||]) 86 | where 87 | wrap = Scripts.mkUntypedMintingPolicy checkDatumsPolicy 88 | 89 | {- 90 | As a Script 91 | -} 92 | 93 | script :: PlutusV2.Script 94 | script = PlutusV2.unMintingPolicyScript policy 95 | 96 | {- 97 | As a Short Byte String 98 | -} 99 | 100 | scriptSBS :: SBS.ShortByteString 101 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 102 | 103 | {- 104 | As a Serialised Script 105 | -} 106 | 107 | serialisedScript :: PlutusScript PlutusScriptV2 108 | serialisedScript = PlutusScriptSerialised scriptSBS 109 | 110 | writeSerialisedScript :: IO () 111 | writeSerialisedScript = void $ writeFileTextEnvelope "check-datum-map-policy.plutus" Nothing serialisedScript 112 | 113 | -------------------------------------------------------------------------------- /src/CheckDatumPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckDatumPolicy 18 | ( printScriptHash, 19 | printScriptData, 20 | myDatum, 21 | redeemerDatum, 22 | redeemerDatumHash, 23 | redeemerNoOutputDatum, 24 | serialisedScript, 25 | scriptSBS, 26 | script, 27 | writeSerialisedScript, 28 | ) 29 | where 30 | 31 | import Cardano.Api (writeFileTextEnvelope) 32 | import Cardano.Api.Shelley (PlutusScript (..), 33 | PlutusScriptV2, 34 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 35 | fromPlutusData, 36 | scriptDataToJson) 37 | import Codec.Serialise 38 | import Data.Aeson as A 39 | import qualified Data.ByteString.Lazy as LBS 40 | import qualified Data.ByteString.Short as SBS 41 | import Data.Functor (void) 42 | import qualified Ledger.Typed.Scripts as Scripts 43 | import qualified Plutus.Script.Utils.V2.Scripts as PSU.V2 44 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 45 | import qualified Plutus.V2.Ledger.Api as PlutusV2 46 | import qualified Plutus.V2.Ledger.Contexts as PlutusV2 47 | import Plutus.V2.Ledger.Tx 48 | import qualified PlutusTx 49 | import PlutusTx.Prelude as P hiding 50 | (Semigroup (..), 51 | unless, (.)) 52 | import Prelude (IO, Semigroup (..), 53 | Show (..), print, (.)) 54 | 55 | {- 56 | Define redeemer type to handle expected inline datum or datum hash at a txo 57 | -} 58 | 59 | data InputType = RegularInput | ReferenceInput | BothInputTypes 60 | deriving (Show) 61 | 62 | PlutusTx.unstableMakeIsData ''InputType 63 | 64 | data ExpInputDatum = ExpInputDatum 65 | { txOutRef :: PlutusV2.TxOutRef, 66 | expDatum :: PlutusV2.OutputDatum, 67 | inputType :: InputType 68 | } 69 | deriving (Show) 70 | 71 | PlutusTx.unstableMakeIsData ''ExpInputDatum 72 | 73 | {- 74 | Expected inline datum to use in redeemer 75 | -} 76 | 77 | data SomeData = SomeData {name :: BuiltinByteString, age :: Integer, shopping :: [BuiltinByteString]} 78 | 79 | PlutusTx.unstableMakeIsData ''SomeData 80 | 81 | someData = SomeData {name = "cats", age = 42, shopping = ["apple", "tomato", "cheese"]} 82 | 83 | fortyTwo = 42 :: Integer 84 | 85 | devil = 666 :: Integer 86 | 87 | text :: BuiltinByteString 88 | text = "check_ref_inputs" 89 | 90 | myDatum = PlutusV2.Datum $ PlutusTx.dataToBuiltinData $ PlutusTx.toData text 91 | 92 | myDatumHash = PSU.V2.datumHash myDatum 93 | 94 | {- 95 | Redeemers 96 | -} 97 | 98 | redeemerDatum = ExpInputDatum { txOutRef = PlutusV2.TxOutRef {txOutRefId = "2b1a7a149c1a3574f5d0c5afda47a4fef7c03df69a41551465503ffb6eddc996", txOutRefIdx = 2} 99 | , expDatum = PlutusV2.OutputDatum myDatum 100 | , inputType = BothInputTypes 101 | } 102 | 103 | redeemerDatumHash = ExpInputDatum { txOutRef = PlutusV2.TxOutRef {txOutRefId = "b204b4554a827178b48275629e5eac9bde4f5350badecfcd108d87446f00bf26", txOutRefIdx = 0} 104 | , expDatum = PlutusV2.OutputDatumHash myDatumHash 105 | , inputType = RegularInput 106 | } 107 | 108 | redeemerNoOutputDatum = ExpInputDatum { txOutRef = PlutusV2.TxOutRef {txOutRefId = "b204b4554a827178b48275629e5eac9bde4f5350badecfcd108d87446f00bf26", txOutRefIdx = 0} 109 | , expDatum = PlutusV2.NoOutputDatum 110 | , inputType = BothInputTypes 111 | } 112 | 113 | printScriptData d = print $ "Script Data: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData d) 114 | 115 | {- 116 | The validator script 117 | -} 118 | 119 | {-# INLINEABLE expectedInlinePolicy #-} 120 | expectedInlinePolicy :: ExpInputDatum -> PlutusV2.ScriptContext -> Bool 121 | expectedInlinePolicy expInline ctx = 122 | case expInline of 123 | ExpInputDatum _ PlutusV2.NoOutputDatum RegularInput -> noOutputDatumInInput 124 | ExpInputDatum _ PlutusV2.NoOutputDatum ReferenceInput -> noOutputDatumInRefInput 125 | ExpInputDatum _ PlutusV2.NoOutputDatum BothInputTypes -> noOutputDatumInInput && noOutputDatumInRefInput 126 | 127 | ExpInputDatum _ (PlutusV2.OutputDatum d) RegularInput -> datumInInput d 128 | ExpInputDatum _ (PlutusV2.OutputDatum d) ReferenceInput -> datumInRefInput d 129 | ExpInputDatum _ (PlutusV2.OutputDatum d) BothInputTypes -> datumInInput d && datumInRefInput d 130 | 131 | ExpInputDatum _ (PlutusV2.OutputDatumHash dh) RegularInput -> datumHashInInput dh 132 | ExpInputDatum _ (PlutusV2.OutputDatumHash dh) ReferenceInput -> datumHashInRefInput dh 133 | ExpInputDatum _ (PlutusV2.OutputDatumHash dh) BothInputTypes -> datumHashInInput dh && datumHashInRefInput dh 134 | 135 | _ -> traceError "Unexpected case" 136 | where 137 | info :: PlutusV2.TxInfo 138 | info = PlutusV2.scriptContextTxInfo ctx 139 | 140 | fromJust' :: BuiltinString -> Maybe a -> a -- should be built-in 141 | fromJust' err Nothing = traceError err 142 | fromJust' _ (Just x) = x 143 | 144 | findTxIn :: PlutusV2.TxInInfo 145 | findTxIn = fromJust' "txIn doesn't exist" $ PlutusV2.findTxInByTxOutRef (txOutRef expInline) info 146 | 147 | findRefTxInByTxOutRef :: TxOutRef -> PlutusV2.TxInfo -> Maybe PlutusV2.TxInInfo -- similar to findTxInByTxOutRef, should be a built-in context 148 | findRefTxInByTxOutRef outRef PlutusV2.TxInfo{txInfoReferenceInputs} = 149 | find (\PlutusV2.TxInInfo{txInInfoOutRef} -> txInInfoOutRef == outRef) txInfoReferenceInputs 150 | 151 | findRefTxIn :: PlutusV2.TxInInfo 152 | findRefTxIn = fromJust' "txRefIn doesn't exist" $ findRefTxInByTxOutRef (txOutRef expInline) info 153 | 154 | noOutputDatumInInput = traceIfFalse "Expected regular input to have no output datum" $ PlutusV2.NoOutputDatum == PlutusV2.txOutDatum (PlutusV2.txInInfoResolved findTxIn) 155 | datumInInput d = traceIfFalse "Expected regular input to have datum" $ PlutusV2.OutputDatum d == PlutusV2.txOutDatum (PlutusV2.txInInfoResolved findTxIn) 156 | datumHashInInput dh = traceIfFalse "Expected regular input to have datum hash" $ PlutusV2.OutputDatumHash dh == PlutusV2.txOutDatum (PlutusV2.txInInfoResolved findTxIn) 157 | 158 | noOutputDatumInRefInput = traceIfFalse "Expected reference input to have no output datum" $ PlutusV2.NoOutputDatum == PlutusV2.txOutDatum (PlutusV2.txInInfoResolved findRefTxIn) 159 | datumInRefInput d = traceIfFalse "Expected reference input to have datum" $ PlutusV2.OutputDatum d == PlutusV2.txOutDatum (PlutusV2.txInInfoResolved findRefTxIn) 160 | datumHashInRefInput dh = traceIfFalse "Expected reference input to have datum hash" $ PlutusV2.OutputDatumHash dh == PlutusV2.txOutDatum (PlutusV2.txInInfoResolved findRefTxIn) 161 | 162 | {- 163 | As a Minting Policy 164 | -} 165 | 166 | compiledCode :: PlutusTx.CompiledCode (BuiltinData -> BuiltinData -> ()) 167 | compiledCode = $$(PlutusTx.compile [|| wrap ||]) 168 | where 169 | wrap = Scripts.mkUntypedMintingPolicy expectedInlinePolicy 170 | 171 | policy :: Scripts.MintingPolicy 172 | policy = PlutusV2.mkMintingPolicyScript compiledCode 173 | 174 | thisScriptHash :: PlutusV2.ScriptHash 175 | thisScriptHash = PSU.V2.scriptHash $ PlutusV2.fromCompiledCode compiledCode 176 | 177 | printScriptHash = print $ "Script Hash: " ++ show thisScriptHash 178 | 179 | {- 180 | As a Script 181 | -} 182 | 183 | script :: PlutusV2.Script 184 | script = PlutusV2.unMintingPolicyScript policy 185 | 186 | {- 187 | As a Short Byte String 188 | -} 189 | 190 | scriptSBS :: SBS.ShortByteString 191 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 192 | 193 | {- 194 | As a Serialised Script 195 | -} 196 | 197 | serialisedScript :: PlutusScript PlutusScriptV2 198 | serialisedScript = PlutusScriptSerialised scriptSBS 199 | 200 | writeSerialisedScript :: IO () 201 | writeSerialisedScript = void $ writeFileTextEnvelope "check-datum.plutus" Nothing serialisedScript 202 | -------------------------------------------------------------------------------- /src/CheckRedeemersPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module CheckRedeemersPolicy 17 | ( printRedeemer, 18 | serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScript, 26 | PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (..), 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 39 | import qualified Plutus.V2.Ledger.Api as PlutusV2 40 | import Plutus.V2.Ledger.Contexts (ownCurrencySymbol) 41 | import qualified PlutusTx 42 | import qualified PlutusTx.AssocMap as AMap 43 | import qualified PlutusTx.Builtins as BI 44 | import PlutusTx.Prelude as P hiding 45 | (Semigroup (..), 46 | unless, (.)) 47 | import Prelude (IO, Semigroup (..), 48 | print, (.)) 49 | 50 | {- 51 | Redeemers 52 | -} 53 | 54 | --data ExpRedeemers = ExpRedeemers {redeemers :: [Plutus.Redeemer]} 55 | 56 | --PlutusTx.unstableMakeIsData ''ExpRedeemers 57 | 58 | asRedeemer :: PlutusTx.ToData a => a -> PlutusV2.Redeemer 59 | asRedeemer a = PlutusV2.Redeemer $ PlutusTx.dataToBuiltinData $ PlutusTx.toData a 60 | 61 | intAsRedeemer :: Integer -> PlutusV2.Redeemer 62 | intAsRedeemer = asRedeemer @Integer 63 | 64 | redeemer :: [PlutusV2.Redeemer] 65 | redeemer = [intAsRedeemer 42, intAsRedeemer 43, asRedeemer @BI.BuiltinByteString "d"] 66 | 67 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 68 | 69 | {- 70 | The validator script 71 | -} 72 | 73 | {-# INLINEABLE checkRedeemersPolicy #-} 74 | checkRedeemersPolicy :: [PlutusV2.Redeemer] -> PlutusV2.ScriptContext -> Bool 75 | checkRedeemersPolicy expRedeemers ctx = traceIfFalse "Redeemers do not match expected" $ P.all ((P.== True) . findR) expRedeemers && 76 | traceIfFalse "Number of redeemers (without own) does not match expected" (P.length expRedeemers P.== P.length withoutOwnRedeemer) 77 | where 78 | info :: PlutusV2.TxInfo 79 | info = PlutusV2.scriptContextTxInfo ctx 80 | 81 | thisScriptPurpose :: PlutusV2.ScriptPurpose 82 | thisScriptPurpose = PlutusV2.Minting $ ownCurrencySymbol ctx 83 | 84 | withoutOwnRedeemer :: [PlutusV2.Redeemer] 85 | withoutOwnRedeemer = AMap.elems $ AMap.delete thisScriptPurpose (PlutusV2.txInfoRedeemers info) 86 | 87 | findR :: PlutusV2.Redeemer -> Bool 88 | findR r = P.isJust $ P.find (P.== r) withoutOwnRedeemer 89 | {- 90 | As a Minting Policy 91 | -} 92 | 93 | policy :: Scripts.MintingPolicy 94 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||]) 95 | where 96 | wrap = Scripts.mkUntypedMintingPolicy checkRedeemersPolicy 97 | 98 | {- 99 | As a Script 100 | -} 101 | 102 | script :: PlutusV2.Script 103 | script = PlutusV2.unMintingPolicyScript policy 104 | 105 | {- 106 | As a Short Byte String 107 | -} 108 | 109 | scriptSBS :: SBS.ShortByteString 110 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 111 | 112 | {- 113 | As a Serialised Script 114 | -} 115 | 116 | serialisedScript :: PlutusScript PlutusScriptV2 117 | serialisedScript = PlutusScriptSerialised scriptSBS 118 | 119 | writeSerialisedScript :: IO () 120 | writeSerialisedScript = void $ writeFileTextEnvelope "check-redeemers-policy.plutus" Nothing serialisedScript 121 | -------------------------------------------------------------------------------- /src/CheckReferenceInputs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckReferenceInputs 18 | ( printRedeemer, 19 | printRedeemer2, 20 | serialisedScript, 21 | scriptSBS, 22 | writeSerialisedScript, 23 | ) 24 | where 25 | 26 | import Cardano.Api (PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (..), 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import Data.String 38 | import qualified Ledger.Typed.Scripts as Scripts 39 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 40 | import Plutus.V1.Ledger.Tx (TxId (getTxId)) 41 | import qualified Plutus.V2.Ledger.Api as PlutusV2 42 | import qualified PlutusTx 43 | import PlutusTx.Prelude as P hiding 44 | (Semigroup (..), 45 | unless, (.)) 46 | import Prelude (IO, Semigroup (..), 47 | print, (.)) 48 | 49 | {- 50 | Redeemers 51 | -} 52 | 53 | redeemer :: [(PlutusV2.TxId, Integer)] 54 | redeemer = [("b204b4554a827178b48275629e5eac9bde4f5350badecfcd108d87446f00bf26", 0), 55 | ("b204b4554a827178b48275629e5eac9bde4f5350badecfcd108d87446f00bf26", 1)] 56 | 57 | r2 :: [PlutusV2.TxOutRef] 58 | r2 = expRefTxos' redeemer 59 | 60 | expRefTxos' :: [(PlutusV2.TxId, Integer)] -> [PlutusV2.TxOutRef] 61 | expRefTxos' = map (\(txid,idx)-> PlutusV2.TxOutRef{txOutRefId=txid, txOutRefIdx=idx}) 62 | 63 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 64 | printRedeemer2 = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData r2) 65 | 66 | {- 67 | The validator script 68 | -} 69 | 70 | {-# INLINEABLE expectedInlinePolicy #-} 71 | expectedInlinePolicy :: [PlutusV2.TxOutRef] -> PlutusV2.ScriptContext -> Bool 72 | expectedInlinePolicy expRefTxos ctx = traceIfFalse "Reference inputs do not match redeemer" $ expRefTxos == refInputs 73 | where 74 | info = PlutusV2.scriptContextTxInfo ctx 75 | refInputs = map PlutusV2.txInInfoOutRef $ PlutusV2.txInfoReferenceInputs info 76 | 77 | {- 78 | As a validator 79 | -} 80 | 81 | policy :: Scripts.MintingPolicy 82 | policy = PlutusV2.mkMintingPolicyScript 83 | $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy expectedInlinePolicy||]) 84 | 85 | {- 86 | As a Short Byte String 87 | -} 88 | 89 | scriptSBS :: SBS.ShortByteString 90 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise policy 91 | 92 | {- 93 | As a Serialised Script 94 | -} 95 | 96 | serialisedScript :: PlutusScript PlutusScriptV2 97 | serialisedScript = PlutusScriptSerialised scriptSBS 98 | 99 | writeSerialisedScript :: IO () 100 | writeSerialisedScript = void $ writeFileTextEnvelope "check-reference-inputs.plutus" Nothing serialisedScript 101 | 102 | -------------------------------------------------------------------------------- /src/CheckReferenceScriptPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckReferenceScriptPolicy 18 | ( policyHash, 19 | printRedeemer, 20 | serialisedScript, 21 | scriptSBS, 22 | script, 23 | writeSerialisedScript, 24 | ) 25 | where 26 | 27 | import Cardano.Api (PlutusScript (..), 28 | PlutusScriptV2, 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | scriptDataToJson, 31 | writeFileTextEnvelope) 32 | import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised), 33 | fromPlutusData) 34 | import Codec.Serialise 35 | import Data.Aeson as A 36 | import qualified Data.ByteString.Lazy as LBS 37 | import qualified Data.ByteString.Short as SBS 38 | import Data.Functor (void) 39 | import Ledger 40 | import qualified Ledger.Typed.Scripts as Scripts 41 | import qualified Plutus.Script.Utils.V2.Scripts as PSU.V2 42 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 43 | import Plutus.V2.Ledger.Api (toData) 44 | import qualified Plutus.V2.Ledger.Api as PlutusV2 45 | import qualified Plutus.V2.Ledger.Contexts as PlutusV2 46 | import PlutusTx (CompiledCode) 47 | import qualified PlutusTx 48 | import PlutusTx.Prelude as P hiding 49 | (Semigroup (..), 50 | unless, (.)) 51 | import Prelude (IO, Semigroup (..), 52 | Show (..), print, (.)) 53 | 54 | {- 55 | Define redeemer type to handle expected inline datum or datum hash at a txo 56 | -} 57 | 58 | data InputType = RegularInput | ReferenceInput | BothInputTypes 59 | deriving (Show) 60 | 61 | PlutusTx.unstableMakeIsData ''InputType 62 | 63 | data ExpRefScript = ExpRefScript 64 | { txOutRef :: TxOutRef, 65 | expRefScript :: Maybe ScriptHash, 66 | inputType :: InputType 67 | } 68 | deriving (Show) 69 | 70 | PlutusTx.unstableMakeIsData ''ExpRefScript 71 | 72 | {- 73 | Redeemers 74 | -} 75 | 76 | redeemer = ExpRefScript { txOutRef = TxOutRef {txOutRefId = "b204b4554a827178b48275629e5eac9bde4f5350badecfcd108d87446f00bf26", txOutRefIdx = 0} 77 | , expRefScript = Just policyScriptHash -- "c4a19ee0baedc17a949f902688a6f6752673862ad921d23fb8233e23" <- this policy's script hash 78 | , inputType = RegularInput 79 | } 80 | 81 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ toData policyScriptHash) 82 | 83 | {- 84 | The validator script 85 | -} 86 | 87 | {-# INLINEABLE expectedRefScriptPolicy #-} 88 | expectedRefScriptPolicy :: ExpRefScript -> PlutusV2.ScriptContext -> Bool 89 | expectedRefScriptPolicy expRefScript ctx = 90 | case expRefScript of 91 | ExpRefScript _ Nothing RegularInput -> noReferenceScriptInInput 92 | ExpRefScript _ Nothing ReferenceInput -> noReferenceScriptInRefInput 93 | ExpRefScript _ Nothing BothInputTypes -> noReferenceScriptInInput && noReferenceScriptInRefInput 94 | 95 | ExpRefScript _ sh@(Just _) RegularInput -> referenceScriptInInput sh 96 | ExpRefScript _ sh@(Just _) ReferenceInput -> referenceScriptInRefInput sh 97 | ExpRefScript _ sh@(Just _) BothInputTypes -> referenceScriptInInput sh && referenceScriptInRefInput sh 98 | 99 | _ -> traceError "Unexpected case" 100 | where 101 | info :: PlutusV2.TxInfo 102 | info = PlutusV2.scriptContextTxInfo ctx 103 | 104 | fromJust' :: BuiltinString -> Maybe a -> a 105 | fromJust' err Nothing = traceError err 106 | fromJust' _ (Just x) = x 107 | 108 | findTxIn :: PlutusV2.TxInInfo 109 | findTxIn = fromJust' "txIn doesn't exist" $ PlutusV2.findTxInByTxOutRef (txOutRef expRefScript) info 110 | 111 | findRefTxInByTxOutRef :: TxOutRef -> PlutusV2.TxInfo -> Maybe PlutusV2.TxInInfo -- similar to findTxInByTxOutRef, should be a built-in context 112 | findRefTxInByTxOutRef outRef PlutusV2.TxInfo{txInfoReferenceInputs} = 113 | find (\PlutusV2.TxInInfo{txInInfoOutRef} -> txInInfoOutRef == outRef) txInfoReferenceInputs 114 | 115 | findRefTxIn :: PlutusV2.TxInInfo 116 | findRefTxIn = fromJust' "txRefIn doesn't exist" $ findRefTxInByTxOutRef (txOutRef expRefScript) info 117 | 118 | noReferenceScriptInInput = traceIfFalse "Expected regular input to have no reference script" $ P.isNothing $ PlutusV2.txOutReferenceScript $ PlutusV2.txInInfoResolved findTxIn 119 | referenceScriptInInput sh = traceIfFalse "Expected regular input to have reference script" $ sh == PlutusV2.txOutReferenceScript (PlutusV2.txInInfoResolved findTxIn) 120 | 121 | noReferenceScriptInRefInput = traceIfFalse "Expected reference input to have no reference script" $ P.isNothing $ PlutusV2.txOutReferenceScript $ PlutusV2.txInInfoResolved findRefTxIn 122 | referenceScriptInRefInput sh = traceIfFalse "Expected reference input to have reference script" $ sh == PlutusV2.txOutReferenceScript (PlutusV2.txInInfoResolved findRefTxIn) 123 | 124 | {- 125 | As a Minting Policy 126 | -} 127 | 128 | compiledCode :: CompiledCode (BuiltinData -> BuiltinData -> ()) 129 | compiledCode = $$(PlutusTx.compile [|| wrap ||]) 130 | where 131 | wrap = Scripts.mkUntypedMintingPolicy expectedRefScriptPolicy 132 | 133 | policyScriptHash :: ScriptHash 134 | policyScriptHash = PSU.V2.scriptHash $ fromCompiledCode compiledCode 135 | 136 | policy :: Scripts.MintingPolicy 137 | policy = PlutusV2.mkMintingPolicyScript compiledCode 138 | 139 | policyHash :: MintingPolicyHash 140 | policyHash = PSU.V2.mintingPolicyHash policy -- different way to produce the same hash as policyScriptHash 141 | 142 | {- 143 | As a Script 144 | -} 145 | 146 | script :: PlutusV2.Script 147 | script = PlutusV2.unMintingPolicyScript policy 148 | 149 | {- 150 | As a Short Byte String 151 | -} 152 | 153 | scriptSBS :: SBS.ShortByteString 154 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 155 | 156 | {- 157 | As a Serialised Script 158 | -} 159 | 160 | serialisedScript :: PlutusScript PlutusScriptV2 161 | serialisedScript = PlutusScriptSerialised scriptSBS 162 | 163 | writeSerialisedScript :: IO () 164 | writeSerialisedScript = void $ writeFileTextEnvelope "check-reference-script.plutus" Nothing serialisedScript 165 | -------------------------------------------------------------------------------- /src/CheckSameInlineDatumAtAllInputs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckSameInlineDatumAtAllInputs 18 | ( serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript, printRedeemer 22 | ) 23 | where 24 | 25 | import Data.Aeson as A 26 | 27 | import Cardano.Api (PlutusScriptV2, 28 | writeFileTextEnvelope) 29 | import Cardano.Api.Shelley (PlutusScript (..), 30 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 31 | fromPlutusData, 32 | scriptDataToJson) 33 | import Codec.Serialise 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import qualified Plutus.Script.Utils.V2.Scripts as PSU.V2 39 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 40 | import qualified Plutus.V2.Ledger.Api as PlutusV2 41 | import qualified PlutusTx 42 | import PlutusTx.Prelude as P hiding 43 | (Semigroup (..), 44 | unless, (.)) 45 | import Prelude (IO, Semigroup (..), 46 | print, (.)) 47 | 48 | {- 49 | Expected inline datum to use in redeemer 50 | -} 51 | 52 | {-# INLINEABLE myDatum #-} 53 | myDatum = PlutusV2.Datum $ PlutusTx.dataToBuiltinData $ PlutusTx.toData (42 :: Integer) 54 | 55 | datumHash :: PlutusV2.DatumHash 56 | datumHash = PSU.V2.datumHash myDatum 57 | 58 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData datumHash) 59 | 60 | {- 61 | The validator script 62 | -} 63 | 64 | {-# INLINEABLE expectedDatumHashPolicy #-} 65 | expectedDatumHashPolicy :: PlutusV2.DatumHash -> PlutusV2.ScriptContext -> P.Bool 66 | expectedDatumHashPolicy dh ctx = traceIfFalse "Unexpected datum hash at each reference input" (P.all (P.== True) $ P.map checkDatumHash allRefTxIn) 67 | where 68 | info :: PlutusV2.TxInfo 69 | info = PlutusV2.scriptContextTxInfo ctx 70 | 71 | allRefTxIn :: [PlutusV2.TxInInfo] 72 | allRefTxIn = PlutusV2.txInfoReferenceInputs info 73 | 74 | checkDatumHash :: PlutusV2.TxInInfo -> P.Bool 75 | checkDatumHash txin = PlutusV2.OutputDatumHash dh P.== PlutusV2.txOutDatum (PlutusV2.txInInfoResolved txin) 76 | 77 | {- 78 | As a Minting Policy 79 | -} 80 | 81 | policy :: Scripts.MintingPolicy 82 | policy = PlutusV2.mkMintingPolicyScript 83 | $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy expectedDatumHashPolicy||]) 84 | {- 85 | As a Script 86 | -} 87 | 88 | script :: PlutusV2.Script 89 | script = PlutusV2.unMintingPolicyScript policy 90 | 91 | {- 92 | As a Short Byte String 93 | -} 94 | 95 | scriptSBS :: SBS.ShortByteString 96 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 97 | {- 98 | As a Serialised Script 99 | -} 100 | 101 | serialisedScript :: PlutusScript PlutusScriptV2 102 | serialisedScript = PlutusScriptSerialised scriptSBS 103 | 104 | writeSerialisedScript :: IO () 105 | writeSerialisedScript = void $ writeFileTextEnvelope "check-same-datum-hash-at-all-reference-inputs.plutus" Nothing serialisedScript 106 | -------------------------------------------------------------------------------- /src/CheckSameInlineDatumAtMultipleInputs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckSameInlineDatumAtMultipleInputs 18 | ( printRedeemer, 19 | serialisedScript, 20 | scriptSBS, 21 | script, 22 | writeSerialisedScript, 23 | ) 24 | where 25 | 26 | import Cardano.Api (writeFileTextEnvelope) 27 | import Cardano.Api.Shelley (PlutusScript (..), 28 | PlutusScriptV2, 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 39 | import qualified Plutus.V2.Ledger.Api as PlutusV2 40 | import qualified Plutus.V2.Ledger.Contexts as PlutusV2 41 | import Plutus.V2.Ledger.Tx 42 | import qualified PlutusTx 43 | import PlutusTx.Prelude as P hiding 44 | (Semigroup (..), 45 | unless, (.)) 46 | import Prelude (IO, Semigroup (..), 47 | print, (.)) 48 | 49 | {- 50 | Expected inline datum to use in redeemer 51 | -} 52 | 53 | myDatum = PlutusV2.Datum $ PlutusTx.dataToBuiltinData $ PlutusTx.toData (42 :: Integer) 54 | 55 | {- 56 | Redeemer 57 | -} 58 | 59 | redeemer = [ 60 | PlutusV2.TxOutRef {txOutRefId = "2b1a7a149c1a3574f5d0c5afda47a4fef7c03df69a41551465503ffb6eddc996", txOutRefIdx = 1} , 61 | PlutusV2.TxOutRef {txOutRefId = "2b1a7a149c1a3574f5d0c5afda47a4fef7c03df69a41551465503ffb6eddc996", txOutRefIdx = 2} 62 | ] 63 | 64 | printRedeemer = print $ "Script Data: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 65 | 66 | {- 67 | The validator script 68 | -} 69 | 70 | {-# INLINEABLE expectedInlinePolicy #-} 71 | expectedInlinePolicy :: PlutusV2.Datum -> [PlutusV2.TxOutRef] -> PlutusV2.ScriptContext -> Bool 72 | expectedInlinePolicy d refs ctx = traceIfFalse "Unexpected inline datum at each regular input" (P.all (P.== True) (map (txoDatumIs42 . findTxIn) refs)) && 73 | traceIfFalse "Unexpected inline datum at each reference input" (P.all (P.== True) (map (txoDatumIs42 . findRefTxIn) refs)) 74 | where 75 | info :: PlutusV2.TxInfo 76 | info = PlutusV2.scriptContextTxInfo ctx 77 | 78 | fromJust' :: BuiltinString -> Maybe a -> a -- should be built-in 79 | fromJust' err Nothing = traceError err 80 | fromJust' _ (Just x) = x 81 | 82 | findTxIn :: PlutusV2.TxOutRef -> PlutusV2.TxInInfo 83 | findTxIn r = fromJust' "txIn doesn't exist" $ PlutusV2.findTxInByTxOutRef r info 84 | 85 | findRefTxInByTxOutRef :: TxOutRef -> PlutusV2.TxInfo -> Maybe PlutusV2.TxInInfo -- similar to findTxInByTxOutRef, should be a built-in context 86 | findRefTxInByTxOutRef outRef PlutusV2.TxInfo{txInfoReferenceInputs} = find (\PlutusV2.TxInInfo{txInInfoOutRef} -> txInInfoOutRef == outRef) txInfoReferenceInputs 87 | 88 | findRefTxIn :: PlutusV2.TxOutRef -> PlutusV2.TxInInfo 89 | findRefTxIn r = fromJust' "txRefIn doesn't exist" $ findRefTxInByTxOutRef r info 90 | 91 | txoDatumIs42 :: PlutusV2.TxInInfo -> Bool 92 | txoDatumIs42 txin = PlutusV2.OutputDatum d P.== PlutusV2.txOutDatum (PlutusV2.txInInfoResolved txin) 93 | 94 | {- 95 | As a Minting Policy 96 | -} 97 | 98 | policy :: PlutusV2.Datum -> Scripts.MintingPolicy 99 | policy d = PlutusV2.mkMintingPolicyScript $ 100 | $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy . expectedInlinePolicy||]) 101 | `PlutusTx.applyCode` 102 | PlutusTx.liftCode d 103 | {- 104 | As a Script 105 | -} 106 | 107 | script :: PlutusV2.Script 108 | script = PlutusV2.unMintingPolicyScript $ policy myDatum 109 | {- 110 | As a Short Byte String 111 | -} 112 | 113 | scriptSBS :: SBS.ShortByteString 114 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 115 | 116 | {- 117 | As a Serialised Script 118 | -} 119 | 120 | serialisedScript :: PlutusScript PlutusScriptV2 121 | serialisedScript = PlutusScriptSerialised scriptSBS 122 | 123 | writeSerialisedScript :: IO () 124 | writeSerialisedScript = void $ writeFileTextEnvelope "check-same-inline-datum-at-multiple-inputs.plutus" Nothing serialisedScript 125 | -------------------------------------------------------------------------------- /src/CheckTxInDatumPolicyV1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckTxInDatumPolicyV1 18 | ( printScriptHash, 19 | printScriptData, 20 | myDatum, 21 | redeemerDatumHash, 22 | redeemerNothing, 23 | serialisedScript, 24 | scriptSBS, 25 | script, 26 | writeSerialisedScript, 27 | ) 28 | where 29 | 30 | import Cardano.Api (writeFileTextEnvelope) 31 | import Cardano.Api.Shelley (PlutusScript (..), 32 | PlutusScriptV2, 33 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 34 | fromPlutusData, 35 | scriptDataToJson) 36 | import Codec.Serialise 37 | import Data.Aeson as A 38 | import qualified Data.ByteString.Lazy as LBS 39 | import qualified Data.ByteString.Short as SBS 40 | import Data.Functor (void) 41 | import qualified Ledger.Typed.Scripts as Scripts 42 | import qualified Plutus.Script.Utils.Scripts as PSU 43 | import qualified Plutus.Script.Utils.V1.Scripts as PSU.V1 44 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 45 | import qualified Plutus.V1.Ledger.Api as PlutusV1 46 | import qualified Plutus.V1.Ledger.Contexts as PlutusV1 47 | import qualified Plutus.V1.Ledger.Scripts as PlutusV1 48 | import Plutus.V1.Ledger.Tx 49 | import qualified PlutusTx 50 | import PlutusTx.Prelude as P hiding 51 | (Semigroup (..), 52 | unless, (.)) 53 | import Prelude (IO, Semigroup (..), 54 | Show (..), print, (.)) 55 | 56 | {- 57 | Define redeemer type to handle expected inline datum or datum hash at a txo 58 | -} 59 | 60 | data ExpTxInDatumHash = ExpTxInDatumHash 61 | { txOutRef :: PlutusV1.TxOutRef, 62 | expDatumHash :: Maybe PlutusV1.DatumHash 63 | } 64 | deriving (Show) 65 | 66 | PlutusTx.unstableMakeIsData ''ExpTxInDatumHash 67 | 68 | {- 69 | Expected inline datum to use in redeemer 70 | -} 71 | 72 | data SomeData = SomeData {name :: BuiltinByteString, age :: Integer, shopping :: [BuiltinByteString]} 73 | 74 | PlutusTx.unstableMakeIsData ''SomeData 75 | 76 | someData = SomeData {name = "cats", age = 42, shopping = ["apple", "tomato", "cheese"]} 77 | 78 | fortyTwo = 42 :: Integer 79 | 80 | devil = 666 :: Integer 81 | 82 | text :: BuiltinByteString 83 | text = "check_ref_inputs" 84 | 85 | myDatum = PlutusV1.Datum $ PlutusTx.dataToBuiltinData $ PlutusTx.toData fortyTwo 86 | 87 | myDatumHash = PSU.datumHash myDatum 88 | 89 | {- 90 | Redeemers 91 | -} 92 | 93 | redeemerDatumHash = ExpTxInDatumHash { txOutRef = PlutusV1.TxOutRef {txOutRefId = "2b1a7a149c1a3574f5d0c5afda47a4fef7c03df69a41551465503ffb6eddc996", txOutRefIdx = 2} 94 | , expDatumHash = Just myDatumHash 95 | } 96 | 97 | redeemerNothing = ExpTxInDatumHash { txOutRef = PlutusV1.TxOutRef {txOutRefId = "2b1a7a149c1a3574f5d0c5afda47a4fef7c03df69a41551465503ffb6eddc996", txOutRefIdx = 2} 98 | , expDatumHash = Nothing 99 | } 100 | 101 | 102 | printScriptData d = print $ "Script Data: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV1.toData d) 103 | 104 | {- 105 | The validator script 106 | -} 107 | 108 | {-# INLINEABLE expectedInlinePolicy #-} 109 | expectedInlinePolicy :: ExpTxInDatumHash -> PlutusV1.ScriptContext -> Bool 110 | expectedInlinePolicy expInline ctx = traceIfFalse "Expected datumhash is not in txin" $ expDatumHash expInline == PlutusV1.txOutDatumHash (PlutusV1.txInInfoResolved findTxIn) 111 | where 112 | info :: PlutusV1.TxInfo 113 | info = PlutusV1.scriptContextTxInfo ctx 114 | 115 | fromJust' :: BuiltinString -> Maybe a -> a -- should be built-in 116 | fromJust' err Nothing = traceError err 117 | fromJust' _ (Just x) = x 118 | 119 | findTxIn :: PlutusV1.TxInInfo 120 | findTxIn = fromJust' "txIn doesn't exist" $ PlutusV1.findTxInByTxOutRef (txOutRef expInline) info 121 | 122 | {- 123 | As a Minting Policy 124 | -} 125 | 126 | compiledCode :: PlutusTx.CompiledCode (BuiltinData -> BuiltinData -> ()) 127 | compiledCode = $$(PlutusTx.compile [|| wrap ||]) 128 | where 129 | wrap = Scripts.mkUntypedMintingPolicy expectedInlinePolicy 130 | 131 | policy :: Scripts.MintingPolicy 132 | policy = PlutusV1.mkMintingPolicyScript compiledCode 133 | 134 | thisScriptHash :: PlutusV1.ScriptHash 135 | thisScriptHash = PSU.V1.scriptHash $ PlutusV1.fromCompiledCode compiledCode 136 | 137 | printScriptHash = print $ "Script Hash: " ++ show thisScriptHash 138 | 139 | {- 140 | As a Script 141 | -} 142 | 143 | script :: PlutusV1.Script 144 | script = PlutusV1.unMintingPolicyScript policy 145 | 146 | {- 147 | As a Short Byte String 148 | -} 149 | 150 | scriptSBS :: SBS.ShortByteString 151 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 152 | 153 | {- 154 | As a Serialised Script 155 | -} 156 | 157 | serialisedScript :: PlutusScript PlutusScriptV2 158 | serialisedScript = PlutusScriptSerialised scriptSBS 159 | 160 | writeSerialisedScript :: IO () 161 | writeSerialisedScript = void $ writeFileTextEnvelope "check-tx-in-datum-hash-V1.plutus" Nothing serialisedScript 162 | -------------------------------------------------------------------------------- /src/CheckWitnessPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE NoImplicitPrelude #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TemplateHaskell #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | 17 | module CheckWitnessPolicy 18 | ( serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript, 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScript (..), 26 | PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised)) 29 | import Codec.Serialise 30 | import qualified Data.ByteString.Lazy as LBS 31 | import qualified Data.ByteString.Short as SBS 32 | import Data.Functor (void) 33 | import Ledger 34 | import qualified Ledger.Typed.Scripts as Scripts 35 | import qualified Plutus.Script.Utils.V2.Scripts as PSU.V2 36 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 37 | import qualified Plutus.V2.Ledger.Api as PlutusV2 38 | import qualified Plutus.V2.Ledger.Contexts as PlutusV2 39 | import PlutusTx (CompiledCode) 40 | import qualified PlutusTx 41 | import PlutusTx.Prelude as P hiding 42 | (Semigroup (..), 43 | unless, (.)) 44 | import Prelude (IO, (.)) 45 | 46 | {- 47 | The policy 48 | -} 49 | 50 | {-# INLINEABLE expectedWitnessPolicy #-} 51 | expectedWitnessPolicy :: PlutusV2.PubKeyHash -> PlutusV2.ScriptContext -> Bool 52 | expectedWitnessPolicy pkh ctx = PlutusV2.txSignedBy info pkh 53 | where 54 | info :: PlutusV2.TxInfo 55 | info = PlutusV2.scriptContextTxInfo ctx 56 | 57 | {- 58 | As a Minting Policy 59 | -} 60 | 61 | compiledCode :: CompiledCode (BuiltinData -> BuiltinData -> ()) 62 | compiledCode = $$(PlutusTx.compile [|| wrap ||]) 63 | where 64 | wrap = Scripts.mkUntypedMintingPolicy expectedWitnessPolicy 65 | 66 | policyScriptHash :: ScriptHash 67 | policyScriptHash = PSU.V2.scriptHash $ fromCompiledCode compiledCode 68 | 69 | policy :: Scripts.MintingPolicy 70 | policy = PlutusV2.mkMintingPolicyScript compiledCode 71 | 72 | policyHash :: MintingPolicyHash 73 | policyHash = PSU.V2.mintingPolicyHash policy 74 | 75 | {- 76 | As a Script 77 | -} 78 | 79 | script :: PlutusV2.Script 80 | script = PlutusV2.unMintingPolicyScript policy 81 | 82 | {- 83 | As a Short Byte String 84 | -} 85 | 86 | scriptSBS :: SBS.ShortByteString 87 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 88 | 89 | {- 90 | As a Serialised Script 91 | -} 92 | 93 | serialisedScript :: PlutusScript PlutusScriptV2 94 | serialisedScript = PlutusScriptSerialised scriptSBS 95 | 96 | writeSerialisedScript :: IO () 97 | writeSerialisedScript = void $ writeFileTextEnvelope "check-witness-policy.plutus" Nothing serialisedScript 98 | 99 | -------------------------------------------------------------------------------- /src/CountDatumMapPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module CountDatumMapPolicy 17 | ( serialisedScript, 18 | scriptSBS, 19 | script, 20 | writeSerialisedScript, 21 | ) 22 | where 23 | 24 | import Cardano.Api (PlutusScript, 25 | PlutusScriptV2, 26 | writeFileTextEnvelope) 27 | import Cardano.Api.Shelley (PlutusScript (..)) 28 | import Codec.Serialise 29 | import qualified Data.ByteString.Lazy as LBS 30 | import qualified Data.ByteString.Short as SBS 31 | import Data.Functor (void) 32 | import qualified Ledger.Typed.Scripts as Scripts 33 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 34 | import qualified Plutus.V2.Ledger.Api as PlutusV2 35 | import qualified PlutusTx 36 | import PlutusTx.Prelude as P (Bool, Eq ((==)), 37 | Integer, 38 | Maybe (Nothing), 39 | length, 40 | traceIfFalse, ($)) 41 | import Prelude (IO, (.)) 42 | 43 | {- 44 | The validator script 45 | -} 46 | 47 | {-# INLINEABLE countDatumsPolicy #-} 48 | countDatumsPolicy :: Integer -> PlutusV2.ScriptContext -> Bool 49 | countDatumsPolicy n ctx = traceIfFalse "Number of datums in txInfoData map does not match expected" $ n P.== P.length (PlutusV2.txInfoData info) 50 | where 51 | info :: PlutusV2.TxInfo 52 | info = PlutusV2.scriptContextTxInfo ctx 53 | 54 | {- 55 | As a Minting Policy 56 | -} 57 | 58 | policy :: Scripts.MintingPolicy 59 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||]) 60 | where 61 | wrap = Scripts.mkUntypedMintingPolicy countDatumsPolicy 62 | 63 | {- 64 | As a Script 65 | -} 66 | 67 | script :: PlutusV2.Script 68 | script = PlutusV2.unMintingPolicyScript policy 69 | 70 | {- 71 | As a Short Byte String 72 | -} 73 | 74 | scriptSBS :: SBS.ShortByteString 75 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 76 | 77 | {- 78 | As a Serialised Script 79 | -} 80 | 81 | serialisedScript :: PlutusScript PlutusScriptV2 82 | serialisedScript = PlutusScriptSerialised scriptSBS 83 | 84 | writeSerialisedScript :: IO () 85 | writeSerialisedScript = void $ writeFileTextEnvelope "count-datum-map-policy.plutus" Nothing serialisedScript 86 | 87 | -------------------------------------------------------------------------------- /src/CountRedeemersPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module CountRedeemersPolicy 17 | ( serialisedScript, 18 | scriptSBS, 19 | script, 20 | writeSerialisedScript, 21 | ) 22 | where 23 | 24 | import Cardano.Api (PlutusScript, 25 | PlutusScriptV2, 26 | writeFileTextEnvelope) 27 | import Cardano.Api.Shelley (PlutusScript (..)) 28 | import Codec.Serialise 29 | import qualified Data.ByteString.Lazy as LBS 30 | import qualified Data.ByteString.Short as SBS 31 | import Data.Functor (void) 32 | import qualified Ledger.Typed.Scripts as Scripts 33 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 34 | import qualified Plutus.V2.Ledger.Api as PlutusV2 35 | import qualified PlutusTx 36 | import PlutusTx.Prelude as P hiding 37 | (Semigroup (..), 38 | unless, (.)) 39 | import Prelude (IO, (.)) 40 | 41 | {- 42 | The validator script 43 | -} 44 | 45 | {-# INLINEABLE countRedeemersPolicy #-} 46 | countRedeemersPolicy :: Integer -> PlutusV2.ScriptContext -> Bool 47 | countRedeemersPolicy n ctx = traceIfFalse "Number of redeemers does not match expected" $ n P.== P.length (PlutusV2.txInfoRedeemers info) 48 | where 49 | info :: PlutusV2.TxInfo 50 | info = PlutusV2.scriptContextTxInfo ctx 51 | 52 | {- 53 | As a Minting Policy 54 | -} 55 | 56 | policy :: Scripts.MintingPolicy 57 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||]) 58 | where 59 | wrap = Scripts.mkUntypedMintingPolicy countRedeemersPolicy 60 | 61 | {- 62 | As a Script 63 | -} 64 | 65 | script :: PlutusV2.Script 66 | script = PlutusV2.unMintingPolicyScript policy 67 | 68 | {- 69 | As a Short Byte String 70 | -} 71 | 72 | scriptSBS :: SBS.ShortByteString 73 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 74 | 75 | {- 76 | As a Serialised Script 77 | -} 78 | 79 | serialisedScript :: PlutusScript PlutusScriptV2 80 | serialisedScript = PlutusScriptSerialised scriptSBS 81 | 82 | writeSerialisedScript :: IO () 83 | writeSerialisedScript = void $ writeFileTextEnvelope "count-redeemers-policy.plutus" Nothing serialisedScript 84 | 85 | -------------------------------------------------------------------------------- /src/CountReferenceInputsPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module CountReferenceInputsPolicy 17 | ( serialisedScript, 18 | scriptSBS, 19 | script, 20 | writeSerialisedScript, 21 | ) 22 | where 23 | 24 | import Cardano.Api (PlutusScript, 25 | PlutusScriptV2, 26 | writeFileTextEnvelope) 27 | import Cardano.Api.Shelley (PlutusScript (..)) 28 | import Codec.Serialise 29 | import qualified Data.ByteString.Lazy as LBS 30 | import qualified Data.ByteString.Short as SBS 31 | import Data.Functor (void) 32 | import qualified Ledger.Typed.Scripts as Scripts 33 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 34 | import qualified Plutus.V2.Ledger.Api as PlutusV2 35 | import qualified PlutusTx 36 | import PlutusTx.Prelude as P hiding 37 | (Semigroup (..), 38 | unless, (.)) 39 | import Prelude (IO, (.)) 40 | 41 | {- 42 | The validator script 43 | -} 44 | 45 | {-# INLINEABLE countReferenceInputssPolicy #-} 46 | countReferenceInputssPolicy :: Integer -> PlutusV2.ScriptContext -> Bool 47 | countReferenceInputssPolicy n ctx = traceIfFalse "Number of reference inputs does not match expected" $ n P.== P.length (PlutusV2.txInfoReferenceInputs info) 48 | where 49 | info :: PlutusV2.TxInfo 50 | info = PlutusV2.scriptContextTxInfo ctx 51 | 52 | {- 53 | As a Minting Policy 54 | -} 55 | 56 | policy :: Scripts.MintingPolicy 57 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||]) 58 | where 59 | wrap = Scripts.mkUntypedMintingPolicy countReferenceInputssPolicy 60 | 61 | {- 62 | As a Script 63 | -} 64 | 65 | script :: PlutusV2.Script 66 | script = PlutusV2.unMintingPolicyScript policy 67 | 68 | {- 69 | As a Short Byte String 70 | -} 71 | 72 | scriptSBS :: SBS.ShortByteString 73 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 74 | 75 | {- 76 | As a Serialised Script 77 | -} 78 | 79 | serialisedScript :: PlutusScript PlutusScriptV2 80 | serialisedScript = PlutusScriptSerialised scriptSBS 81 | 82 | writeSerialisedScript :: IO () 83 | writeSerialisedScript = void $ writeFileTextEnvelope "count-reference-inputs-policy.plutus" Nothing serialisedScript 84 | 85 | -------------------------------------------------------------------------------- /src/Deadline.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | {-# OPTIONS_GHC -Wall #-} 11 | 12 | module Deadline 13 | ( serialisedScriptV1, 14 | scriptSBSV1, 15 | scriptV1, 16 | writeSerialisedScriptV1, 17 | serialisedScriptV2, 18 | scriptSBSV2, 19 | scriptV2, 20 | writeSerialisedScriptV2, 21 | runTrace, 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScriptV2, 26 | writeFileTextEnvelope) 27 | import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised), 28 | PlutusScriptV1) 29 | import Codec.Serialise 30 | import qualified Data.ByteString.Lazy as LBS 31 | import qualified Data.ByteString.Short as SBS 32 | import Data.Functor (void) 33 | import Data.Map as Map 34 | import Data.Text (Text) 35 | import Data.Void (Void) 36 | import Ledger 37 | import Ledger.Ada as Ada 38 | import Ledger.Constraints as Constraints 39 | import qualified Ledger.Typed.Scripts as Scripts 40 | import Plutus.Contract as Contract 41 | import qualified Plutus.Script.Utils.V1.Scripts as PSU.V1 42 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 43 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 44 | import Plutus.Trace.Emulator as Emulator (EmulatorTrace, 45 | activateContractWallet, 46 | runEmulatorTraceIO, 47 | waitNSlots) 48 | import qualified Plutus.V1.Ledger.Api as PlutusV1 49 | import qualified Plutus.V2.Ledger.Api as PlutusV2 50 | import qualified PlutusTx 51 | import PlutusTx.Prelude as P hiding 52 | (Semigroup (..), 53 | unless, (.)) 54 | import Prelude (IO, Semigroup (..), 55 | Show (..), String, (.)) 56 | import Wallet.Emulator.Wallet 57 | 58 | 59 | 60 | ------------------------------------------------------------------------------- 61 | -- Disp like Show (Good for debuging time interval emulator issue, can remove once resolved) 62 | ------------------------------------------------------------------------------- 63 | 64 | class Disp a where 65 | disp :: a -> BuiltinByteString -> BuiltinByteString 66 | 67 | instance Disp a => Disp (Interval a) where 68 | disp (Interval lb ub) end = 69 | "Interval(" `appendByteString` disp lb (44 `consByteString` disp ub (41 `consByteString` end)) 70 | 71 | -- not showing the [ ( difference 72 | instance Disp a => Disp (LowerBound a) where 73 | disp (LowerBound x _) end = disp x end 74 | 75 | instance Disp a => Disp (UpperBound a) where 76 | disp (UpperBound x _) end = disp x end 77 | 78 | instance Disp a => Disp (Extended a) where 79 | disp (Finite x) end = disp x end 80 | disp NegInf end = "NegInf" `appendByteString` end 81 | disp PosInf end = "PosInf" `appendByteString` end 82 | 83 | instance Disp POSIXTime where 84 | disp (POSIXTime i) = disp i 85 | 86 | instance Disp Integer where 87 | disp n end 88 | | n < 0 = 45 `consByteString` go (negate n) end 89 | | n == 0 = 48 `consByteString` emptyByteString 90 | | otherwise = go n end 91 | where 92 | go :: Integer -> BuiltinByteString -> BuiltinByteString 93 | go m acc 94 | | m == 0 = acc 95 | | otherwise = 96 | let 97 | m' = m `P.divide` 10 98 | r = m `modulo` 10 99 | in 100 | go m' $ consByteString (r + 48) acc 101 | 102 | 103 | 104 | 105 | {- 106 | The timelocked validator script 107 | -} 108 | 109 | deadline :: PlutusV1.POSIXTime 110 | deadline = 1596059095000 -- (milliseconds) transaction's valid range must be before this 111 | 112 | {-# INLINEABLE mkValidatorV1 #-} 113 | mkValidatorV1 :: PlutusV1.POSIXTime -> () -> () -> PlutusV1.ScriptContext -> Bool 114 | mkValidatorV1 dl _ _ ctx = to dl `contains` range -- traceError (decodeUtf8 (disp range "")) 115 | where 116 | info :: PlutusV1.TxInfo 117 | info = scriptContextTxInfo ctx 118 | 119 | range :: PlutusV1.POSIXTimeRange 120 | range = txInfoValidRange info 121 | 122 | {-# INLINEABLE mkValidatorV2 #-} 123 | mkValidatorV2 :: PlutusV2.POSIXTime -> () -> () -> PlutusV2.ScriptContext -> Bool 124 | mkValidatorV2 dl _ _ ctx = to dl `contains` range -- traceError (decodeUtf8 (disp range "")) 125 | where 126 | info :: PlutusV2.TxInfo 127 | info = PlutusV2.scriptContextTxInfo ctx 128 | 129 | range :: PlutusV2.POSIXTimeRange 130 | range = PlutusV2.txInfoValidRange info 131 | 132 | {- 133 | As a validator 134 | -} 135 | 136 | data DeadlineValidator 137 | instance Scripts.ValidatorTypes DeadlineValidator 138 | 139 | typedValidatorV1 :: PlutusV1.POSIXTime -> Scripts.TypedValidator DeadlineValidator 140 | typedValidatorV1 = Scripts.mkTypedValidatorParam @DeadlineValidator 141 | $$(PlutusTx.compile [||mkValidatorV1||]) 142 | $$(PlutusTx.compile [|| wrap ||]) 143 | where 144 | wrap = Scripts.mkUntypedValidator 145 | 146 | untypedValidatorV2 :: PlutusV2.POSIXTime -> PSU.V2.Validator -- There is not yet a way to make a V2 typed validator (PLT-494) 147 | untypedValidatorV2 t = PlutusV2.mkValidatorScript $ 148 | $$(PlutusTx.compile [|| Scripts.mkUntypedValidator . mkValidatorV2 ||]) 149 | `PlutusTx.applyCode` 150 | PlutusTx.liftCode t 151 | 152 | {- 153 | As a Script 154 | -} 155 | 156 | scriptV1 :: POSIXTime -> Validator 157 | scriptV1 = Scripts.validatorScript . typedValidatorV1 158 | 159 | scriptV2 :: POSIXTime -> PSU.V2.Validator 160 | scriptV2 = untypedValidatorV2 161 | 162 | {- 163 | As a Short Byte String 164 | -} 165 | 166 | scriptSBSV1 :: SBS.ShortByteString 167 | scriptSBSV1 = SBS.toShort . LBS.toStrict $ serialise $ scriptV1 deadline 168 | 169 | scriptSBSV2 :: SBS.ShortByteString 170 | scriptSBSV2 = SBS.toShort . LBS.toStrict $ serialise $ scriptV2 deadline 171 | 172 | {- 173 | As a Serialised Script 174 | -} 175 | 176 | serialisedScriptV1 :: PlutusScript PlutusScriptV1 177 | serialisedScriptV1 = PlutusScriptSerialised scriptSBSV1 178 | 179 | serialisedScriptV2 :: PlutusScript PlutusScriptV2 180 | serialisedScriptV2 = PlutusScriptSerialised scriptSBSV2 181 | 182 | writeSerialisedScriptV1 :: IO () 183 | writeSerialisedScriptV1 = void $ writeFileTextEnvelope "deadline-V1.plutus" Nothing serialisedScriptV1 184 | 185 | writeSerialisedScriptV2 :: IO () 186 | writeSerialisedScriptV2 = void $ writeFileTextEnvelope "deadline-V2.plutus" Nothing serialisedScriptV2 187 | 188 | {- 189 | Offchain Contract 190 | -} 191 | 192 | scrAddress :: Ledger.Address 193 | scrAddress = Scripts.validatorAddress $ typedValidatorV1 deadline 194 | --scrAddress = Ledger.scriptHashAddress valHash 195 | 196 | valHash :: PSU.V1.ValidatorHash 197 | valHash = Scripts.validatorHash $ typedValidatorV1 deadline 198 | 199 | contract :: Contract () Empty Text () 200 | contract = do 201 | now <- currentTime 202 | Contract.logInfo @String $ "now: " ++ show now 203 | Contract.logInfo @String $ "1: pay the script address" 204 | let tx1 = Constraints.mustPayToOtherScript valHash unitDatum $ Ada.lovelaceValueOf 25000000 205 | ledgerTx1 <- submitTx tx1 206 | awaitTxConfirmed $ getCardanoTxId ledgerTx1 207 | Contract.logInfo @String $ "tx1 successfully submitted" 208 | Contract.logInfo @String $ "2: spend from script address with expected validity interval" 209 | utxos <- utxosAt scrAddress 210 | let orefs = fst <$> Map.toList utxos 211 | lookups = 212 | Constraints.plutusV1OtherScript (scriptV1 deadline) 213 | <> Constraints.unspentOutputs utxos 214 | tx2 = 215 | mconcat [Constraints.mustSpendScriptOutput oref unitRedeemer | oref <- orefs] 216 | <> Constraints.mustIncludeDatumInTx unitDatum 217 | <> Constraints.mustValidateIn (from $ now - 1000) -- FAILS 218 | ledgerTx2 <- submitTxConstraintsWith @Void lookups tx2 219 | Contract.logInfo @String $ "waiting for tx2 confirmed..." 220 | awaitTxConfirmed $ getCardanoTxId ledgerTx2 221 | Contract.logInfo @String $ "tx2 successfully submitted" 222 | 223 | {- 224 | Trace 225 | -} 226 | 227 | runTrace :: IO () 228 | runTrace = runEmulatorTraceIO emulatorTrace 229 | 230 | emulatorTrace :: EmulatorTrace () 231 | emulatorTrace = do 232 | void $ activateContractWallet (knownWallet 1) contract 233 | void $ Emulator.waitNSlots 2 234 | -------------------------------------------------------------------------------- /src/DeadlinePolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE NamedFieldPuns #-} 8 | {-# LANGUAGE NoImplicitPrelude #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module DeadlinePolicy 17 | ( serialisedScriptV1, 18 | scriptSBSV1, 19 | scriptV1, 20 | writeSerialisedScriptV1, 21 | serialisedScriptV2, 22 | scriptSBSV2, 23 | scriptV2, 24 | writeSerialisedScriptV2 25 | ) where 26 | 27 | import Cardano.Api (PlutusScriptV1, 28 | PlutusScriptV2, 29 | writeFileTextEnvelope) 30 | import Cardano.Api.Shelley (PlutusScript (..)) 31 | import Codec.Serialise 32 | import qualified Data.ByteString.Lazy as LBS 33 | import qualified Data.ByteString.Short as SBS 34 | import Data.Functor (void) 35 | import qualified Ledger.Typed.Scripts as Scripts 36 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 37 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 38 | import qualified Plutus.V1.Ledger.Api as PlutusV1 39 | import qualified Plutus.V1.Ledger.Interval as PlutusV1 40 | import qualified Plutus.V2.Ledger.Api as PlutusV2 41 | import qualified PlutusTx 42 | import PlutusTx.Prelude as P hiding 43 | (Semigroup (..), 44 | unless, (.)) 45 | import Prelude (IO, (.)) 46 | 47 | -- V1 48 | 49 | deadlineV1 :: PlutusV1.POSIXTime 50 | deadlineV1 = 1656086034000 -- transaction's valid range must be after this 51 | 52 | {-# INLINABLE mkPolicyV1 #-} 53 | mkPolicyV1 :: PlutusV1.POSIXTime -> BuiltinData -> PlutusV1.ScriptContext -> Bool 54 | mkPolicyV1 dl _ ctx = PlutusV1.from dl `PlutusV1.contains` range 55 | where 56 | info :: PlutusV1.TxInfo 57 | info = PlutusV1.scriptContextTxInfo ctx 58 | 59 | range :: PlutusV1.POSIXTimeRange 60 | range = PlutusV1.txInfoValidRange info 61 | 62 | policyV1 :: PlutusV1.POSIXTime -> Scripts.MintingPolicy 63 | policyV1 s = PlutusV1.mkMintingPolicyScript $ 64 | $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy . mkPolicyV1||]) 65 | `PlutusTx.applyCode` 66 | PlutusTx.liftCode s 67 | 68 | scriptV1 :: PlutusV1.Script 69 | scriptV1 = PlutusV1.unMintingPolicyScript $ policyV1 deadlineV1 70 | 71 | scriptSBSV1 :: SBS.ShortByteString 72 | scriptSBSV1 = SBS.toShort . LBS.toStrict $ serialise scriptV1 73 | 74 | serialisedScriptV1 :: PlutusScript PlutusScriptV1 75 | serialisedScriptV1 = PlutusScriptSerialised scriptSBSV1 76 | 77 | writeSerialisedScriptV1 :: IO () 78 | writeSerialisedScriptV1 = void $ writeFileTextEnvelope "deadline-policy-v1.plutus" Nothing serialisedScriptV1 79 | 80 | -- V2 81 | 82 | deadlineV2 :: PlutusV2.POSIXTime 83 | deadlineV2 = 1656086034 -- transaction's valid range must be after this 84 | 85 | {-# INLINABLE mkPolicyV2 #-} 86 | mkPolicyV2 :: PlutusV2.POSIXTime -> BuiltinData -> PlutusV2.ScriptContext -> Bool 87 | mkPolicyV2 dl _ ctx = PlutusV2.from dl `PlutusV1.contains` range -- there's no Plutus.V2.Ledger.Interval 88 | where 89 | info :: PlutusV2.TxInfo 90 | info = PlutusV2.scriptContextTxInfo ctx 91 | 92 | range :: PlutusV2.POSIXTimeRange 93 | range = PlutusV2.txInfoValidRange info 94 | 95 | policyV2 :: PlutusV2.POSIXTime -> Scripts.MintingPolicy 96 | policyV2 s = PlutusV2.mkMintingPolicyScript $ 97 | $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy . mkPolicyV2||]) 98 | `PlutusTx.applyCode` 99 | PlutusTx.liftCode s 100 | 101 | scriptV2 :: PlutusV1.Script 102 | scriptV2 = PlutusV1.unMintingPolicyScript $ policyV2 deadlineV2 103 | 104 | scriptSBSV2 :: SBS.ShortByteString 105 | scriptSBSV2 = SBS.toShort . LBS.toStrict $ serialise scriptV2 106 | 107 | serialisedScriptV2 :: PlutusScript PlutusScriptV2 108 | serialisedScriptV2 = PlutusScriptSerialised scriptSBSV2 109 | 110 | writeSerialisedScriptV2 :: IO () 111 | writeSerialisedScriptV2 = void $ writeFileTextEnvelope "deadline-policy-v2.plutus" Nothing serialisedScriptV2 112 | -------------------------------------------------------------------------------- /src/DeadlineRedeemerPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE NamedFieldPuns #-} 8 | {-# LANGUAGE NoImplicitPrelude #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module DeadlineRedeemerPolicy 17 | ( serialisedScriptV1, 18 | scriptSBSV1, 19 | scriptV1, 20 | writeSerialisedScriptV1, 21 | serialisedScriptV2, 22 | scriptSBSV2, 23 | scriptV2, 24 | writeSerialisedScriptV2 25 | ) where 26 | 27 | import Cardano.Api (PlutusScriptV1, 28 | PlutusScriptV2, 29 | writeFileTextEnvelope) 30 | import Cardano.Api.Shelley (PlutusScript (..)) 31 | import Codec.Serialise 32 | import qualified Data.ByteString.Lazy as LBS 33 | import qualified Data.ByteString.Short as SBS 34 | import Data.Functor (void) 35 | import qualified Ledger.Typed.Scripts as Scripts 36 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 37 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 38 | import qualified Plutus.V1.Ledger.Api as PlutusV1 39 | import qualified Plutus.V1.Ledger.Interval as PlutusV1 40 | import qualified Plutus.V2.Ledger.Api as PlutusV2 41 | import qualified PlutusTx 42 | import PlutusTx.Prelude as P hiding 43 | (Semigroup (..), 44 | unless, (.)) 45 | import Prelude (IO, (.)) 46 | 47 | -- V1 48 | 49 | {-# INLINABLE mkPolicyV1 #-} 50 | mkPolicyV1 :: PlutusV1.POSIXTime -> PlutusV1.ScriptContext -> Bool 51 | mkPolicyV1 dl ctx = PlutusV1.to dl `PlutusV1.contains` range -- transaction's valid range must be before deadline 52 | where 53 | info :: PlutusV1.TxInfo 54 | info = PlutusV1.scriptContextTxInfo ctx 55 | 56 | range :: PlutusV1.POSIXTimeRange 57 | range = PlutusV1.txInfoValidRange info 58 | 59 | policyV1 :: Scripts.MintingPolicy 60 | policyV1 = PlutusV1.mkMintingPolicyScript $$(PlutusTx.compile [|| Scripts.mkUntypedMintingPolicy mkPolicyV1 ||]) 61 | 62 | scriptV1 :: PlutusV1.Script 63 | scriptV1 = PlutusV1.unMintingPolicyScript policyV1 64 | 65 | scriptSBSV1 :: SBS.ShortByteString 66 | scriptSBSV1 = SBS.toShort . LBS.toStrict $ serialise scriptV1 67 | 68 | serialisedScriptV1 :: PlutusScript PlutusScriptV1 69 | serialisedScriptV1 = PlutusScriptSerialised scriptSBSV1 70 | 71 | writeSerialisedScriptV1 :: IO () 72 | writeSerialisedScriptV1 = void $ writeFileTextEnvelope "deadline-redeemer-policy-v1.plutus" Nothing serialisedScriptV1 73 | 74 | -- V2 75 | 76 | {-# INLINABLE mkPolicyV2 #-} 77 | mkPolicyV2 :: PlutusV2.POSIXTime -> PlutusV2.ScriptContext -> Bool 78 | mkPolicyV2 dl ctx = PlutusV2.to dl `PlutusV1.contains` range -- there's no Plutus.V2.Ledger.Interval 79 | where 80 | info :: PlutusV2.TxInfo 81 | info = PlutusV2.scriptContextTxInfo ctx 82 | 83 | range :: PlutusV2.POSIXTimeRange 84 | range = PlutusV2.txInfoValidRange info 85 | 86 | policyV2 :: Scripts.MintingPolicy 87 | policyV2 = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [|| Scripts.mkUntypedMintingPolicy mkPolicyV2 ||]) 88 | 89 | scriptV2 :: PlutusV1.Script 90 | scriptV2 = PlutusV1.unMintingPolicyScript policyV2 91 | 92 | scriptSBSV2 :: SBS.ShortByteString 93 | scriptSBSV2 = SBS.toShort . LBS.toStrict $ serialise scriptV2 94 | 95 | serialisedScriptV2 :: PlutusScript PlutusScriptV2 96 | serialisedScriptV2 = PlutusScriptSerialised scriptSBSV2 97 | 98 | writeSerialisedScriptV2 :: IO () 99 | writeSerialisedScriptV2 = void $ writeFileTextEnvelope "deadline-redeemer-policy-v2.plutus" Nothing serialisedScriptV2 100 | -------------------------------------------------------------------------------- /src/EcdsaSecp256k1LoopValidator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module EcdsaSecp256k1LoopValidator (writeSerialisedScript) where 12 | 13 | import Cardano.Api (PlutusScript, PlutusScriptV2, 14 | writeFileTextEnvelope) 15 | import Cardano.Api.Shelley (PlutusScript (..)) 16 | import Codec.Serialise (serialise) 17 | import qualified Data.ByteString.Lazy as LBS 18 | import qualified Data.ByteString.Short as SBS 19 | import Data.Functor (void) 20 | import qualified Plutus.V2.Ledger.Api as PlutusV2 21 | import qualified PlutusTx 22 | import qualified PlutusTx.Builtins as BI 23 | import PlutusTx.Prelude as P hiding (Semigroup (..), unless, (.)) 24 | import Prelude (IO, (.)) 25 | 26 | {-# INLINEABLE mkValidator #-} 27 | mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> () 28 | mkValidator _datum red _txContext = 29 | case PlutusV2.fromBuiltinData red of 30 | Nothing -> P.traceError "Trace error: Invalid redeemer" 31 | Just (n, vkey, msg, sig) -> 32 | if n < (1000000 :: Integer) 33 | then traceError "redeemer is < 1000000" 34 | else loop n vkey msg sig 35 | where 36 | loop i v m s 37 | | i == 1000000 = () 38 | | BI.verifyEcdsaSecp256k1Signature v m s = loop (pred i) v m s 39 | | otherwise = P.traceError "Trace error: ECDSA validation failed" 40 | 41 | validator :: PlutusV2.Validator 42 | validator = PlutusV2.mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||]) 43 | 44 | script :: PlutusV2.Script 45 | script = PlutusV2.unValidatorScript validator 46 | 47 | loopScriptShortBs :: SBS.ShortByteString 48 | loopScriptShortBs = SBS.toShort . LBS.toStrict $ serialise script 49 | 50 | loopScript :: PlutusScript PlutusScriptV2 51 | loopScript = PlutusScriptSerialised loopScriptShortBs 52 | 53 | writeSerialisedScript :: IO () 54 | writeSerialisedScript = void $ writeFileTextEnvelope "ecdsa-secp256k-loop.plutus" Nothing loopScript 55 | -------------------------------------------------------------------------------- /src/EcdsaSecp256k1Validator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module EcdsaSecp256k1Validator (writeSerialisedScript) where 12 | 13 | import Cardano.Api (PlutusScript, PlutusScriptV2, 14 | writeFileTextEnvelope) 15 | import Cardano.Api.Shelley (PlutusScript (..)) 16 | import Codec.Serialise (serialise) 17 | import qualified Data.ByteString.Lazy as LBS 18 | import qualified Data.ByteString.Short as SBS 19 | import Data.Functor (void) 20 | import qualified Ledger.Typed.Scripts as Scripts 21 | import qualified Plutus.V2.Ledger.Api as PlutusV2 22 | import qualified PlutusTx 23 | import qualified PlutusTx.Builtins as BI 24 | import PlutusTx.Prelude as P hiding (Semigroup (..), unless, (.)) 25 | import Prelude (IO, (.)) 26 | 27 | {-# INLINEABLE mkPolicy #-} 28 | mkPolicy :: BuiltinData -> BuiltinData -> () 29 | mkPolicy red _ = 30 | case PlutusV2.fromBuiltinData red of 31 | Nothing -> P.traceError "Trace error: Invalid redeemer" 32 | Just (vkey, msg, sig) -> 33 | if BI.verifyEcdsaSecp256k1Signature vkey msg sig 34 | then () 35 | else P.traceError "Trace error: ECDSA validation failed" 36 | 37 | policy :: Scripts.MintingPolicy 38 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [|| mkPolicy ||]) 39 | 40 | script :: PlutusV2.Script 41 | script = PlutusV2.unMintingPolicyScript policy 42 | 43 | scriptShortBs :: SBS.ShortByteString 44 | scriptShortBs = SBS.toShort . LBS.toStrict $ serialise script 45 | 46 | serialisedScript :: PlutusScript PlutusScriptV2 47 | serialisedScript = PlutusScriptSerialised scriptShortBs 48 | 49 | writeSerialisedScript :: IO () 50 | writeSerialisedScript = void $ writeFileTextEnvelope "ecdsa-secp256k-policy.plutus" Nothing serialisedScript 51 | -------------------------------------------------------------------------------- /src/NFTMint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module NFTMint 17 | ( printRedeemer, 18 | serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript, 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScript, 26 | PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (..), 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import Ledger.Value as Value 39 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 40 | import qualified Plutus.V1.Ledger.Api as PlutusV1 41 | import qualified Plutus.V2.Ledger.Api as PlutusV2 42 | import Plutus.V2.Ledger.Contexts (ownCurrencySymbol) 43 | import qualified PlutusTx 44 | import PlutusTx.Prelude as P hiding 45 | (Semigroup (..), 46 | unless, (.)) 47 | import Prelude (IO, Semigroup (..), 48 | Show (..), print, (.)) 49 | 50 | data NFTParams = NFTParams -- doesn't need more than the TxOutRef 51 | { --mpTokenName :: !Plutus.TokenName 52 | mpAmount :: !Integer 53 | , mpTxOutRef :: !PlutusV2.TxOutRef 54 | --, mpPubKeyHs :: !Plutus.PubKeyHash 55 | } deriving Show 56 | 57 | PlutusTx.makeLift ''NFTParams 58 | PlutusTx.unstableMakeIsData ''NFTParams 59 | 60 | redeemer :: NFTParams 61 | redeemer = NFTParams { mpAmount = 1, 62 | mpTxOutRef = PlutusV2.TxOutRef {txOutRefId = "82669eddc629c8ce5cc3cb908cec6de339281bb0a0ec111880ff0936132ac8b0", txOutRefIdx = 0} 63 | } 64 | 65 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 66 | 67 | {-# INLINABLE mkPolicy #-} 68 | mkPolicy :: NFTParams -> BuiltinData -> PlutusV2.ScriptContext -> Bool 69 | mkPolicy p _ ctx = traceIfFalse "UTxO not consumed" hasUTxO && 70 | traceIfFalse "wrong amount minted" checkNFTAmount 71 | 72 | where 73 | info :: PlutusV2.TxInfo 74 | info = PlutusV2.scriptContextTxInfo ctx 75 | 76 | hasUTxO :: Bool 77 | hasUTxO = any (\i -> PlutusV2.txInInfoOutRef i == mpTxOutRef p) $ PlutusV2.txInfoInputs info 78 | 79 | checkNFTAmount :: Bool 80 | checkNFTAmount = case Value.flattenValue (PlutusV2.txInfoMint info) of 81 | [(cs, tn', amt)] -> cs == ownCurrencySymbol ctx && tn' == PlutusV2.TokenName "" && amt == 1 82 | _ -> False 83 | 84 | 85 | {- 86 | As a Minting Policy 87 | -} 88 | 89 | policy :: NFTParams -> Scripts.MintingPolicy 90 | policy mp = PlutusV2.mkMintingPolicyScript $ 91 | $$(PlutusTx.compile [|| wrap ||]) 92 | `PlutusTx.applyCode` 93 | PlutusTx.liftCode mp 94 | where 95 | wrap mp' = Scripts.mkUntypedMintingPolicy $ mkPolicy mp' 96 | 97 | {- 98 | As a Script 99 | -} 100 | 101 | script :: PlutusV2.Script 102 | script = PlutusV2.unMintingPolicyScript $ policy redeemer 103 | 104 | {- 105 | As a Short Byte String 106 | -} 107 | 108 | scriptSBS :: SBS.ShortByteString 109 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 110 | 111 | {- 112 | As a Serialised Script 113 | -} 114 | 115 | serialisedScript :: PlutusScript PlutusScriptV2 116 | serialisedScript = PlutusScriptSerialised scriptSBS 117 | 118 | writeSerialisedScript :: IO () 119 | writeSerialisedScript = void $ writeFileTextEnvelope "nft-mint-V2.plutus" Nothing serialisedScript 120 | -------------------------------------------------------------------------------- /src/ParamPolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module ParamPolicy 17 | ( printRedeemer, 18 | serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScript, 26 | PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (..), 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 39 | import qualified Plutus.V2.Ledger.Api as PlutusV2 40 | import qualified PlutusTx 41 | import qualified PlutusTx.Builtins as BI 42 | import PlutusTx.Prelude as P hiding 43 | (Semigroup (..), 44 | unless, (.)) 45 | import Prelude (IO, Semigroup (..), 46 | print, (.)) 47 | 48 | {- 49 | Redeemers 50 | -} 51 | 52 | --data ExpRedeemers = ExpRedeemers {redeemers :: [Plutus.Redeemer]} 53 | 54 | --PlutusTx.unstableMakeIsData ''ExpRedeemers 55 | 56 | asRedeemer :: PlutusTx.ToData a => a -> PlutusV2.Redeemer 57 | asRedeemer a = PlutusV2.Redeemer $ PlutusTx.dataToBuiltinData $ PlutusTx.toData a 58 | 59 | intAsRedeemer :: Integer -> PlutusV2.Redeemer 60 | intAsRedeemer = asRedeemer @Integer 61 | 62 | redeemer :: [PlutusV2.Redeemer] 63 | redeemer = [intAsRedeemer 42, intAsRedeemer 43, asRedeemer @BI.BuiltinByteString "d"] 64 | 65 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 66 | 67 | {- 68 | The validator script 69 | -} 70 | 71 | 72 | {-# INLINEABLE paramsPolicy #-} 73 | paramsPolicy :: BuiltinByteString -> [PlutusV2.Redeemer] -> PlutusV2.ScriptContext -> Bool 74 | paramsPolicy bs expRedeemers ctx = True 75 | 76 | {- 77 | As a Minting Policy 78 | -} 79 | 80 | -- Example of how to paramaterise minting policy 81 | policy :: BuiltinByteString -> Scripts.MintingPolicy 82 | policy s = PlutusV2.mkMintingPolicyScript $ 83 | $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy . paramsPolicy||]) 84 | `PlutusTx.applyCode` 85 | PlutusTx.liftCode s 86 | 87 | {- 88 | As a Script 89 | -} 90 | 91 | script :: PlutusV2.Script 92 | script = PlutusV2.unMintingPolicyScript $ policy "cats" 93 | 94 | {- 95 | As a Short Byte String 96 | -} 97 | 98 | scriptSBS :: SBS.ShortByteString 99 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 100 | 101 | {- 102 | As a Serialised Script 103 | -} 104 | 105 | serialisedScript :: PlutusScript PlutusScriptV2 106 | serialisedScript = PlutusScriptSerialised scriptSBS 107 | 108 | writeSerialisedScript :: IO () 109 | writeSerialisedScript = void $ writeFileTextEnvelope "params-policy.plutus" Nothing serialisedScript 110 | 111 | -------------------------------------------------------------------------------- /src/SchnorrSecp256k1LoopValidator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module SchnorrSecp256k1LoopValidator (writeSerialisedScript) where 12 | 13 | import Cardano.Api (PlutusScript, PlutusScriptV2, 14 | writeFileTextEnvelope) 15 | import Cardano.Api.Shelley (PlutusScript (..)) 16 | import Codec.Serialise (serialise) 17 | import qualified Data.ByteString.Lazy as LBS 18 | import qualified Data.ByteString.Short as SBS 19 | import Data.Functor (void) 20 | import qualified Plutus.V2.Ledger.Api as PlutusV2 21 | import qualified PlutusTx 22 | import qualified PlutusTx.Builtins as BI 23 | import PlutusTx.Prelude as P hiding (Semigroup (..), unless, (.)) 24 | import Prelude (IO, (.)) 25 | 26 | {-# INLINEABLE mkValidator #-} 27 | mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> () 28 | mkValidator _datum red _txContext = 29 | case PlutusV2.fromBuiltinData red of 30 | Nothing -> P.traceError "Trace error: Invalid redeemer" 31 | Just (n, vkey, msg, sig) -> 32 | if n < (1000000 :: Integer) 33 | then traceError "redeemer is < 1000000" 34 | else loop n vkey msg sig 35 | where 36 | loop i v m s 37 | | i == 1000000 = () 38 | | BI.verifySchnorrSecp256k1Signature v m s = loop (pred i) v m s 39 | | otherwise = P.traceError "Trace error: Schnorr validation failed" 40 | 41 | validator :: PlutusV2.Validator 42 | validator = PlutusV2.mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||]) 43 | 44 | script :: PlutusV2.Script 45 | script = PlutusV2.unValidatorScript validator 46 | 47 | loopScriptShortBs :: SBS.ShortByteString 48 | loopScriptShortBs = SBS.toShort . LBS.toStrict $ serialise script 49 | 50 | loopScript :: PlutusScript PlutusScriptV2 51 | loopScript = PlutusScriptSerialised loopScriptShortBs 52 | 53 | writeSerialisedScript :: IO () 54 | writeSerialisedScript = void $ writeFileTextEnvelope "schnorr-secp256k-loop.plutus" Nothing loopScript 55 | 56 | -------------------------------------------------------------------------------- /src/SchnorrSecp256k1Validator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module SchnorrSecp256k1Validator (writeSerialisedScript) where 12 | 13 | import Cardano.Api (PlutusScript, PlutusScriptV2, 14 | writeFileTextEnvelope) 15 | import Cardano.Api.Shelley (PlutusScript (..)) 16 | import Codec.Serialise (serialise) 17 | import qualified Data.ByteString.Lazy as LBS 18 | import qualified Data.ByteString.Short as SBS 19 | import Data.Functor (void) 20 | import qualified Ledger.Typed.Scripts as Scripts 21 | import qualified Plutus.V2.Ledger.Api as PlutusV2 22 | import qualified PlutusTx 23 | import qualified PlutusTx.Builtins as BI 24 | import PlutusTx.Prelude as P hiding (Semigroup (..), unless, (.)) 25 | import Prelude (IO, (.)) 26 | 27 | {-# INLINEABLE mkPolicy #-} 28 | mkPolicy :: BuiltinData -> BuiltinData -> () 29 | mkPolicy red _ = 30 | case PlutusV2.fromBuiltinData red of 31 | Nothing -> P.traceError "Trace error: Invalid redeemer" 32 | Just (vkey, msg, sig) -> 33 | if BI.verifySchnorrSecp256k1Signature vkey msg sig 34 | then () 35 | else P.traceError "Trace error: Schnorr validation failed" 36 | 37 | policy :: Scripts.MintingPolicy 38 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [|| mkPolicy ||]) 39 | 40 | script :: PlutusV2.Script 41 | script = PlutusV2.unMintingPolicyScript policy 42 | 43 | scriptShortBs :: SBS.ShortByteString 44 | scriptShortBs = SBS.toShort . LBS.toStrict $ serialise script 45 | 46 | 47 | serialisedScript :: PlutusScript PlutusScriptV2 48 | serialisedScript = PlutusScriptSerialised scriptShortBs 49 | 50 | writeSerialisedScript :: IO () 51 | writeSerialisedScript = void $ writeFileTextEnvelope "schnorr-secp256k-policy.plutus" Nothing serialisedScript 52 | 53 | -------------------------------------------------------------------------------- /src/TokenNamePolicy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module TokenNamePolicy 12 | ( serialisedScriptV1, 13 | serialisedScriptV2, 14 | scriptSBSV1, 15 | scriptSBSV2, 16 | scriptV1, 17 | scriptV2, 18 | writeSerialisedScriptV1, 19 | writeSerialisedScriptV2, 20 | printPIRV2 21 | ) 22 | where 23 | 24 | import Cardano.Api (PlutusScriptV1, 25 | PlutusScriptV2, 26 | writeFileTextEnvelope) 27 | import Cardano.Api.Shelley (PlutusScript (..)) 28 | import Codec.Serialise 29 | import qualified Data.ByteString.Lazy as LBS 30 | import qualified Data.ByteString.Short as SBS 31 | import Data.Functor (void) 32 | import Data.Maybe (fromJust) 33 | import qualified Ledger.Typed.Scripts as Scripts 34 | import Ledger.Value as Value 35 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 36 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 37 | import qualified Plutus.V1.Ledger.Api as PlutusV1 38 | import qualified Plutus.V1.Ledger.Contexts as PlutusV1 39 | import qualified Plutus.V2.Ledger.Api as PlutusV2 40 | import qualified Plutus.V2.Ledger.Contexts as PlutusV2 41 | import PlutusTx (getPir) 42 | import qualified PlutusTx 43 | import PlutusTx.Prelude as P hiding 44 | (Semigroup (..), 45 | unless, (.)) 46 | import Prelude (IO, (.)) 47 | import Prettyprinter.Extras (pretty) 48 | 49 | {- 50 | The validator script (checks redeemer token name is used for minting) 51 | -} 52 | 53 | {-# INLINEABLE tokenNamePolicyV1 #-} 54 | tokenNamePolicyV1 :: TokenName -> PlutusV1.ScriptContext -> Bool 55 | tokenNamePolicyV1 tn ctx = traceIfFalse "wrong token name" checkTokenName 56 | where 57 | info :: PlutusV1.TxInfo 58 | info = PlutusV1.scriptContextTxInfo ctx 59 | 60 | checkTokenName :: Bool 61 | checkTokenName = valueOf (PlutusV1.txInfoMint info) (PlutusV1.ownCurrencySymbol ctx) tn > 0 62 | 63 | {-# INLINEABLE tokenNamePolicyV2 #-} 64 | tokenNamePolicyV2 :: TokenName -> PlutusV2.ScriptContext -> Bool 65 | tokenNamePolicyV2 tn ctx = traceIfFalse "wrong token name" checkTokenName 66 | where 67 | info :: PlutusV2.TxInfo 68 | info = PlutusV2.scriptContextTxInfo ctx 69 | 70 | checkTokenName :: Bool 71 | checkTokenName = valueOf (PlutusV2.txInfoMint info) (PlutusV2.ownCurrencySymbol ctx) tn > 0 72 | 73 | {- 74 | As a Minting Policy 75 | -} 76 | 77 | policyV1 :: Scripts.MintingPolicy 78 | policyV1 = PlutusV1.mkMintingPolicyScript $$(PlutusTx.compile [|| Scripts.mkUntypedMintingPolicy tokenNamePolicyV1 ||]) 79 | 80 | policyV2 :: Scripts.MintingPolicy 81 | policyV2 = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [|| Scripts.mkUntypedMintingPolicy tokenNamePolicyV2 ||]) 82 | 83 | printPIRV2 = pretty $ fromJust $ getPir $$(PlutusTx.compile [|| Scripts.mkUntypedMintingPolicy tokenNamePolicyV2 ||]) 84 | 85 | {- 86 | As a Script 87 | -} 88 | 89 | scriptV1 :: PlutusV1.Script 90 | scriptV1 = PlutusV1.unMintingPolicyScript policyV1 91 | 92 | scriptV2 :: PlutusV2.Script 93 | scriptV2 = PlutusV2.unMintingPolicyScript policyV2 94 | 95 | {- 96 | As a Short Byte String 97 | -} 98 | 99 | scriptSBSV1 :: SBS.ShortByteString 100 | scriptSBSV1 = SBS.toShort . LBS.toStrict $ serialise scriptV1 101 | 102 | scriptSBSV2 :: SBS.ShortByteString 103 | scriptSBSV2 = SBS.toShort . LBS.toStrict $ serialise scriptV2 104 | 105 | {- 106 | As a Serialised Script 107 | -} 108 | 109 | serialisedScriptV1 :: PlutusScript PlutusScriptV1 110 | serialisedScriptV1 = PlutusScriptSerialised scriptSBSV1 111 | 112 | writeSerialisedScriptV1 :: IO () 113 | writeSerialisedScriptV1 = void $ writeFileTextEnvelope "token-name-policy-V1.plutus" Nothing serialisedScriptV1 114 | 115 | serialisedScriptV2 :: PlutusScript PlutusScriptV2 116 | serialisedScriptV2 = PlutusScriptSerialised scriptSBSV2 117 | 118 | writeSerialisedScriptV2 :: IO () 119 | writeSerialisedScriptV2 = void $ writeFileTextEnvelope "token-name-policy-V2.plutus" Nothing serialisedScriptV2 120 | -------------------------------------------------------------------------------- /src/TxInfoDataEquivalence.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE NoImplicitPrelude #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module TxInfoDataEquivalence 17 | ( printRedeemer, 18 | serialisedScript, 19 | scriptSBS, 20 | script, 21 | writeSerialisedScript, 22 | ) 23 | where 24 | 25 | import Cardano.Api (PlutusScript, 26 | PlutusScriptV2, 27 | writeFileTextEnvelope) 28 | import Cardano.Api.Shelley (PlutusScript (..), 29 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 30 | fromPlutusData, 31 | scriptDataToJson) 32 | import Codec.Serialise 33 | import Data.Aeson as A 34 | import qualified Data.ByteString.Lazy as LBS 35 | import qualified Data.ByteString.Short as SBS 36 | import Data.Functor (void) 37 | import qualified Ledger.Typed.Scripts as Scripts 38 | import qualified Plutus.Script.Utils.Scripts as PSU 39 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 40 | import qualified Plutus.V2.Ledger.Api as PlutusV2 41 | import qualified PlutusTx 42 | import PlutusTx.Prelude as P hiding 43 | (Semigroup (..), 44 | unless, (.)) 45 | import Prelude (IO, Semigroup (..), 46 | print, (.)) 47 | 48 | {- 49 | Redeemers 50 | -} 51 | 52 | --data ExpRedeemers = ExpRedeemers {redeemers :: [Plutus.Redeemer]} 53 | 54 | --PlutusTx.unstableMakeIsData ''ExpRedeemers 55 | 56 | asDatum :: PlutusTx.ToData a => a -> PlutusV2.Datum 57 | asDatum a = PlutusV2.Datum $ PlutusTx.dataToBuiltinData $ PlutusTx.toData a 58 | 59 | intAsDatum :: Integer -> PlutusV2.Datum 60 | intAsDatum = asDatum @Integer 61 | 62 | datum :: PlutusV2.Datum 63 | datum = intAsDatum 123 64 | 65 | datumHash :: PlutusV2.DatumHash 66 | datumHash = PSU.datumHash datum 67 | 68 | redeemer :: PlutusV2.Map PlutusV2.DatumHash PlutusV2.Datum 69 | redeemer = PlutusV2.fromList [(datumHash, datum)] 70 | 71 | printRedeemer = print $ "Redeemer: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemer) 72 | 73 | {- 74 | The validator script 75 | -} 76 | 77 | {-# INLINEABLE checkDatumsPolicy #-} 78 | checkDatumsPolicy :: PlutusV2.Map PlutusV2.DatumHash PlutusV2.Datum -> PlutusV2.ScriptContext -> Bool 79 | checkDatumsPolicy expDatumMap ctx = traceIfFalse "Datums and hashes in txInfoData do not match expected" (expDatumMap == PlutusV2.txInfoData info) 80 | where 81 | info :: PlutusV2.TxInfo 82 | info = PlutusV2.scriptContextTxInfo ctx 83 | {- 84 | As a Minting Policy 85 | -} 86 | 87 | policy :: Scripts.MintingPolicy 88 | policy = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [||wrap||]) 89 | where 90 | wrap = Scripts.mkUntypedMintingPolicy checkDatumsPolicy 91 | 92 | {- 93 | As a Script 94 | -} 95 | 96 | script :: PlutusV2.Script 97 | script = PlutusV2.unMintingPolicyScript policy 98 | 99 | {- 100 | As a Short Byte String 101 | -} 102 | 103 | scriptSBS :: SBS.ShortByteString 104 | scriptSBS = SBS.toShort . LBS.toStrict $ serialise script 105 | 106 | {- 107 | As a Serialised Script 108 | -} 109 | 110 | serialisedScript :: PlutusScript PlutusScriptV2 111 | serialisedScript = PlutusScriptSerialised scriptSBS 112 | 113 | writeSerialisedScript :: IO () 114 | writeSerialisedScript = void $ writeFileTextEnvelope "check-datum-hash-map-policy.plutus" Nothing serialisedScript 115 | 116 | -------------------------------------------------------------------------------- /src/TypedDatumRedeemer42.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module TypedDatumRedeemer42 12 | ( datumRedeemer42Serialised, 13 | datumRedeemer42SBS, 14 | writeDatumRedeemer42Script, 15 | traceDatumRedeemer42, 16 | ) 17 | where 18 | 19 | import Cardano.Api (writeFileTextEnvelope) 20 | import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised), 21 | PlutusScriptV1) 22 | 23 | import Codec.Serialise 24 | import qualified Data.ByteString.Lazy as LBS 25 | import qualified Data.ByteString.Short as SBS 26 | import Data.Functor (void) 27 | import Data.Map as Map 28 | import Data.Text (Text) 29 | import Data.Void (Void) 30 | import Ledger 31 | import Ledger.Ada as Ada 32 | import Ledger.Constraints as Constraints 33 | import Ledger.Constraints.TxConstraints as TxConstraints 34 | import qualified Ledger.Typed.Scripts as Scripts 35 | import Ledger.Typed.Scripts.Validators 36 | import Plutus.Contract as Contract 37 | import qualified Plutus.Script.Utils.V1.Scripts as PSU.V1 38 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 39 | import Plutus.Trace.Emulator as Emulator 40 | import qualified Plutus.V1.Ledger.Scripts as Plutus 41 | import qualified PlutusTx 42 | import qualified PlutusTx.Builtins as BI 43 | import PlutusTx.Prelude as P hiding 44 | (Semigroup (..), 45 | unless, (.)) 46 | import Prelude (IO, Semigroup (..), 47 | String, (.)) 48 | import Wallet.Emulator.Wallet 49 | 50 | {- 51 | The Typed 42 validator script 52 | -} 53 | 54 | {-# INLINEABLE mkValidator #-} 55 | mkValidator :: Integer -> Integer -> ScriptContext -> Bool 56 | mkValidator d r _ = 57 | traceIfFalse "datum is not 42" (d == 42) && 58 | traceIfFalse "redeemer is not 42" (r == 42) 59 | 60 | {- 61 | As a typed validator 62 | -} 63 | 64 | data Typed 65 | instance Scripts.ValidatorTypes Typed where 66 | type DatumType Typed = Integer 67 | type RedeemerType Typed = Integer 68 | 69 | typedValidator :: Scripts.TypedValidator Typed 70 | typedValidator = 71 | Scripts.mkTypedValidator @Typed 72 | $$(PlutusTx.compile [||mkValidator||]) 73 | $$(PlutusTx.compile [||wrap||]) 74 | where 75 | wrap = Scripts.mkUntypedValidator 76 | 77 | datumRedeemer42Validator :: Plutus.Validator 78 | datumRedeemer42Validator = validatorScript typedValidator 79 | 80 | {- 81 | As a Script 82 | -} 83 | 84 | datumRedeemer42Script :: Plutus.Script 85 | datumRedeemer42Script = Plutus.unValidatorScript datumRedeemer42Validator 86 | 87 | {- 88 | As a Short Byte String 89 | -} 90 | 91 | datumRedeemer42SBS :: SBS.ShortByteString 92 | datumRedeemer42SBS = SBS.toShort . LBS.toStrict $ serialise datumRedeemer42Script 93 | 94 | {- 95 | As a Serialised Script 96 | -} 97 | 98 | datumRedeemer42Serialised :: PlutusScript PlutusScriptV1 99 | datumRedeemer42Serialised = PlutusScriptSerialised datumRedeemer42SBS 100 | 101 | writeDatumRedeemer42Script :: IO () 102 | writeDatumRedeemer42Script = void $ writeFileTextEnvelope "typed-datum-redeemer-42.plutus" Nothing datumRedeemer42Serialised 103 | 104 | {- 105 | Offchain Contract 106 | -} 107 | 108 | scrAddress :: Ledger.Address 109 | scrAddress = Scripts.validatorAddress typedValidator 110 | --scrAddress = Ledger.scriptHashAddress valHash 111 | 112 | valHash :: PSU.V1.ValidatorHash 113 | valHash = Scripts.validatorHash typedValidator 114 | 115 | datumRedeemer42Contract :: Contract () Empty Text () 116 | datumRedeemer42Contract = do 117 | logInfo @String $ "1: pay the script address" 118 | let tx1 = Constraints.mustPayToOtherScript valHash (Plutus.Datum $ BI.mkI 42) $ Ada.lovelaceValueOf 2000000 119 | ledgerTx1 <- submitTx tx1 120 | awaitTxConfirmed $ getCardanoTxId ledgerTx1 121 | logInfo @String $ "tx1 successfully submitted" 122 | 123 | logInfo @String $ "2: spend from script address including datum and redeemer 'Integer 42'" 124 | utxos <- utxosAt scrAddress 125 | let orefs = fst <$> Map.toList utxos 126 | lookups = 127 | Constraints.plutusV1OtherScript datumRedeemer42Validator 128 | <> Constraints.unspentOutputs utxos 129 | tx2 = 130 | mconcat [Constraints.mustSpendScriptOutput oref (Plutus.Redeemer $ BI.mkI 42) | oref <- orefs] 131 | <> Constraints.mustIncludeDatumInTx (Plutus.Datum $ BI.mkB "Not 42") -- List comprehension -- Changing redeemer value correctly throws ValidationError 132 | <> Constraints.mustValidateIn (to $ 1596059100000) -- doesn't seem to care what datum is 133 | Contract.logDebug $ requiredDatums tx2 -- does include wrong BS datum, idk 134 | ledgerTx2 <- submitTxConstraintsWith @Void lookups tx2 135 | logInfo @String $ "waiting for tx2 confirmed..." 136 | awaitTxConfirmed $ getCardanoTxId ledgerTx2 137 | logInfo @String $ "tx2 successfully submitted" 138 | 139 | {- 140 | Trace 141 | -} 142 | 143 | traceDatumRedeemer42 :: IO () 144 | traceDatumRedeemer42 = runEmulatorTraceIO datumRedeemer42Trace 145 | 146 | datumRedeemer42Trace :: EmulatorTrace () 147 | datumRedeemer42Trace = do 148 | void $ activateContractWallet (knownWallet 1) datumRedeemer42Contract 149 | void $ Emulator.waitNSlots 2 150 | -------------------------------------------------------------------------------- /src/UntypedHelloWorld.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | 11 | module UntypedHelloWorld 12 | ( helloWorldSerialised, 13 | helloWorldSBS, 14 | writeHelloWorldScript, 15 | writeHelloWorldScriptV2, 16 | ) 17 | where 18 | 19 | import Cardano.Api (writeFileTextEnvelope) 20 | import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised), 21 | PlutusScriptV1, PlutusScriptV2) 22 | import Codec.Serialise 23 | import qualified Data.ByteString.Lazy as LBS 24 | import qualified Data.ByteString.Short as SBS 25 | import Data.Functor (void) 26 | import qualified Plutus.V1.Ledger.Scripts as Plutus 27 | import qualified PlutusTx 28 | import qualified PlutusTx.Builtins as BI 29 | import PlutusTx.Prelude as P hiding (Semigroup (..), unless, 30 | (.)) 31 | import Prelude (IO, (.)) 32 | 33 | hello :: BuiltinData 34 | hello = BI.mkB "Hello World!" 35 | 36 | {- 37 | The Hello World validator script 38 | -} 39 | 40 | {-# INLINEABLE helloWorld #-} 41 | helloWorld :: BuiltinData -> BuiltinData -> BuiltinData -> () 42 | helloWorld datum _redeemer _context = if datum P.== hello then () else (P.error ()) 43 | 44 | {- 45 | As a Validator 46 | -} 47 | 48 | helloWorldValidator :: Plutus.Validator 49 | helloWorldValidator = Plutus.mkValidatorScript $$(PlutusTx.compile [||helloWorld||]) 50 | 51 | {- 52 | As a Script 53 | -} 54 | 55 | helloWorldScript :: Plutus.Script 56 | helloWorldScript = Plutus.unValidatorScript helloWorldValidator 57 | 58 | {- 59 | As a Short Byte String 60 | -} 61 | 62 | helloWorldSBS :: SBS.ShortByteString 63 | helloWorldSBS = SBS.toShort . LBS.toStrict $ serialise helloWorldScript 64 | 65 | {- 66 | As a Serialised Script 67 | -} 68 | 69 | helloWorldSerialised :: PlutusScript PlutusScriptV1 70 | helloWorldSerialised = PlutusScriptSerialised helloWorldSBS 71 | 72 | writeHelloWorldScript :: IO () 73 | writeHelloWorldScript = void $ writeFileTextEnvelope "untyped-helloWorld.plutus" Nothing helloWorldSerialised 74 | 75 | helloWorldSerialisedV2 :: PlutusScript PlutusScriptV2 76 | helloWorldSerialisedV2 = PlutusScriptSerialised helloWorldSBS 77 | 78 | writeHelloWorldScriptV2 :: IO () 79 | writeHelloWorldScriptV2 = void $ writeFileTextEnvelope "untyped-helloWorld-v2.plutus" Nothing helloWorldSerialisedV2 80 | -------------------------------------------------------------------------------- /src/ValidRangeEquivilance.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE NamedFieldPuns #-} 8 | {-# LANGUAGE NoImplicitPrelude #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module ValidRangeEquivilance 17 | ( serialisedScriptV1, 18 | scriptSBSV1, 19 | scriptV1, 20 | writeSerialisedScriptV1, 21 | serialisedScriptV2, 22 | scriptSBSV2, 23 | scriptV2, 24 | writeSerialisedScriptV2, 25 | printScriptDataV1, 26 | printScriptDataV2 27 | ) where 28 | 29 | import Cardano.Api (PlutusScriptV1, 30 | PlutusScriptV2, 31 | ScriptData, 32 | ScriptDataJsonSchema (ScriptDataJsonDetailedSchema), 33 | scriptDataToJson, 34 | writeFileTextEnvelope) 35 | import Cardano.Api.Shelley (PlutusScript (..), 36 | fromPlutusData) 37 | import Codec.Serialise 38 | import qualified Data.Aeson as A 39 | import qualified Data.ByteString.Lazy as LBS 40 | import qualified Data.ByteString.Short as SBS 41 | import Data.Functor (void) 42 | import Data.Text.Internal.Fusion.Size (upperBound) 43 | import Ledger (Interval (ivTo), 44 | ScriptPurpose) 45 | import qualified Ledger.Typed.Scripts as Scripts 46 | import qualified Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 47 | import qualified Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2 48 | import qualified Plutus.V1.Ledger.Api as PlutusV1 49 | import qualified Plutus.V1.Ledger.Api as V2PlutusV2 50 | import qualified Plutus.V1.Ledger.Interval as PlutusV1 51 | import qualified Plutus.V2.Ledger.Api as PlutusV2 52 | import qualified PlutusTx 53 | import PlutusTx.AssocMap (Map) 54 | import PlutusTx.Prelude as P hiding 55 | (Semigroup (..), 56 | unless, (.)) 57 | import Prelude (IO, Semigroup ((<>)), 58 | Show, print, (.)) 59 | 60 | data PV1CustomRedeemer 61 | = PV1CustomRedeemer 62 | { 63 | pv1Inputs :: [PlutusV1.TxInInfo] 64 | , pv1Outputs :: [PlutusV1.TxOut] 65 | , pv1Fee :: PlutusV1.Value 66 | , pv1Mint :: PlutusV1.Value 67 | , pv1DCert :: [PlutusV1.DCert] 68 | , pv1Wdrl :: Map PlutusV1.StakingCredential Integer 69 | , pv1ValidRange :: PlutusV1.POSIXTimeRange 70 | , pv1Signatories :: [PlutusV1.PubKeyHash] 71 | , pv1Data :: Map PlutusV1.DatumHash PlutusV1.Datum 72 | } deriving (Eq, Show) 73 | 74 | PlutusTx.unstableMakeIsData ''PV1CustomRedeemer 75 | 76 | data PV2CustomRedeemer 77 | = PV2CustomRedeemer 78 | { 79 | pv2Inputs :: [PlutusV2.TxInInfo] 80 | -- , pv2RefInputs :: [PlutusV2.TxInInfo] 81 | -- , pv2Outputs :: [PlutusV2.TxOut] 82 | -- , pv2Fee :: PlutusV2.Value 83 | -- , pv2Mint :: PlutusV2.Value 84 | -- , pv2DCert :: [PlutusV2.DCert] 85 | -- , pv2Wdrl :: PlutusV2.Map V2PlutusV2.StakingCredential Integer 86 | , pv2ValidRange :: PlutusV2.POSIXTimeRange 87 | -- , pv2Signatories :: [PlutusV2.PubKeyHash] 88 | -- , pv2Redeemers :: PlutusV2.Map ScriptPurpose PlutusV2.Redeemer 89 | -- , pv2Data :: PlutusV2.Map PlutusV2.DatumHash PlutusV2.Datum 90 | } deriving (Eq, Show) 91 | 92 | PlutusTx.unstableMakeIsData ''PV2CustomRedeemer 93 | 94 | data AnyCustomRedeemer 95 | = AnyPV1CustomRedeemer PV1CustomRedeemer | 96 | AnyPV2CustomRedeemer PV2CustomRedeemer 97 | deriving (Show, Eq) 98 | 99 | --PlutusTx.unstableMakeIsData ''AnyCustomRedeemer 100 | 101 | customRedeemerToScriptData :: AnyCustomRedeemer -> ScriptData 102 | customRedeemerToScriptData (AnyPV1CustomRedeemer cRedeem) = 103 | fromPlutusData $ PlutusV1.toData cRedeem 104 | customRedeemerToScriptData (AnyPV2CustomRedeemer cRedeem) = 105 | fromPlutusData $ PlutusV2.toData cRedeem 106 | 107 | timeRangeV1 :: PlutusV1.POSIXTimeRange 108 | timeRangeV1 = PlutusV1.Interval 109 | (PlutusV1.LowerBound (PlutusV1.Finite $ PlutusV1.POSIXTime 665000000) True) 110 | (PlutusV1.UpperBound (PlutusV1.Finite $ PlutusV1.POSIXTime 666000000) True) 111 | 112 | timeRangeV2 :: PlutusV2.POSIXTimeRange 113 | timeRangeV2 = PlutusV2.Interval 114 | (PlutusV2.LowerBound (PlutusV2.NegInf) True) 115 | (PlutusV2.UpperBound (PlutusV2.Finite $ PlutusV2.POSIXTime 666000000) True) 116 | 117 | 118 | 119 | redeemerV2 = PV2CustomRedeemer { pv2Inputs = [], pv2ValidRange = timeRangeV2 } 120 | 121 | printScriptDataV1 = print $ "Script Data: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV1.toData timeRangeV1) 122 | printScriptDataV2 = print $ "Script Data: " <> A.encode (scriptDataToJson ScriptDataJsonDetailedSchema $ fromPlutusData $ PlutusV2.toData redeemerV2) 123 | 124 | -- V1 125 | 126 | {-# INLINABLE mkPolicyV1 #-} 127 | mkPolicyV1 :: PV2CustomRedeemer -> PlutusV1.ScriptContext -> Bool 128 | mkPolicyV1 (PV2CustomRedeemer _ r) ctx = r /= PlutusV1.txInfoValidRange (PlutusV1.scriptContextTxInfo ctx) 129 | -- where 130 | -- info :: PlutusV1.TxInfo 131 | -- info = PlutusV1.scriptContextTxInfo ctx 132 | 133 | -- extendUpperBound :: PlutusV1.POSIXTimeRange -> PlutusV1.POSIXTimeRange 134 | -- extendUpperBound (PlutusV1.Interval l (PlutusV1.UpperBound (PlutusV1.Finite f) c)) = PlutusV1.Interval l (PlutusV1.UpperBound (PlutusV1.Finite ( f + t )) c) 135 | 136 | policyV1 :: Scripts.MintingPolicy 137 | policyV1 = PlutusV1.mkMintingPolicyScript $$(PlutusTx.compile [|| wrap ||]) 138 | where 139 | wrap = Scripts.mkUntypedMintingPolicy mkPolicyV1 140 | 141 | scriptV1 :: PlutusV1.Script 142 | scriptV1 = PlutusV1.unMintingPolicyScript policyV1 143 | 144 | scriptSBSV1 :: SBS.ShortByteString 145 | scriptSBSV1 = SBS.toShort . LBS.toStrict $ serialise scriptV1 146 | 147 | serialisedScriptV1 :: PlutusScript PlutusScriptV1 148 | serialisedScriptV1 = PlutusScriptSerialised scriptSBSV1 149 | 150 | writeSerialisedScriptV1 :: IO () 151 | writeSerialisedScriptV1 = void $ writeFileTextEnvelope "valid-range-inequivilance-v1.plutus" Nothing serialisedScriptV1 152 | 153 | -- V2 154 | 155 | {-# INLINABLE mkPolicyV2 #-} 156 | mkPolicyV2 :: PV2CustomRedeemer -> PlutusV2.ScriptContext -> Bool 157 | mkPolicyV2 (PV2CustomRedeemer _ r) _ = PlutusV2.ivFrom r == PlutusV2.ivFrom r 158 | -- where 159 | -- info :: PlutusV2.TxInfo 160 | -- info = PlutusV2.scriptContextTxInfo ctx 161 | 162 | -- extendUpperBound :: PlutusV2.POSIXTimeRange -> PlutusV2.POSIXTime -> PlutusV2.POSIXTimeRange 163 | -- extendUpperBound (PlutusV2.Interval l (PlutusV2.UpperBound (PlutusV2.Finite f) c)) a = PlutusV2.Interval l (PlutusV2.UpperBound (PlutusV2.Finite $ f + a) c) 164 | 165 | policyV2 :: Scripts.MintingPolicy 166 | policyV2 = PlutusV2.mkMintingPolicyScript $$(PlutusTx.compile [|| wrap ||]) 167 | where 168 | wrap = Scripts.mkUntypedMintingPolicy mkPolicyV2 169 | 170 | scriptV2 :: PlutusV1.Script 171 | scriptV2 = PlutusV1.unMintingPolicyScript policyV2 172 | 173 | scriptSBSV2 :: SBS.ShortByteString 174 | scriptSBSV2 = SBS.toShort . LBS.toStrict $ serialise scriptV2 175 | 176 | serialisedScriptV2 :: PlutusScript PlutusScriptV2 177 | serialisedScriptV2 = PlutusScriptSerialised scriptSBSV2 178 | 179 | writeSerialisedScriptV2 :: IO () 180 | writeSerialisedScriptV2 = void $ writeFileTextEnvelope "valid-range-equivilance-v2.plutus" Nothing serialisedScriptV2 181 | --------------------------------------------------------------------------------