diff --git a/cabal.project b/cabal.project index ec52fc0..fa2d5d1 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING.adoc for how to update index-state index-state: - , hackage.haskell.org 2024-06-12T10:10:17Z - , cardano-haskell-packages 2024-06-12T10:10:17Z + , hackage.haskell.org 2024-09-26T12:18:58Z + , cardano-haskell-packages 2024-09-25T16:01:20Z packages: plutus-ledger plutus-script-utils @@ -45,14 +45,3 @@ package cardano-api optimization: False package cardano-crypto-praos flags: -external-libsodium-vrf - --- This is quickcheck-contractmodel's HEAD of the Conway branch: --- https://github.com/input-output-hk/quickcheck-contractmodel/tree/Conway -source-repository-package - type: git - location: https://github.com/input-output-hk/quickcheck-contractmodel - tag: b19a7689a0d40ba3c7f91da87ef5fbcf20f3926c - --sha256: sha256-ronNW9uJoleclzLjRJhDWdWd9Dso2XSnUl4m3/2eb2k= - subdir: - quickcheck-contractmodel - quickcheck-threatmodel diff --git a/cardano-node-emulator/cardano-node-emulator.cabal b/cardano-node-emulator/cardano-node-emulator.cabal index b2a68d0..55648e6 100644 --- a/cardano-node-emulator/cardano-node-emulator.cabal +++ b/cardano-node-emulator/cardano-node-emulator.cabal @@ -64,7 +64,7 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen, internal} ^>=8.46 + , cardano-api:{cardano-api, gen, internal} ^>=9.1 , cardano-crypto , cardano-ledger-alonzo , cardano-ledger-api @@ -138,7 +138,7 @@ test-suite cardano-node-emulator-test -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen, internal} ^>=8.46 + , cardano-api:{cardano-api, gen, internal} ^>=9.1 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 , plutus-tx-plugin >=1.0.0 diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs index 915dd6a..98d9787 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs @@ -63,10 +63,16 @@ module Cardano.Node.Emulator.Generators ( ) where import Cardano.Api qualified as C +import Cardano.Api.Ledger (StandardCrypto) import Cardano.Api.Shelley qualified as C import Cardano.Crypto.Wallet qualified as Crypto import Cardano.Ledger.Api.PParams (ppMaxCollateralInputsL) -import Cardano.Node.Emulator.Internal.Node.Params (Params (pSlotConfig), testnet) +import Cardano.Node.Emulator.Internal.Node.Params ( + Params (pSlotConfig), + defaultConfig, + paramsFromConfig, + testnet, + ) import Cardano.Node.Emulator.Internal.Node.TimeSlot (SlotConfig) import Cardano.Node.Emulator.Internal.Node.TimeSlot qualified as TimeSlot import Cardano.Node.Emulator.Internal.Node.Validation ( @@ -171,8 +177,8 @@ data Mockchain = Mockchain deriving (Show) -- | The empty mockchain. -emptyChain :: Mockchain -emptyChain = Mockchain [] Map.empty def +emptyChain :: Params -> Mockchain +emptyChain = Mockchain [] Map.empty {- | Generate a mockchain. @@ -180,11 +186,12 @@ emptyChain = Mockchain [] Map.empty def -} genMockchain' :: GeneratorModel + -> C.CardanoEra StandardCrypto -> Gen Mockchain -genMockchain' gm = do +genMockchain' gm era = do slotCfg <- genSlotConfig (txn, ot) <- genInitialTransaction gm - let params = def{pSlotConfig = slotCfg} + let params = (paramsFromConfig $ defaultConfig era){pSlotConfig = slotCfg} -- There is a problem that txId of emulator tx and tx of cardano tx are different. -- We convert the emulator tx to cardano tx here to get the correct transaction id -- because later we anyway will use the converted cardano tx so the utxo should match it. @@ -197,7 +204,7 @@ genMockchain' gm = do } -- | Generate a mockchain using the default 'GeneratorModel'. -genMockchain :: Gen Mockchain +genMockchain :: C.CardanoEra StandardCrypto -> Gen Mockchain genMockchain = genMockchain' generatorModel {- | A transaction with no inputs that mints some value (to be used at the diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Fee.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Fee.hs index bc8a068..2073922 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Fee.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Fee.hs @@ -21,7 +21,7 @@ module Cardano.Node.Emulator.Internal.Node.Fee ( import Cardano.Api qualified as C import Cardano.Api.Error qualified as C.Api -import Cardano.Api.Fees (mapTxScriptWitnesses) +import Cardano.Api.Fees () import Cardano.Api.Shelley qualified as C import Cardano.Api.Shelley qualified as C.Api import Cardano.Ledger.Api.PParams qualified as C @@ -90,28 +90,7 @@ fillTxExUnits params txUtxo buildTx@(CardanoBuildTx txBodyContent) = do Left (Map.mapKeys (C.toScriptIndex C.AlonzoEraOnwardsConway) . fmap (C.fromAlonzoExUnits . snd)) $ getTxExUnitsWithLogs params (CardanoAPI.fromPlutusIndex txUtxo) tmpTx' - bimap (Right . TxBodyError . C.Api.displayError) CardanoBuildTx $ - mapTxScriptWitnesses (mapWitness exUnitsMap') txBodyContent - where - mapWitness - :: Map.Map C.Api.ScriptWitnessIndex C.Api.ExecutionUnits - -> C.ScriptWitnessIndex - -> C.ScriptWitness witctx era - -> Either (C.TxBodyErrorAutoBalance era) (C.ScriptWitness witctx era) - mapWitness _ _ wit@C.SimpleScriptWitness{} = Right wit - mapWitness eum idx (C.PlutusScriptWitness langInEra version script datum redeemer _) = - case Map.lookup idx eum of - Nothing -> - Left $ C.TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap idx eum - Just exunits -> - Right $ - C.PlutusScriptWitness - langInEra - version - script - datum - redeemer - exunits + substituteExecutionUnits exUnitsMap' txBodyContent {- | Creates a balanced transaction by calculating the execution units, the fees and the change, which is assigned to the given address. Only balances Ada. diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Params.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Params.hs index 8b1d75c..c40fdbe 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Params.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Params.hs @@ -13,6 +13,7 @@ -- | The set of parameters, like protocol parameters and slot configuration. module Cardano.Node.Emulator.Internal.Node.Params ( Params (..), + defaultConfig, paramsFromConfig, C.mkLatestTransitionConfig, slotConfigL, @@ -20,7 +21,6 @@ module Cardano.Node.Emulator.Internal.Node.Params ( emulatorPParamsL, emulatorPParams, pProtocolParams, - pParamsFromProtocolParams, ledgerProtocolParameters, increaseTransactionLimits, increaseTransactionLimits', @@ -71,7 +71,6 @@ import Control.Lens (makeLensesFor, over, (%~), (&), (.~), (^.)) import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON)) import Data.Aeson qualified as JSON import Data.Aeson.Types (prependFailure, typeMismatch) -import Data.Default (Default (def)) import Data.Map qualified as Map import Data.Maybe (fromJust) import Data.Ratio ((%)) @@ -87,7 +86,7 @@ import Ledger.Test (testNetworkMagic, testnet) import Ouroboros.Consensus.Block (GenesisWindow (GenesisWindow)) import Ouroboros.Consensus.HardFork.History qualified as Ouroboros import Plutus.Script.Utils.Scripts (Language (PlutusV1)) -import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParams) +import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParamsForTesting) import PlutusLedgerApi.V1 (POSIXTime (POSIXTime, getPOSIXTime)) import Prettyprinter (Pretty (pretty), viaShow, vsep, (<+>)) @@ -125,9 +124,6 @@ makeLensesFor ] ''Params -instance Default Params where - def = paramsFromConfig defaultConfig - instance Pretty Params where pretty Params{..} = vsep @@ -140,11 +136,8 @@ instance Pretty Params where emulatorPParams :: Params -> PParams emulatorPParams = pEmulatorPParams -pProtocolParams :: Params -> C.ProtocolParameters -pProtocolParams p = C.fromLedgerPParams C.ShelleyBasedEraConway $ emulatorPParams p - -pParamsFromProtocolParams :: C.ProtocolParameters -> PParams -pParamsFromProtocolParams = either (error . show) id . C.toLedgerPParams C.ShelleyBasedEraConway +pProtocolParams :: Params -> PParams +pProtocolParams = emulatorPParams ledgerProtocolParameters :: Params -> C.LedgerProtocolParameters C.ConwayEra ledgerProtocolParameters = C.LedgerProtocolParameters . emulatorPParams @@ -168,11 +161,11 @@ increaseTransactionLimits' size steps mem = emulatorProtocolMajorVersion :: Version emulatorProtocolMajorVersion = natVersion @9 -defaultConfig :: TransitionConfig -defaultConfig = +defaultConfig :: C.CardanoEra StandardCrypto -> TransitionConfig +defaultConfig era = C.mkLatestTransitionConfig emulatorShelleyGenesisDefaults - emulatorAlonzoGenesisDefaults + (emulatorAlonzoGenesisDefaults era) emulatorConwayGenesisDefaults emulatorShelleyGenesisDefaults :: C.ShelleyGenesis StandardCrypto @@ -188,16 +181,18 @@ emulatorShelleyGenesisDefaults = & C.ppKeyDepositL .~ Coin 2_000_000 } -emulatorAlonzoGenesisDefaults :: C.AlonzoGenesis -emulatorAlonzoGenesisDefaults = - C.alonzoGenesisDefaults +emulatorAlonzoGenesisDefaults :: C.CardanoEra StandardCrypto -> C.AlonzoGenesis +emulatorAlonzoGenesisDefaults era = + (C.alonzoGenesisDefaults era) { C.agPrices = Prices (fromJust $ boundRational (577 % 10_000)) (fromJust $ boundRational (721 % 10_000_000)) , C.agMaxTxExUnits = ExUnits 14_000_000 10_000_000_000 , C.agCostModels = mkCostModels costModels } where - costModel lang = fromJust $ defaultCostModelParams >>= Alonzo.costModelFromMap lang . projectLangParams lang + costModel lang = + fromJust $ + defaultCostModelParamsForTesting >>= Alonzo.costModelFromMap lang . projectLangParams lang costModels = Map.fromList $ map (\lang -> (lang, costModel lang)) [minBound .. maxBound] projectLangParams lang m = Map.restrictKeys diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Validation.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Validation.hs index 42fcd29..58fb46b 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Validation.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Validation.hs @@ -253,14 +253,13 @@ constructValidated globals (C.Ledger.UtxoEnv _ pp _) st tx = Left errs -> throwError ( ApplyTxError - ( ( ConwayUtxowFailure - (Core.injectFailure (UtxosFailure (Core.injectFailure $ CollectErrors errs))) - ) + ( ConwayUtxowFailure + (Core.injectFailure (UtxosFailure (Core.injectFailure $ CollectErrors errs))) :| [] ) ) Right sLst -> - let scriptEvalResult = evalPlutusScripts @EmulatorEra tx sLst + let scriptEvalResult = evalPlutusScripts sLst vTx = AlonzoTx (view Core.bodyTxL tx) @@ -295,12 +294,14 @@ getTxExUnitsWithLogs :: Params -> UTxO EmulatorEra -> C.Tx C.ConwayEra -> Either P.ValidationErrorInPhase P.RedeemerReport getTxExUnitsWithLogs params utxo (C.ShelleyTx _ tx) = case evalTxExUnitsWithLogs (emulatorPParams params) tx utxo ei ss of - Left e -> Left . (P.Phase1,) . P.CardanoLedgerValidationError . Text.pack . show $ e - Right result -> traverse (either toCardanoLedgerError Right) result + result -> traverse (either toCardanoLedgerError Right) result where eg = emulatorGlobals params ss = systemStart eg ei = epochInfo eg + toCardanoLedgerError + :: TransactionScriptFailure EmulatorEra + -> Either (P.ValidationPhase, P.ValidationError) b toCardanoLedgerError (ValidationFailure _ (V1.CekError ce) logs _) = Left (P.Phase2, P.ScriptFailure (P.EvaluationError logs ("CekEvaluationFailure: " ++ show ce))) toCardanoLedgerError e = Left (P.Phase2, P.CardanoLedgerValidationError $ Text.pack $ show e) diff --git a/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal b/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal index 5a9d834..d25acc6 100644 --- a/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal +++ b/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal @@ -59,7 +59,7 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, internal} ^>=8.46 + , cardano-api:{cardano-api, internal} ^>=9.1 , cardano-ledger-api , cardano-ledger-byron , cardano-ledger-core:{cardano-ledger-core, testlib} diff --git a/flake.lock b/flake.lock index 8bbac91..3fd9756 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1719233847, - "narHash": "sha256-569bi4WS+xZek1JitRhDDUovdiGMRIXS65yicgg+i9I=", + "lastModified": 1722589833, + "narHash": "sha256-2buGzz1bHYZ+2pQ/CIP1RkmtyAt6OTem+IC4EsJdwU8=", "owner": "IntersectMBO", "repo": "cardano-haskell-packages", - "rev": "faab2780b99436e9b4bc953cc7c653d524dfd71d", + "rev": "e9da05ac39d5792029170fee1aaf3330a16ba9b0", "type": "github" }, "original": { diff --git a/plutus-ledger/plutus-ledger.cabal b/plutus-ledger/plutus-ledger.cabal index cbbb567..bbdd4f4 100644 --- a/plutus-ledger/plutus-ledger.cabal +++ b/plutus-ledger/plutus-ledger.cabal @@ -62,7 +62,6 @@ library Ledger.Blockchain Ledger.Builtins.Orphans Ledger.CardanoWallet - Ledger.Contexts.Orphans Ledger.Credential.Orphans Ledger.Crypto Ledger.Crypto.Orphans @@ -107,7 +106,7 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, internal} ^>=8.46 + , cardano-api:{cardano-api, internal} ^>=9.1 , cardano-binary , cardano-crypto , cardano-ledger-alonzo @@ -172,7 +171,7 @@ test-suite plutus-ledger-test -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} ^>=8.46 + , cardano-api:{cardano-api, gen} ^>=9.1 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 diff --git a/plutus-ledger/src/Ledger/Contexts/Orphans.hs b/plutus-ledger/src/Ledger/Contexts/Orphans.hs deleted file mode 100644 index fce7795..0000000 --- a/plutus-ledger/src/Ledger/Contexts/Orphans.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Ledger.Contexts.Orphans where - -import PlutusLedgerApi.V1.Contexts (ScriptPurpose (..)) - -deriving stock instance Ord ScriptPurpose diff --git a/plutus-ledger/src/Ledger/Test.hs b/plutus-ledger/src/Ledger/Test.hs index 3fddab3..f8879d5 100644 --- a/plutus-ledger/src/Ledger/Test.hs +++ b/plutus-ledger/src/Ledger/Test.hs @@ -22,11 +22,13 @@ import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 qualified as PV2 import PlutusLedgerApi.V3 qualified as PV3 import PlutusTx qualified +import PlutusTx.Prelude (BuiltinUnit, check) import Prelude hiding (not) someCode - :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ()) -someCode = $$(PlutusTx.compile [||\_ _ _ -> ()||]) + :: PlutusTx.CompiledCode + (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> BuiltinUnit) +someCode = $$(PlutusTx.compile [||\_ _ _ -> check True||]) someValidator :: Scripts.Validator someValidator = Ledger.mkValidatorScript someCode diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs index 86a1fdf..ed7aa6a 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs @@ -84,7 +84,7 @@ fromCardanoTxInsCollateral C.TxInsCollateralNone = [] fromCardanoTxInsCollateral (C.TxInsCollateral _ txIns) = txIns toCardanoDatumWitness :: Maybe PV1.Datum -> C.ScriptDatum C.WitCtxTxIn -toCardanoDatumWitness = maybe C.InlineScriptDatum (C.ScriptDatumForTxIn . toCardanoScriptData . PV1.getDatum) +toCardanoDatumWitness = maybe C.InlineScriptDatum (C.ScriptDatumForTxIn . Just . toCardanoScriptData . PV1.getDatum) type WitnessHeader witctx = C.ScriptDatum witctx -> C.ScriptRedeemer -> C.ExecutionUnits -> C.ScriptWitness witctx C.ConwayEra diff --git a/plutus-ledger/src/Ledger/Tx/Internal.hs b/plutus-ledger/src/Ledger/Tx/Internal.hs index 8efea48..81e634b 100644 --- a/plutus-ledger/src/Ledger/Tx/Internal.hs +++ b/plutus-ledger/src/Ledger/Tx/Internal.hs @@ -30,7 +30,6 @@ import Data.Map qualified as Map import GHC.Generics (Generic) import Ledger.Address (CardanoAddress, cardanoPubKeyHash) -import Ledger.Contexts.Orphans () import Ledger.Crypto import Ledger.DCert.Orphans () import Ledger.Tx.Orphans () @@ -216,4 +215,6 @@ emptyTxBodyContent = , txUpdateProposal = C.TxUpdateProposalNone , txProposalProcedures = Nothing , txVotingProcedures = Nothing + , txCurrentTreasuryValue = Nothing + , txTreasuryDonation = Nothing } diff --git a/plutus-ledger/src/Ledger/Value/Orphans.hs b/plutus-ledger/src/Ledger/Value/Orphans.hs index bac510c..c74dac8 100644 --- a/plutus-ledger/src/Ledger/Value/Orphans.hs +++ b/plutus-ledger/src/Ledger/Value/Orphans.hs @@ -115,7 +115,7 @@ instance (ToJSON v, ToJSON k) => ToJSON (Map.Map k v) where instance (FromJSON v, FromJSON k, PlutusTx.Eq k) => FromJSON (Map.Map k v) where parseJSON v = Map.safeFromList <$> JSON.parseJSON v -deriving anyclass instance (Hashable k, Hashable v) => Hashable (Map.Map k v) +deriving anyclass instance (Hashable k, Hashable v, Ord k) => Hashable (Map.Map k v) deriving anyclass instance (Serialise k, Serialise v) => Serialise (Map.Map k v) diff --git a/plutus-script-utils/plutus-script-utils.cabal b/plutus-script-utils/plutus-script-utils.cabal index 030ba03..7b15dc0 100644 --- a/plutus-script-utils/plutus-script-utils.cabal +++ b/plutus-script-utils/plutus-script-utils.cabal @@ -97,7 +97,7 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api ^>=8.46 + , cardano-api ^>=9.1 , cardano-ledger-core , plutus-core >=1.0.0 , plutus-ledger-api >=1.0.0 diff --git a/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs b/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs index 3d82348..8d9f02c 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs @@ -68,6 +68,7 @@ import PlutusTx (CompiledCode, makeLift) import PlutusTx qualified import PlutusTx.Builtins (BuiltinData) import PlutusTx.Builtins qualified as Builtins +import PlutusTx.Prelude (BuiltinUnit) import Prettyprinter (Pretty (pretty)) import Prettyprinter.Extras (PrettyShow (PrettyShow)) @@ -239,19 +240,20 @@ newtype StakeValidatorHash = StakeValidatorHash {getStakeValidatorHash :: Builti deriving stock (Generic) deriving newtype (Eq, Ord, PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) -mkValidatorScript :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> Validator +mkValidatorScript + :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit) -> Validator mkValidatorScript = Validator . Script . serialiseCompiledCode unValidatorScript :: Validator -> Script unValidatorScript = getValidator -mkMintingPolicyScript :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy +mkMintingPolicyScript :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinUnit) -> MintingPolicy mkMintingPolicyScript = MintingPolicy . Script . serialiseCompiledCode unMintingPolicyScript :: MintingPolicy -> Script unMintingPolicyScript = getMintingPolicy -mkStakeValidatorScript :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> StakeValidator +mkStakeValidatorScript :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinUnit) -> StakeValidator mkStakeValidatorScript = StakeValidator . Script . serialiseCompiledCode unStakeValidatorScript :: StakeValidator -> Script diff --git a/plutus-script-utils/src/Plutus/Script/Utils/Typed.hs b/plutus-script-utils/src/Plutus/Script/Utils/Typed.hs index 25c8a13..3bcf331 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/Typed.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/Typed.hs @@ -47,11 +47,11 @@ import PlutusLedgerApi.V1 qualified as PV1 import PlutusLedgerApi.V1.Address qualified as PV1 import PlutusLedgerApi.V2 qualified as PV2 import PlutusLedgerApi.V3 qualified as PV3 -import PlutusTx.Prelude (BuiltinData, BuiltinString, check, trace) +import PlutusTx.Prelude (BuiltinData, BuiltinString, BuiltinUnit, check, trace) -type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> () -type UntypedMintingPolicy = BuiltinData -> BuiltinData -> () -type UntypedStakeValidator = BuiltinData -> BuiltinData -> () +type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit +type UntypedMintingPolicy = BuiltinData -> BuiltinData -> BuiltinUnit +type UntypedStakeValidator = BuiltinData -> BuiltinData -> BuiltinUnit data Any deriving stock (Eq, Show, Generic) @@ -68,8 +68,8 @@ class ValidatorTypes (a :: Type) where type DatumType a :: Type -- Defaults - type RedeemerType a = () - type DatumType a = () + type RedeemerType a = BuiltinUnit + type DatumType a = BuiltinUnit instance ValidatorTypes Void where type RedeemerType Void = Void diff --git a/plutus-script-utils/src/Plutus/Script/Utils/V1/Generators.hs b/plutus-script-utils/src/Plutus/Script/Utils/V1/Generators.hs index 99cbb9d..0f77f82 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/V1/Generators.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/V1/Generators.hs @@ -13,15 +13,15 @@ module Plutus.Script.Utils.V1.Generators ( ) where import Plutus.Script.Utils.Scripts qualified as Ledger +import Plutus.Script.Utils.V1.Scripts qualified as Scripts import PlutusLedgerApi.V1.Value (TokenName, Value) import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx qualified - -import Plutus.Script.Utils.V1.Scripts qualified as Scripts +import PlutusTx.Prelude (check) alwaysSucceedValidator :: Ledger.Validator alwaysSucceedValidator = - Ledger.mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> ()||]) + Ledger.mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> check True||]) alwaysSucceedValidatorVersioned :: Ledger.Versioned Ledger.Validator alwaysSucceedValidatorVersioned = Ledger.Versioned alwaysSucceedValidator Ledger.PlutusV1 @@ -31,7 +31,7 @@ alwaysSucceedValidatorHash = Scripts.validatorHash alwaysSucceedValidator alwaysSucceedPolicy :: Ledger.MintingPolicy alwaysSucceedPolicy = - Ledger.mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> ()||]) + Ledger.mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> check True||]) alwaysSucceedPolicyVersioned :: Ledger.Versioned Ledger.MintingPolicy alwaysSucceedPolicyVersioned = Ledger.Versioned alwaysSucceedPolicy Ledger.PlutusV1 diff --git a/plutus-script-utils/src/Plutus/Script/Utils/V2/Generators.hs b/plutus-script-utils/src/Plutus/Script/Utils/V2/Generators.hs index c51d51a..9494343 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/V2/Generators.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/V2/Generators.hs @@ -20,14 +20,15 @@ import PlutusTx qualified import Plutus.Script.Utils.V1.Generators qualified as PV1 import Plutus.Script.Utils.V2.Scripts qualified as Scripts +import PlutusTx.Prelude (check) alwaysSucceedValidator :: Validator alwaysSucceedValidator = - mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> ()||]) + mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> check True||]) alwaysSucceedValidatorHash :: ValidatorHash alwaysSucceedValidatorHash = Scripts.validatorHash alwaysSucceedValidator alwaysSucceedPolicy :: MintingPolicy alwaysSucceedPolicy = - mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> ()||]) + mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> check True||]) diff --git a/plutus-script-utils/src/Plutus/Script/Utils/V3/Generators.hs b/plutus-script-utils/src/Plutus/Script/Utils/V3/Generators.hs index 7048848..edd3121 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/V3/Generators.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/V3/Generators.hs @@ -20,14 +20,15 @@ import PlutusTx qualified import Plutus.Script.Utils.V1.Generators qualified as PV1 import Plutus.Script.Utils.V3.Scripts qualified as Scripts +import PlutusTx.Prelude (check) alwaysSucceedValidator :: Validator alwaysSucceedValidator = - mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> ()||]) + mkValidatorScript $$(PlutusTx.compile [||\_ _ _ -> check True||]) alwaysSucceedValidatorHash :: ValidatorHash alwaysSucceedValidatorHash = Scripts.validatorHash alwaysSucceedValidator alwaysSucceedPolicy :: MintingPolicy alwaysSucceedPolicy = - mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> ()||]) + mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> check True||]) diff --git a/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/MonetaryPolicies.hs b/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/MonetaryPolicies.hs index ba3fc14..615ae90 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/MonetaryPolicies.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/MonetaryPolicies.hs @@ -26,11 +26,11 @@ import PlutusLedgerApi.V3 ( Address (Address, addressCredential), Credential (ScriptCredential), ScriptHash (ScriptHash), + ScriptInfo (MintingScript), txInInfoResolved, ) import PlutusLedgerApi.V3.Contexts ( - ScriptContext (ScriptContext, scriptContextPurpose, scriptContextTxInfo), - ScriptPurpose (Minting), + ScriptContext (ScriptContext, scriptContextScriptInfo, scriptContextTxInfo), TxInfo (TxInfo, txInfoInputs), ) import PlutusLedgerApi.V3.Contexts qualified as PV3 @@ -55,7 +55,7 @@ mkForwardingMintingPolicy vshsh = {-# INLINEABLE forwardToValidator #-} forwardToValidator :: ValidatorHash -> () -> PV3.ScriptContext -> Bool -forwardToValidator (ValidatorHash h) _ ScriptContext{scriptContextTxInfo = TxInfo{txInfoInputs}, scriptContextPurpose = Minting _} = +forwardToValidator (ValidatorHash h) _ ScriptContext{scriptContextTxInfo = TxInfo{txInfoInputs}, scriptContextScriptInfo = MintingScript _} = let checkHash TxOut{txOutAddress = Address{addressCredential = ScriptCredential (ScriptHash vh)}} = vh == h checkHash _ = False in any (checkHash . txInInfoResolved) txInfoInputs diff --git a/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/StakeValidators.hs b/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/StakeValidators.hs index e238827..21db0a0 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/StakeValidators.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/V3/Typed/Scripts/StakeValidators.hs @@ -26,11 +26,11 @@ import PlutusLedgerApi.V3 ( Address (Address, addressCredential), Credential (ScriptCredential), ScriptHash (ScriptHash), + ScriptInfo (CertifyingScript, RewardingScript), txInInfoResolved, ) import PlutusLedgerApi.V3.Contexts ( - ScriptContext (ScriptContext, scriptContextPurpose, scriptContextTxInfo), - ScriptPurpose (Certifying, Rewarding), + ScriptContext (ScriptContext, scriptContextScriptInfo, scriptContextTxInfo), TxInfo (TxInfo, txInfoInputs), ) import PlutusTx qualified @@ -54,11 +54,11 @@ mkForwardingStakeValidator vshsh = {-# INLINEABLE forwardToValidator #-} forwardToValidator :: ValidatorHash -> () -> ScriptContext -> Bool -forwardToValidator (ValidatorHash h) _ ScriptContext{scriptContextTxInfo = TxInfo{txInfoInputs}, scriptContextPurpose} = +forwardToValidator (ValidatorHash h) _ ScriptContext{scriptContextTxInfo = TxInfo{txInfoInputs}, scriptContextScriptInfo} = let checkHash TxOut{txOutAddress = Address{addressCredential = ScriptCredential (ScriptHash vh)}} = vh == h checkHash _ = False result = any (checkHash . txInInfoResolved) txInfoInputs - in case scriptContextPurpose of - Rewarding _ -> result - Certifying _ _ -> result + in case scriptContextScriptInfo of + RewardingScript _ -> result + CertifyingScript _ _ -> result _ -> False