From 2e5409a1d6edc4907c9e11eef5139986593a94ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Fri, 10 Jun 2022 21:54:49 +0200 Subject: [PATCH 01/15] bump deps --- flake.lock | 32 ++++++++++++------------ flake.nix | 8 +++--- src/Plutus/Test/Model/Blockchain.hs | 2 +- src/Plutus/Test/Model/Fork/CardanoAPI.hs | 15 +++++++++-- 4 files changed, 34 insertions(+), 23 deletions(-) diff --git a/flake.lock b/flake.lock index 624d694..bee9e41 100644 --- a/flake.lock +++ b/flake.lock @@ -87,17 +87,17 @@ "cardano-addresses": { "flake": false, "locked": { - "lastModified": 1639584472, - "narHash": "sha256-Eyu7PVYk1oQLp/Hd43S2PW+PojyAT/Rr48Xng6sbtIU=", + "lastModified": 1631515399, + "narHash": "sha256-XgXQKJHRKAFwIjONh19D/gKE0ARlhMXXcV74eZpd0lw=", "owner": "input-output-hk", "repo": "cardano-addresses", - "rev": "71006f9eb956b0004022e80aadd4ad50d837b621", + "rev": "d2f86caa085402a953920c6714a0de6a50b655ec", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-addresses", - "rev": "71006f9eb956b0004022e80aadd4ad50d837b621", + "rev": "d2f86caa085402a953920c6714a0de6a50b655ec", "type": "github" } }, @@ -222,17 +222,17 @@ "cardano-wallet": { "flake": false, "locked": { - "lastModified": 1642494510, - "narHash": "sha256-A3im2IkoumUx3NzgPooaXGC18/iYxbEooMa9ho93/6o=", + "lastModified": 1643027663, + "narHash": "sha256-gn2bFvahj6eM3nJ+MfVFHth7JPDcV78+evMxirusTGQ=", "owner": "j-mueller", "repo": "cardano-wallet", - "rev": "a5085acbd2670c24251cf8d76a4e83c77a2679ba", + "rev": "5ad348d26313363bacec061ee963c89fd9d467b8", "type": "github" }, "original": { "owner": "j-mueller", "repo": "cardano-wallet", - "rev": "a5085acbd2670c24251cf8d76a4e83c77a2679ba", + "rev": "5ad348d26313363bacec061ee963c89fd9d467b8", "type": "github" } }, @@ -571,34 +571,34 @@ "plutus": { "flake": false, "locked": { - "lastModified": 1644763429, - "narHash": "sha256-hJDQIrSEJWXmJnOYoneAZQDB2VW59FRm8ly/nqkU2dA=", + "lastModified": 1646650116, + "narHash": "sha256-S8uvyld7ZpPsmxZlWJeRNAPd+mw3PafrtaiiuU8H3KA=", "owner": "input-output-hk", "repo": "plutus", - "rev": "d4f933d25ecc35a9c5bb057f5cf462112129cfdb", + "rev": "4127e9cd6e889824d724c30eae55033cb50cbf3e", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "plutus", - "rev": "d4f933d25ecc35a9c5bb057f5cf462112129cfdb", + "rev": "4127e9cd6e889824d724c30eae55033cb50cbf3e", "type": "github" } }, "plutus-apps": { "flake": false, "locked": { - "lastModified": 1646168223, - "narHash": "sha256-ao9CPg1/FwDQ8JCIetTnEv8nRgWYrsMrvRpXRBvz9sU=", + "lastModified": 1646839502, + "narHash": "sha256-uQ+OEE+xdDXvH2ZhP2N2nYeiU+JoU8zFV1ZLHvGWR9k=", "owner": "input-output-hk", "repo": "plutus-apps", - "rev": "686b559d34c7bd934b327a1644f31fe42d643492", + "rev": "63deb7d7ebd1c8c8ddf2640e1873d8f0f49559a1", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "plutus-apps", - "rev": "686b559d34c7bd934b327a1644f31fe42d643492", + "rev": "63deb7d7ebd1c8c8ddf2640e1873d8f0f49559a1", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 4256a94..953c3ca 100644 --- a/flake.nix +++ b/flake.nix @@ -16,7 +16,7 @@ # all inputs below here are for pinning with haskell.nix cardano-addresses = { url = - "github:input-output-hk/cardano-addresses/71006f9eb956b0004022e80aadd4ad50d837b621"; + "github:input-output-hk/cardano-addresses/d2f86caa085402a953920c6714a0de6a50b655ec"; flake = false; }; cardano-base = { @@ -51,7 +51,7 @@ }; cardano-wallet = { url = - "github:j-mueller/cardano-wallet/a5085acbd2670c24251cf8d76a4e83c77a2679ba"; + "github:j-mueller/cardano-wallet/5ad348d26313363bacec061ee963c89fd9d467b8"; flake = false; }; flat = { @@ -81,12 +81,12 @@ }; plutus = { url = - "github:input-output-hk/plutus/d4f933d25ecc35a9c5bb057f5cf462112129cfdb"; + "github:input-output-hk/plutus/4127e9cd6e889824d724c30eae55033cb50cbf3e"; flake = false; }; plutus-apps = { url = - "github:input-output-hk/plutus-apps/686b559d34c7bd934b327a1644f31fe42d643492"; + "github:input-output-hk/plutus-apps/63deb7d7ebd1c8c8ddf2640e1873d8f0f49559a1"; flake = false; }; Win32-network = { diff --git a/src/Plutus/Test/Model/Blockchain.hs b/src/Plutus/Test/Model/Blockchain.hs index 2a9b15d..e8cd2ca 100644 --- a/src/Plutus/Test/Model/Blockchain.hs +++ b/src/Plutus/Test/Model/Blockchain.hs @@ -836,7 +836,7 @@ getUTxO tid tx = do fromTxOut networkId (tin, tout) = do cin <- Cardano.toCardanoTxIn $ P.txInRef tin - cout <- fmap toCtxUTxOTxOut $ Cardano.toCardanoTxOut networkId (P.txData tx) tout + cout <- fmap toCtxUTxOTxOut $ Cardano.toCardanoTxOut networkId (Fork.toCardanoTxOutDatum $ P.txData tx) tout pure (cin, cout) toUtxo :: NetworkId -> [(TxIn, TxOut)] -> Either Cardano.ToCardanoError (UTxO AlonzoEra) diff --git a/src/Plutus/Test/Model/Fork/CardanoAPI.hs b/src/Plutus/Test/Model/Fork/CardanoAPI.hs index bf97c9c..b1409f6 100644 --- a/src/Plutus/Test/Model/Fork/CardanoAPI.hs +++ b/src/Plutus/Test/Model/Fork/CardanoAPI.hs @@ -15,6 +15,7 @@ not accessible from standard Plutus TX -} module Plutus.Test.Model.Fork.CardanoAPI ( toCardanoTxBody, + toCardanoTxOutDatum, toCardanoStakeWitness, ) where @@ -35,10 +36,20 @@ import Codec.Serialise qualified as Codec import Plutus.Test.Model.Fork.CardanoAPITemp (makeTransactionBody') import Prelude -import Ledger.Tx.CardanoAPI hiding (toCardanoTxBody) +import Ledger.Tx.CardanoAPI hiding (deserialiseFromRawBytes, toCardanoTxBody) import Plutus.Test.Model.Fork.TxExtra import PlutusTx.Prelude qualified as PlutusTx +import Data.Maybe (fromMaybe) +toCardanoScriptData :: Api.BuiltinData -> C.ScriptData +toCardanoScriptData = C.fromPlutusData . Api.builtinDataToData + +toCardanoTxOutDatum :: Map.Map Api.DatumHash Api.Datum -> Maybe Api.DatumHash -> Either ToCardanoError (C.TxOutDatum C.CtxTx C.AlonzoEra) +toCardanoTxOutDatum datas mHash = fromMaybe (toCardanoTxOutDatumHash mHash) $ do + datumHash <- mHash + datum <- Map.lookup datumHash datas + pure $ pure $ C.TxOutDatum C.ScriptDataInAlonzoEra $ toCardanoScriptData $ Api.getDatum datum + toCardanoTxBody :: [P.PaymentPubKeyHash] -- ^ Required signers of the transaction -> Maybe C.ProtocolParameters -- ^ Protocol parameters to use. Building Plutus transactions will fail if this is 'Nothing' @@ -48,7 +59,7 @@ toCardanoTxBody toCardanoTxBody sigs protocolParams networkId (Tx extra P.Tx{..}) = do txIns <- traverse toCardanoTxInBuild $ Set.toList txInputs txInsCollateral <- toCardanoTxInsCollateral txCollateral - txOuts <- traverse (toCardanoTxOut networkId txData) txOutputs + txOuts <- traverse (toCardanoTxOut networkId $ toCardanoTxOutDatum txData) txOutputs txFee' <- toCardanoFee txFee txValidityRange <- toCardanoValidityRange txValidRange txMintValue <- toCardanoMintValue txRedeemers txMint txMintScripts From 3a446c4ee73dc399257c38e1873b8b5cda5c306c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Thu, 28 Jul 2022 11:07:29 +0200 Subject: [PATCH 02/15] chore: fit with indigo project --- flake.lock | 32 ++++++++++++------------- flake.nix | 8 +++---- src/Plutus/Model/Fork/Cardano/Common.hs | 4 ++-- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/flake.lock b/flake.lock index 5fbb007..1d8ca9f 100644 --- a/flake.lock +++ b/flake.lock @@ -87,17 +87,17 @@ "cardano-base": { "flake": false, "locked": { - "lastModified": 1652788515, - "narHash": "sha256-l0KgomRi6YhEoOlFnBYEXhnZO2+PW68rhfUrbMXjhCQ=", + "lastModified": 1654537609, + "narHash": "sha256-4b0keLjRaVSdEwfBXB1iT3QPlsutdxSltGfBufT4Clw=", "owner": "input-output-hk", "repo": "cardano-base", - "rev": "631cb6cf1fa01ab346233b610a38b3b4cba6e6ab", + "rev": "0f3a867493059e650cda69e20a5cbf1ace289a57", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-base", - "rev": "631cb6cf1fa01ab346233b610a38b3b4cba6e6ab", + "rev": "0f3a867493059e650cda69e20a5cbf1ace289a57", "type": "github" } }, @@ -121,34 +121,34 @@ "cardano-ledger": { "flake": false, "locked": { - "lastModified": 1657934159, - "narHash": "sha256-Pfc4FPSWySZLd/mqK1Gtru4IKfI/0HEdX4nSW2iOP0U=", + "lastModified": 1657127204, + "narHash": "sha256-4wcSA61TwoDTvJ6rx7tjEAJjQLO/cs8WGTHcOghNdTc=", "owner": "input-output-hk", "repo": "cardano-ledger", - "rev": "389b266d6226dedf3d2aec7af640b3ca4984c5ea", + "rev": "3be8a19083fc13d9261b1640e27dd389b51bb08e", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-ledger", - "rev": "389b266d6226dedf3d2aec7af640b3ca4984c5ea", + "rev": "3be8a19083fc13d9261b1640e27dd389b51bb08e", "type": "github" } }, "cardano-prelude": { "flake": false, "locked": { - "lastModified": 1657171052, - "narHash": "sha256-T5hW85PfnuR6066jIhH/2g5dzTmI0JXsXSKwez8fXnw=", + "lastModified": 1617089317, + "narHash": "sha256-kgX3DKyfjBb8/XcDEd+/adlETsFlp5sCSurHWgsFAQI=", "owner": "input-output-hk", "repo": "cardano-prelude", - "rev": "533aec85c1ca05c7d171da44b89341fb736ecfe5", + "rev": "bb4ed71ba8e587f672d06edf9d2e376f4b055555", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "cardano-prelude", - "rev": "533aec85c1ca05c7d171da44b89341fb736ecfe5", + "rev": "bb4ed71ba8e587f672d06edf9d2e376f4b055555", "type": "github" } }, @@ -550,17 +550,17 @@ "plutus": { "flake": false, "locked": { - "lastModified": 1657812223, - "narHash": "sha256-coD/Kpl7tutwXb6ukQCH5XojBjquYkW7ob0BWZtdpok=", + "lastModified": 1656585904, + "narHash": "sha256-ATwDR5LX2RN9YfoPhTxV7REvFoJnM4x/CN9XZVZlalg=", "owner": "input-output-hk", "repo": "plutus", - "rev": "8ab4c3355c5fdf67dcf6acc1f5a14668d5e6f0a9", + "rev": "69ab98c384703172f898eb5bcad1078ded521426", "type": "github" }, "original": { "owner": "input-output-hk", "repo": "plutus", - "rev": "8ab4c3355c5fdf67dcf6acc1f5a14668d5e6f0a9", + "rev": "69ab98c384703172f898eb5bcad1078ded521426", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 39ea0ee..88fcfd2 100644 --- a/flake.nix +++ b/flake.nix @@ -9,13 +9,13 @@ haskell-nix-extra-hackage.inputs.haskell-nix.follows = "haskell-nix"; haskell-nix-extra-hackage.inputs.nixpkgs.follows = "nixpkgs"; - cardano-base.url = "github:input-output-hk/cardano-base/631cb6cf1fa01ab346233b610a38b3b4cba6e6ab"; + cardano-base.url = "github:input-output-hk/cardano-base/0f3a867493059e650cda69e20a5cbf1ace289a57"; cardano-base.flake = false; cardano-crypto.url = "github:input-output-hk/cardano-crypto/f73079303f663e028288f9f4a9e08bcca39a923e"; cardano-crypto.flake = false; - cardano-ledger.url = "github:input-output-hk/cardano-ledger/389b266d6226dedf3d2aec7af640b3ca4984c5ea"; + cardano-ledger.url = "github:input-output-hk/cardano-ledger/3be8a19083fc13d9261b1640e27dd389b51bb08e"; cardano-ledger.flake = false; - cardano-prelude.url = "github:input-output-hk/cardano-prelude/533aec85c1ca05c7d171da44b89341fb736ecfe5"; + cardano-prelude.url = "github:input-output-hk/cardano-prelude/bb4ed71ba8e587f672d06edf9d2e376f4b055555"; cardano-prelude.flake = false; flat.url = "github:Quid2/flat/ee59880f47ab835dbd73bea0847dab7869fc20d8"; flat.flake = false; @@ -23,7 +23,7 @@ goblins.flake = false; weigh.url = "github:fpco/weigh/bfcf4415144d7d2817dfcb91b6f9a6dfd7236de7"; weigh.flake = false; - plutus.url = "github:input-output-hk/plutus/8ab4c3355c5fdf67dcf6acc1f5a14668d5e6f0a9"; + plutus.url = "github:input-output-hk/plutus/69ab98c384703172f898eb5bcad1078ded521426"; plutus.flake = false; Win32-network.url = "github:input-output-hk/Win32-network/3825d3abf75f83f406c1f7161883c438dac7277d"; Win32-network.flake = false; diff --git a/src/Plutus/Model/Fork/Cardano/Common.hs b/src/Plutus/Model/Fork/Cardano/Common.hs index 7a9d1ba..3682370 100644 --- a/src/Plutus/Model/Fork/Cardano/Common.hs +++ b/src/Plutus/Model/Fork/Cardano/Common.hs @@ -64,7 +64,7 @@ import Cardano.Ledger.Shelley.API.Types qualified as Shelley (Hash) import Cardano.Ledger.TxIn qualified as C import Cardano.Ledger.ShelleyMA.Timelocks qualified as C import Cardano.Ledger.Keys qualified as C -import Cardano.Ledger.Keys.WitVKey +import Cardano.Ledger.Shelley.TxBody (Delegation (Delegation), WitVKey) import Cardano.Ledger.Shelley.UTxO qualified as C import qualified Cardano.Crypto.Hash.Class as Crypto import Cardano.Ledger.Mary.Value qualified as C @@ -167,7 +167,7 @@ toDCert :: Network -> C.Coin -> C.Coin -> P.DCert -> Either ToCardanoError (C.DC toDCert network poolDeposit minPoolCost = \case P.DCertDelegRegKey (P.StakingHash stakingCredential) -> C.DCertDeleg . C.RegKey <$> toCredential stakingCredential P.DCertDelegDeRegKey (P.StakingHash stakingCredential) -> C.DCertDeleg . C.DeRegKey <$> toCredential stakingCredential - P.DCertDelegDelegate (P.StakingHash stakingCredential) pubKeyHash -> C.DCertDeleg . C.Delegate <$> (C.Delegation <$> toCredential stakingCredential <*> toPubKeyHash pubKeyHash) + P.DCertDelegDelegate (P.StakingHash stakingCredential) pubKeyHash -> C.DCertDeleg . C.Delegate <$> (Delegation <$> toCredential stakingCredential <*> toPubKeyHash pubKeyHash) P.DCertPoolRegister poolKeyHash poolVfr -> C.DCertPool . C.RegPool <$> toPoolParams poolKeyHash poolVfr P.DCertPoolRetire pkh n -> C.DCertPool . (\key -> C.RetirePool key (C.EpochNo (fromIntegral n)) ) <$> toPubKeyHash pkh P.DCertGenesis -> Left "DCertGenesis is not supported" From b198fb53d51b516cde0145724edb36d78fb9f2ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Tue, 25 Oct 2022 19:22:14 +0200 Subject: [PATCH 03/15] feat: add untyped validator and spendScriptRefUntyped --- src/Plutus/Model/Contract.hs | 18 ++++++++++++++++++ src/Plutus/Model/Validator.hs | 13 +++++++++++++ 2 files changed, 31 insertions(+) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index e76b3dd..e95e65b 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -56,6 +56,7 @@ module Plutus.Model.Contract ( spendPubKey, spendScript, spendScriptRef, + spendScriptRefUntyped, spendBox, refInputInline, refInputHash, @@ -445,6 +446,23 @@ spendScriptRef refScript script refOut red dat = toExtra $ sh = scriptHash script validator = toVersionedScript script +spendScriptRefUntyped :: + TxOutRef -> + UntypedValidator -> + TxOutRef -> + Redeemer -> + Datum -> + Tx +spendScriptRefUntyped refScript script refOut red dat = toExtra $ + mempty + { P.txInputs = S.singleton $ Fork.TxIn refOut (Just $ Fork.ConsumeScriptAddress Nothing red dat) + , P.txReferenceInputs = S.singleton $ Fork.TxIn refScript Nothing + , P.txScripts = M.singleton sh validator + } + where + sh = scriptHash script + validator = Versioned (getLanguage script) (getValidator $ toValidator script) + -- | Reference input with inlined datum refInputInline :: TxOutRef -> Tx refInputInline ref = toExtra $ diff --git a/src/Plutus/Model/Validator.hs b/src/Plutus/Model/Validator.hs index 8498632..a6581b2 100644 --- a/src/Plutus/Model/Validator.hs +++ b/src/Plutus/Model/Validator.hs @@ -12,6 +12,7 @@ module Plutus.Model.Validator( IsValidatorHash, TypedValidator(..), + UntypedValidator(..), TypedValidatorHash(..), TypedPolicy(..), TypedStake(..), @@ -99,6 +100,18 @@ instance HasValidator (TypedValidator datum redeemer) where instance HasAddress (TypedValidator datum redeemer) where toAddress = toAddress . toValidatorHash +--------------------------------------------------------------------- +-- untyped validator + +newtype UntypedValidator = UntypedValidator { unUntypedValidator :: Versioned Validator } + deriving newtype (HasLanguage) + +instance HasValidator UntypedValidator where + toValidator (UntypedValidator (Versioned _lang validator)) = validator + +instance HasAddress UntypedValidator where + toAddress = toAddress . toValidatorHash + --------------------------------------------------------------------- -- typed validator hash From bc736ca138834b1ba255ca160c4b61e1668c26aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Tue, 25 Oct 2022 19:25:42 +0200 Subject: [PATCH 04/15] feat: add spendScriptUntyped --- src/Plutus/Model/Contract.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index e95e65b..527074c 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -55,6 +55,7 @@ module Plutus.Model.Contract ( userSpend, spendPubKey, spendScript, + spendScriptUntyped, spendScriptRef, spendScriptRefUntyped, spendBox, @@ -149,6 +150,7 @@ import Plutus.Model.Fork.Ledger.Tx qualified as P import Plutus.Model.Fork.Ledger.Tx qualified as Fork import Plutus.Model.Validator as X import Plutus.Model.Ada (Ada(..)) +import Plutus.Model.Validator (UntypedValidator(unUntypedValidator)) ------------------------------------------------------------------------ -- modify blockchain @@ -427,6 +429,18 @@ spendScript tv ref red dat = toExtra $ { P.txInputs = S.singleton $ Fork.TxIn ref (Just $ Fork.ConsumeScriptAddress (Just $ Versioned (getLanguage tv) (toValidator tv)) (toRedeemer red) (toDatum dat)) } +-- | Spend script input untyped. +spendScriptUntyped :: + UntypedValidator -> + TxOutRef -> + Redeemer -> + Datum -> + Tx +spendScriptUntyped v ref red dat = toExtra $ + mempty + { P.txInputs = S.singleton $ Fork.TxIn ref (Just $ Fork.ConsumeScriptAddress (Just $ unUntypedValidator v) red dat) + } + -- | Spends script that references other script spendScriptRef :: (IsValidator script) => @@ -446,6 +460,7 @@ spendScriptRef refScript script refOut red dat = toExtra $ sh = scriptHash script validator = toVersionedScript script +-- | Spends script that references other script untyped version spendScriptRefUntyped :: TxOutRef -> UntypedValidator -> From fbc9fe4b9e6f684a1540a541ba4fb900467a2164 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Tue, 25 Oct 2022 19:33:07 +0200 Subject: [PATCH 05/15] style: lint fix --- src/Plutus/Model/Contract.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index 527074c..1d96013 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -150,7 +150,6 @@ import Plutus.Model.Fork.Ledger.Tx qualified as P import Plutus.Model.Fork.Ledger.Tx qualified as Fork import Plutus.Model.Validator as X import Plutus.Model.Ada (Ada(..)) -import Plutus.Model.Validator (UntypedValidator(unUntypedValidator)) ------------------------------------------------------------------------ -- modify blockchain From e6696f09b79cb03922f530758083e6d9b422b6ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Tue, 25 Oct 2022 20:01:56 +0200 Subject: [PATCH 06/15] feat: add mkUntypedValidator --- src/Plutus/Model/Validator/V2.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Plutus/Model/Validator/V2.hs b/src/Plutus/Model/Validator/V2.hs index 843f1da..630ef1e 100644 --- a/src/Plutus/Model/Validator/V2.hs +++ b/src/Plutus/Model/Validator/V2.hs @@ -1,6 +1,7 @@ -- | Creation of typed validators for Plutus V2 module Plutus.Model.Validator.V2( mkTypedValidator, + mkUntypedValidator, mkTypedPolicy, mkTypedStake, toBuiltinValidator, @@ -13,13 +14,17 @@ import PlutusTx.Prelude qualified as Plutus import Plutus.V2.Ledger.Api import PlutusTx.Code (CompiledCode) -import Plutus.Model.Validator (TypedValidator(..), TypedPolicy(..), TypedStake(..)) +import Plutus.Model.Validator (TypedValidator(..), TypedPolicy(..), TypedStake(..), UntypedValidator (UntypedValidator)) import Plutus.Model.Fork.Ledger.Scripts (toV2) -- | Create Plutus V2 typed validator mkTypedValidator :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> TypedValidator datum redeemer mkTypedValidator = TypedValidator . toV2 . mkValidatorScript +-- | Create Plutus V2 untyped validator +mkUntypedValidator :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> UntypedValidator +mkUntypedValidator = UntypedValidator . toV2 . mkValidatorScript + -- | Create Plutus V2 typed minting policy mkTypedPolicy :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> TypedPolicy redeemer mkTypedPolicy = TypedPolicy . toV2 . mkMintingPolicyScript From 39fed20e5e16c6fb49e851ccae5fcd8980f52649 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Tue, 25 Oct 2022 20:31:05 +0200 Subject: [PATCH 07/15] feat: add payToScriptUntyped --- src/Plutus/Model/Contract.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index 1d96013..ac0b6f7 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -48,6 +48,7 @@ module Plutus.Model.Contract ( payToKey, payToKeyDatum, payToScript, + payToScriptUntyped, loadRefScript, loadRefScriptDatum, payToRef, @@ -367,6 +368,21 @@ payToScript script dat val = toExtra $ where (outDatum, datumMap) = fromDatumMode dat +-- | Pay to the script untyped. +-- The a type parameter represents the contents of the datum. +-- Example for datum: `()` and not `Datum $ toBuiltinDatum ()`. +payToScriptUntyped :: ToData a => + UntypedValidator -> DatumMode a -> Value -> Tx +payToScriptUntyped script dat val = toExtra $ + mempty + { P.txOutputs = [TxOut (toAddress script) val outDatum Nothing] + , P.txData = datumMap + } + where + (outDatum, datumMap) = fromDatumMode dat + + + -- | Uploads the reference script to blockchain loadRefScript :: (IsValidator script) => script -> Value -> Tx loadRefScript script val = loadRefScriptBy script Nothing val From 2962ade08677c143784532eca50410a2876a9bff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Wed, 26 Oct 2022 12:42:19 +0200 Subject: [PATCH 08/15] feat: lower the constraints for box related functions --- src/Plutus/Model/Contract.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index ac0b6f7..d50ed1d 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -612,25 +612,25 @@ txBoxValue :: TxBox a -> Value txBoxValue = txOutValue . txBoxOut -- | Read UTXOs with datums. -boxAt :: (IsValidator script) => script -> Run [TxBox script] +boxAt :: (HasAddress script, HasDatum script) => script -> Run [TxBox script] boxAt addr = do utxos <- utxoAt (toAddress addr) fmap catMaybes $ mapM (\(ref, tout) -> fmap (\dat -> TxBox ref tout dat) <$> datumAt ref) utxos -- | It expects that Typed validator can have only one UTXO -- which is NFT. -nftAt :: IsValidator script => script -> Run (TxBox script) +nftAt :: (HasAddress script, HasDatum script) => script -> Run (TxBox script) nftAt tv = head <$> boxAt tv -- | Safe query for single Box -withBox :: IsValidator script => (TxBox script -> Bool) -> script -> (TxBox script -> Run ()) -> Run () +withBox :: (HasAddress script, HasDatum script) => (TxBox script -> Bool) -> script -> (TxBox script -> Run ()) -> Run () withBox isBox script cont = withMayBy readMsg (L.find isBox <$> boxAt script) cont where readMsg = ("No UTxO box for: " <> ) <$> getPrettyAddress (toAddress script) -- | Reads single box from the list. we expect NFT to be a single UTXO for a given script. -withNft :: IsValidator script => script -> (TxBox script -> Run ()) -> Run () +withNft :: (HasAddress script, HasDatum script) => script -> (TxBox script -> Run ()) -> Run () withNft = withBox (const True) ---------------------------------------------------------------------- From 4789aecbb61240f6c8900188e9594c85f8660a17 Mon Sep 17 00:00:00 2001 From: slimbook Date: Sat, 12 Nov 2022 18:01:35 +0000 Subject: [PATCH 09/15] Fix check balance with ref. scripts --- src/Plutus/Model/Contract.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index d50ed1d..d9f99b8 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -766,10 +766,11 @@ checkBalanceBy :: (a -> BalanceDiff) -> Run a -> Run a checkBalanceBy getDiffs act = do beforeSt <- get res <- act + afterSt <- get let BalanceDiff diffs = getDiffs res addrs = M.keys diffs before = fmap (`valueAtState` beforeSt) addrs - after <- mapM valueAt addrs + after = fmap (`valueAtState` afterSt) addrs mapM_ (logError . show . vcat <=< mapM ppError) (check addrs diffs before after) pure res where From 23ac7813a117cda6f86c96c46a667bb5af129f1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Thu, 22 Dec 2022 16:25:31 +0100 Subject: [PATCH 10/15] feat: untyped validator hash --- src/Plutus/Model/Validator.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/Plutus/Model/Validator.hs b/src/Plutus/Model/Validator.hs index a6581b2..b428622 100644 --- a/src/Plutus/Model/Validator.hs +++ b/src/Plutus/Model/Validator.hs @@ -13,6 +13,7 @@ module Plutus.Model.Validator( TypedValidator(..), UntypedValidator(..), + UntypedValidatorHash(..), TypedValidatorHash(..), TypedPolicy(..), TypedStake(..), @@ -103,7 +104,8 @@ instance HasAddress (TypedValidator datum redeemer) where --------------------------------------------------------------------- -- untyped validator -newtype UntypedValidator = UntypedValidator { unUntypedValidator :: Versioned Validator } +newtype UntypedValidator = + UntypedValidator { unUntypedValidator :: Versioned Validator } deriving newtype (HasLanguage) instance HasValidator UntypedValidator where @@ -112,6 +114,19 @@ instance HasValidator UntypedValidator where instance HasAddress UntypedValidator where toAddress = toAddress . toValidatorHash +--------------------------------------------------------------------- +-- untyped validator hash + +newtype UntypedValidatorHash = + UntypedValidatorHash { unTypedValidatorHash :: Versioned ValidatorHash } + deriving newtype (HasLanguage) + +instance HasValidatorHash UntypedValidatorHash where + toValidatorHash (UntypedValidatorHash (Versioned _lang vh)) = vh + +instance HasAddress UntypedValidatorHash where + toAddress (UntypedValidatorHash (Versioned _lang vh)) = toAddress vh + --------------------------------------------------------------------- -- typed validator hash From e7d8cb9e4110c9c6af13e352bfd163f02841e131 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Thu, 22 Dec 2022 17:32:59 +0100 Subject: [PATCH 11/15] feat: update constraints in payToScriptUntyped --- src/Plutus/Model/Contract.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index d9f99b8..2f776a7 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -371,8 +371,8 @@ payToScript script dat val = toExtra $ -- | Pay to the script untyped. -- The a type parameter represents the contents of the datum. -- Example for datum: `()` and not `Datum $ toBuiltinDatum ()`. -payToScriptUntyped :: ToData a => - UntypedValidator -> DatumMode a -> Value -> Tx +payToScriptUntyped :: (ToData a, HasAddress script) => + script -> DatumMode a -> Value -> Tx payToScriptUntyped script dat val = toExtra $ mempty { P.txOutputs = [TxOut (toAddress script) val outDatum Nothing] From 900f62cddcea651873724d07250619480823ae42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Wed, 19 Jul 2023 11:33:41 +0200 Subject: [PATCH 12/15] feat: typed validator construction from validator --- src/Plutus/Model/Validator/V2.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Plutus/Model/Validator/V2.hs b/src/Plutus/Model/Validator/V2.hs index 630ef1e..818c50e 100644 --- a/src/Plutus/Model/Validator/V2.hs +++ b/src/Plutus/Model/Validator/V2.hs @@ -1,6 +1,7 @@ -- | Creation of typed validators for Plutus V2 module Plutus.Model.Validator.V2( mkTypedValidator, + mkTypedValidator', mkUntypedValidator, mkTypedPolicy, mkTypedStake, @@ -17,6 +18,9 @@ import PlutusTx.Code (CompiledCode) import Plutus.Model.Validator (TypedValidator(..), TypedPolicy(..), TypedStake(..), UntypedValidator (UntypedValidator)) import Plutus.Model.Fork.Ledger.Scripts (toV2) +mkTypedValidator' :: Validator -> TypedValidator datum redeemer +mkTypedValidator' = TypedValidator . toV2 + -- | Create Plutus V2 typed validator mkTypedValidator :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> TypedValidator datum redeemer mkTypedValidator = TypedValidator . toV2 . mkValidatorScript From fc7e4e9b09d8d299908c944e27c9693280848a86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Sun, 13 Aug 2023 16:25:09 +0200 Subject: [PATCH 13/15] feat: add typed mp construction from mp --- src/Plutus/Model/Validator/V2.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Plutus/Model/Validator/V2.hs b/src/Plutus/Model/Validator/V2.hs index 818c50e..7dd3040 100644 --- a/src/Plutus/Model/Validator/V2.hs +++ b/src/Plutus/Model/Validator/V2.hs @@ -4,6 +4,7 @@ module Plutus.Model.Validator.V2( mkTypedValidator', mkUntypedValidator, mkTypedPolicy, + mkTypedPolicy', mkTypedStake, toBuiltinValidator, toBuiltinPolicy, @@ -29,6 +30,9 @@ mkTypedValidator = TypedValidator . toV2 . mkValidatorScript mkUntypedValidator :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> UntypedValidator mkUntypedValidator = UntypedValidator . toV2 . mkValidatorScript +mkTypedPolicy' :: MintingPolicy -> TypedPolicy redeemer +mkTypedPolicy' = TypedPolicy . toV2 + -- | Create Plutus V2 typed minting policy mkTypedPolicy :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> TypedPolicy redeemer mkTypedPolicy = TypedPolicy . toV2 . mkMintingPolicyScript From 4ca4cd3beee01c6ac9bb867e1c1654f2056273ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Sun, 28 Jan 2024 20:11:10 +0100 Subject: [PATCH 14/15] feat: `payToKeyDatum` now uses `HasAddress` --- src/Plutus/Model/Contract.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index 2f776a7..9cc23e3 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -339,10 +339,10 @@ fromDatumMode = \case -- build Tx -- | Pay to public key with datum -payToKeyDatum :: ToData a => PubKeyHash -> DatumMode a -> Value -> Tx +payToKeyDatum :: (ToData a, HasAddress pubKeyHash) => pubKeyHash -> DatumMode a -> Value -> Tx payToKeyDatum pkh dat val = toExtra $ mempty - { P.txOutputs = [TxOut (pubKeyHashAddress pkh) val outDatum Nothing] + { P.txOutputs = [TxOut (toAddress pkh) val outDatum Nothing] , P.txData = datumMap } where From 90c400168f80065de95e31bd4a221b7fe8cae9cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kristi=C3=A1n=20Balaj?= Date: Sat, 3 Feb 2024 12:50:40 +0100 Subject: [PATCH 15/15] feat: spendScript untyped changes --- src/Plutus/Model/Contract.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/Plutus/Model/Contract.hs b/src/Plutus/Model/Contract.hs index 9cc23e3..e516ae6 100644 --- a/src/Plutus/Model/Contract.hs +++ b/src/Plutus/Model/Contract.hs @@ -446,15 +446,18 @@ spendScript tv ref red dat = toExtra $ -- | Spend script input untyped. spendScriptUntyped :: - UntypedValidator -> + (HasValidator script, HasLanguage script) => + script -> TxOutRef -> Redeemer -> Datum -> Tx -spendScriptUntyped v ref red dat = toExtra $ +spendScriptUntyped script ref red dat = toExtra $ mempty - { P.txInputs = S.singleton $ Fork.TxIn ref (Just $ Fork.ConsumeScriptAddress (Just $ unUntypedValidator v) red dat) + { P.txInputs = S.singleton $ Fork.TxIn ref (Just $ Fork.ConsumeScriptAddress (Just validator) red dat) } + where + validator = Versioned (getLanguage script) ( toValidator script) -- | Spends script that references other script spendScriptRef :: @@ -477,8 +480,9 @@ spendScriptRef refScript script refOut red dat = toExtra $ -- | Spends script that references other script untyped version spendScriptRefUntyped :: + (HasValidator script, HasLanguage script) => TxOutRef -> - UntypedValidator -> + script -> TxOutRef -> Redeemer -> Datum ->