diff --git a/CONTRIBUTING.adoc b/CONTRIBUTING.adoc index 65340a66ae..6d43815443 100644 --- a/CONTRIBUTING.adoc +++ b/CONTRIBUTING.adoc @@ -211,6 +211,39 @@ Specifically, you will probably want to say `nix flake lock --update-input 2, the following packages have a -- too restictive upper bounds on aeson, so we relax them here. The hackage @@ -58,42 +58,42 @@ allow-newer: , servant:aeson , servant-client-core:aeson , servant-server:aeson + , persistent:aeson , servant-foreign:lens , blockfrost-api:lens + , plutus-core:dependent-sum-template + , docopt:template-haskell + , *:vector + -- temporary + , cardano-wallet:cardano-api + , cardano-testnet:cardano-api + , ouroboros-consensus-byron:* -constraints: - -- cardano-prelude-0.1.0.0 needs - , protolude <0.3.1 - - -- cardano-ledger-byron-0.1.0.0 needs - , cardano-binary <1.5.0.1 - - -- plutus-core-1.0.0.1 needs - , cardano-crypto-class >2.0.0.0 - , algebraic-graphs <0.7 - - -- cardano-ledger-core-0.1.0.0 needs - , cardano-crypto-class <2.0.0.1 - - -- cardano-crypto-class-2.0.0.0.1 needs - , cardano-prelude <0.1.0.1 - - -- dbvar from cardano-wallet needs - , io-classes <0.3.0.0 - - -- newer typed-protocols need io-classes>=0.3.0.0 which is incompatible with dbvar's constraint above - , typed-protocols==0.1.0.0 - - , aeson >= 2 - - , hedgehog >= 1.1 +allow-older: + strict-containers:binary,containers - , resource-pool <0.4.0.0 - - , http2 <4.0.0 - - -- ouroboros-consensus-shelley-0.1.0.1 needs - , ouroboros-consensus-protocol==0.1.0.1 +constraints: + dependent-sum-template >= 0.2 + , quickcheck-contractmodel >= 0.1.5.0 + , quickcheck-threatmodel >= 1.1.0 + , docopt >= 0.7.0.7 + , strict-containers ^>= 0.2, + plutus-tx >= 1.5.0 && < 1.6, + cardano-api >= 8.2.0 && < 8.3, + cardano-strict-containers >= 0.1.2 && < 0.2, + cardano-slotting >= 0.1.1 && < 0.2, + cardano-ledger-binary >= 1.1.1 && < 1.2, + cardano-ledger-allegra >= 1.1.1 && < 1.2, + cardano-ledger-core >= 1.2.0 && < 1.3, + cardano-ledger-shelley >= 1.2.0 && < 1.3, + cardano-ledger-alonzo >= 1.2.1 && < 1.3, + cardano-ledger-api >= 1.2.0 && < 1.3, + cardano-ledger-babbage >= 1.2.1 && < 1.3, + ouroboros-consensus >= 0.7.0 && < 0.8, + ouroboros-consensus-cardano >= 0.6.0 && < 0.7, + + optparse-applicative-fork < 0.18, + optparse-applicative < 0.18 -- The plugin will typically fail when producing Haddock documentation. However, -- in this instance you can simply tell it to defer any errors to runtime (which @@ -116,8 +116,6 @@ package plutus-contract-model -- For dev work we don't care about performance so much, so this is okay. package cardano-ledger-alonzo optimization: False -package ouroboros-consensus-shelley - optimization: False package ouroboros-consensus-cardano optimization: False package cardano-api @@ -130,83 +128,42 @@ package cardano-wallet-cli optimization: False package cardano-wallet-launcher optimization: False -package cardano-wallet-core-integration - optimization: False --- Direct dependency. --- Compared to others, cardano-wallet doesn't bump dependencies very often. --- Making it a good place to start when bumping dependencies. --- As, for example, bumping the node first highly risks breaking API with the wallet. --- Unless early bug fixes are required, this is fine as the wallet tracks stable releases of the node. --- And it is indeed nice for plutus-apps to track stable releases of the node too. --- --- The current version is dated 2022/08/10 source-repository-package type: git location: https://github.com/input-output-hk/cardano-wallet - tag: 18a931648550246695c790578d4a55ee2f10463e + tag: 3f0d2f3abe706958fab8cdc528184068bd0453c9 + --sha256: 1xbr5qrz716mh3vhng64m4v6zhp03x5lcf0kld5mmm1yij0fadwa subdir: - lib/cli - lib/core - lib/core-integration - lib/dbvar + lib/balance-tx + lib/coin-selection + lib/delta-store + lib/delta-table + lib/delta-types lib/launcher lib/numeric - lib/shelley - lib/strict-non-empty-containers + lib/primitive lib/test-utils lib/text-class + lib/wai-middleware-logging + lib/wallet + lib/wallet-benchmarks -- Should follow cardano-wallet. source-repository-package type: git location: https://github.com/input-output-hk/cardano-addresses - tag: b7273a5d3c21f1a003595ebf1e1f79c28cd72513 + tag: 6b55f96d57a181f898eb2a50531d3ae4280c549c + --sha256: 0yygam995i3mawk6hfgxb6v918phvqzyipzhjflff0l6zfrldy7f subdir: - -- cardano-addresses-cli command-line - -- cardano-addresses core --- This is needed because we rely on an unreleased branch of --- cardano-ledger-alonzo. The feature we need --- (evaluateTransactionExecutionUnitsWithLogs) in only included from --- cardano-ledger-alonzo version 1.0.0.0 --- See https://github.com/input-output-hk/cardano-ledger/pull/3111 -source-repository-package - type: git - location: https://github.com/input-output-hk/cardano-ledger - tag: da3e9ae10cf9ef0b805a046c84745f06643583c2 - subdir: - eras/alonzo/impl - eras/alonzo/test-suite - eras/babbage/impl - eras/babbage/test-suite - eras/byron/chain/executable-spec - eras/byron/crypto - eras/byron/crypto/test - eras/byron/ledger/executable-spec - eras/byron/ledger/impl - eras/byron/ledger/impl/test - eras/shelley/impl - eras/shelley/test-suite - eras/shelley-ma/impl - eras/shelley-ma/test-suite - libs/cardano-ledger-core - libs/cardano-ledger-pretty - libs/cardano-protocol-tpraos - libs/cardano-data - libs/vector-map - libs/set-algebra - libs/small-steps - libs/small-steps-test - libs/non-integral - source-repository-package type: git - location: https://github.com/input-output-hk/marconi - tag: 7285a3bc1ae53bf672c7cc2359210c6c29fbce44 + location: https://github.com/input-output-hk/quickcheck-contractmodel + tag: 268e3efccbc851912b1859a0dca977e39e3a6878 + --sha256: sha256-jOQvqhOj1huYTkl7K+f0UHlQuVL+bv/Ab4+c4l3ZCiw= subdir: - cardano-streaming - marconi-chain-index - marconi-core + quickcheck-contractmodel + quickcheck-threatmodel diff --git a/cardano-node-emulator/cardano-node-emulator.cabal b/cardano-node-emulator/cardano-node-emulator.cabal index 86a8d28ce1..ed1f0a97e4 100644 --- a/cardano-node-emulator/cardano-node-emulator.cabal +++ b/cardano-node-emulator/cardano-node-emulator.cabal @@ -45,36 +45,40 @@ library -- Local components -------------------- build-depends: - , freer-extras >=1.2.0 - , plutus-ledger >=1.2.0 + , freer-extras >=1.2.0 + , plutus-ledger >=1.2.0 + , plutus-script-utils >=1.2.0 -------------------------- -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} >=1.35 + , cardano-api:{cardano-api, gen} ^>=8.2 , cardano-crypto + , cardano-ledger-allegra , cardano-ledger-alonzo + , cardano-ledger-api , cardano-ledger-babbage , cardano-ledger-core + , cardano-ledger-mary , cardano-ledger-shelley - , cardano-ledger-shelley-ma , cardano-slotting - , mtl , ouroboros-consensus , plutus-core >=1.0.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 - , quickcheck-contractmodel >=0.1.4.0 + + -- , quickcheck-contractmodel >=0.1.4.0 ------------------------ -- Non-IOG dependencies ------------------------ build-depends: - , aeson >=2 + , aeson >=2 , array - , base >=4.9 && <5 + , base >=4.9 && <5 , bytestring + , cardano-strict-containers , containers , data-default , either @@ -82,11 +86,11 @@ library , hedgehog , lens , mtl - , prettyprinter >=1.1.0.1 + , prettyprinter >=1.1.0.1 , QuickCheck + , quickcheck-contractmodel , quickcheck-dynamic , serialise - , strict-containers , text , time diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs index b5a536ef0b..8c5fd272cf 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs @@ -80,26 +80,26 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.String (fromString) import GHC.Stack (HasCallStack) -import Gen.Cardano.Api.Typed qualified as Gen import Hedgehog (Gen, MonadGen, MonadTest, Range) import Hedgehog qualified as H import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import Ledger (CardanoTx (CardanoEmulatorEraTx), Interval, MintingPolicy (getMintingPolicy), - POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase), - PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange, TxOut, - ValidationErrorInPhase, ValidationPhase (Phase1, Phase2), ValidationResult (FailPhase1, FailPhase2), - addCardanoTxSignature, createGenesisTransaction, minLovelaceTxOutEstimated, pubKeyAddress, txOutValue) +import Ledger (CardanoTx (CardanoEmulatorEraTx), Interval, POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, + Passphrase (Passphrase), PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange, + TxOut, ValidationErrorInPhase, ValidationPhase (Phase1, Phase2), + ValidationResult (FailPhase1, FailPhase2), addCardanoTxSignature, createGenesisTransaction, + minLovelaceTxOutEstimated, pubKeyAddress, txOutValue) import Ledger.CardanoWallet qualified as CW +import Ledger.Scripts qualified as Script import Ledger.Tx qualified as Tx -import Ledger.Tx.CardanoAPI (ToCardanoError, fromCardanoPlutusScript) +import Ledger.Tx.CardanoAPI (ToCardanoError) import Ledger.Tx.CardanoAPI qualified as C hiding (makeTransactionBody) import Ledger.Value.CardanoAPI qualified as Value import Numeric.Natural (Natural) -import Plutus.V1.Ledger.Api qualified as V1 -import Plutus.V1.Ledger.Interval qualified as Interval -import Plutus.V1.Ledger.Scripts qualified as Script +import PlutusLedgerApi.V1 qualified as V1 +import PlutusLedgerApi.V1.Interval qualified as Interval import PlutusTx (toData) +import Test.Gen.Cardano.Api.Typed qualified as Gen -- | Attach signatures of all known private keys to a transaction. signAll :: CardanoTx -> CardanoTx @@ -222,7 +222,7 @@ makeTx => C.TxBodyContent C.BuildTx C.BabbageEra -> m CardanoTx makeTx bodyContent = do - txBody <- either (fail . ("makeTx: Can't create TxBody: " <>) . show) pure $ C.makeTransactionBody bodyContent + txBody <- either (fail . ("makeTx: Can't create TxBody: " <>) . show) pure $ C.createAndValidateTransactionBody bodyContent pure $ signAll $ CardanoEmulatorEraTx $ C.Tx txBody [] -- | Generate a valid transaction, using the unspent outputs provided. @@ -273,13 +273,11 @@ genValidTransactionBodySpending' g ins totalVal = do let txOutputs = either (fail . ("Cannot create outputs: " <>) . show) id $ traverse (\(v, ppk) -> pubKeyTxOut v ppk Nothing) $ zip outVals pubKeys - mintWitness <- failOnCardanoError $ C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 - <$> (C.PScript <$> C.toCardanoPlutusScript - (C.AsPlutusScript C.AsPlutusScriptV2) - (getMintingPolicy alwaysSucceedPolicy)) - <*> pure C.NoScriptDatumForMint - <*> pure (C.fromPlutusData $ toData Script.unitRedeemer) - <*> pure C.zeroExecutionUnits + let mintWitness = C.PlutusScriptWitness C.PlutusScriptV1InBabbage C.PlutusScriptV1 + (C.PScript $ C.examplePlutusScriptAlwaysSucceeds C.WitCtxMint) + C.NoScriptDatumForMint + (C.unsafeHashableScriptData $ C.fromPlutusData $ toData Script.unitRedeemer) + C.zeroExecutionUnits let txMintValue = C.TxMintValue C.MultiAssetInBabbageEra (fromMaybe mempty mintValue) (C.BuildTxWith (Map.singleton alwaysSucceedPolicyId mintWitness)) txIns = map (, C.BuildTxWith $ C.KeyWitness C.KeyWitnessForSpending) ins @@ -436,7 +434,7 @@ genPassphrase = Passphrase <$> Gen.utf8 (Range.singleton 16) Gen.unicode alwaysSucceedPolicy :: Script.MintingPolicy -alwaysSucceedPolicy = Script.MintingPolicy (fromCardanoPlutusScript $ C.examplePlutusScriptAlwaysSucceeds C.WitCtxMint) +alwaysSucceedPolicy = Script.MintingPolicy (C.fromCardanoPlutusScript $ C.examplePlutusScriptAlwaysSucceeds C.WitCtxMint) alwaysSucceedPolicyId :: C.PolicyId alwaysSucceedPolicyId = C.scriptPolicyId (C.PlutusScript C.PlutusScriptV1 $ C.examplePlutusScriptAlwaysSucceeds C.WitCtxMint) diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Chain.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Chain.hs index b65fcd760d..2c9a8389f0 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Chain.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Chain.hs @@ -33,7 +33,7 @@ import GHC.Generics (Generic) import Ledger (Block, Blockchain, CardanoTx, OnChainTx, Slot (Slot), getCardanoTxId, getCardanoTxValidityRange, unOnChain) import Ledger.Index qualified as Index -import Ledger.Interval qualified as Interval +import PlutusLedgerApi.V1.Interval qualified as Interval import Prettyprinter (Pretty (pretty), vsep, (<+>)) -- | Events produced by the blockchain emulator. 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 965b991de6..9e7708ec6c 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 @@ -19,10 +19,8 @@ module Cardano.Node.Emulator.Internal.Node.Fee( import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Cardano.Api.Shelley qualified as C.Api -import Cardano.Ledger.BaseTypes (Globals (systemStart)) -import Cardano.Ledger.Core qualified as C.Ledger (Tx) -import Cardano.Ledger.Shelley.API qualified as C.Ledger hiding (Tx) -import Cardano.Node.Emulator.Internal.Node.Params (EmulatorEra, PParams, Params (emulatorPParams), emulatorEraHistory, +import Cardano.Ledger.BaseTypes (Globals (systemStart), epochInfo) +import Cardano.Node.Emulator.Internal.Node.Params (EmulatorEra, Params (emulatorPParams), bundledProtocolParameters, emulatorGlobals, pProtocolParams) import Cardano.Node.Emulator.Internal.Node.Validation (CardanoLedgerError, UTxO (UTxO), makeTransactionBody) import Control.Arrow ((&&&)) @@ -40,20 +38,19 @@ import Ledger.Index (UtxoIndex, ValidationError (MaxCollateralInputsExceeded, Tx ValidationPhase (Phase1), adjustTxOut, minAdaTxOutEstimated) import Ledger.Tx (ToCardanoError (TxBodyError), TxOut) import Ledger.Tx qualified as Tx -import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), fromPlutusIndex, getCardanoBuildTx, toCardanoFee, +import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), getCardanoBuildTx, toCardanoFee, toCardanoReturnCollateral, toCardanoTotalCollateral) import Ledger.Tx.CardanoAPI qualified as CardanoAPI import Ledger.Value.CardanoAPI (isZero, lovelaceToValue, split, valueGeq) estimateCardanoBuildTxFee :: Params - -> UTxO EmulatorEra -> CardanoBuildTx -> Either CardanoLedgerError C.Lovelace -estimateCardanoBuildTxFee params utxo txBodyContent = do +estimateCardanoBuildTxFee params txBodyContent = do let nkeys = C.Api.estimateTransactionKeyWitnessCount (getCardanoBuildTx txBodyContent) - txBody <- makeTransactionBody params utxo txBodyContent - pure $ evaluateTransactionFee (emulatorPParams params) txBody nkeys + txBody <- makeTransactionBody txBodyContent + pure $ evaluateTransactionFee (bundledProtocolParameters params) txBody nkeys -- | Creates a balanced transaction by calculating the execution units, the fees and the change, -- which is assigned to the given address. Only balances Ada. @@ -65,7 +62,7 @@ makeAutoBalancedTransaction -> Either CardanoLedgerError (C.Api.Tx C.Api.BabbageEra) makeAutoBalancedTransaction params utxo (CardanoBuildTx txBodyContent) cChangeAddr = first Right $ do -- Compute the change. - C.Api.BalancedTxBody _ change _ <- first (TxBodyError . C.Api.displayError) $ balance [] + C.Api.BalancedTxBody _ _ change _ <- first (TxBodyError . C.Api.displayError) $ balance [] let -- Recompute execution units with full set of UTxOs, including change. trial = balance [change] @@ -76,18 +73,19 @@ makeAutoBalancedTransaction params utxo (CardanoBuildTx txBodyContent) cChangeAd C.Api.TxOut addr (C.Api.TxOutValue vtype $ value <> lovelaceToValue delta) datum _referenceScript _ -> change -- Construct the body with correct execution units and fees. - C.Api.BalancedTxBody txBody _ _ <- first (TxBodyError . C.Api.displayError) $ balance [change'] + C.Api.BalancedTxBody _ txBody _ _ <- first (TxBodyError . C.Api.displayError) $ balance [change'] pure $ C.Api.makeSignedTransaction [] txBody where - eh = emulatorEraHistory params - ss = systemStart $ emulatorGlobals params + globals = emulatorGlobals params + ei = C.Api.LedgerEpochInfo $ epochInfo globals + ss = systemStart globals utxo' = fromLedgerUTxO utxo balance extraOuts = C.Api.makeTransactionBodyAutoBalance - C.Api.BabbageEraInCardanoMode ss - eh + ei (pProtocolParams params) mempty + mempty utxo' txBodyContent { C.Api.txOuts = C.Api.txOuts txBodyContent ++ extraOuts } cChangeAddr @@ -117,11 +115,10 @@ makeAutoBalancedTransactionWithUtxoProvider params txUtxo cChangeAddr utxoProvid calcFee n fee = do - (txBodyContent, extraUtxos) <- handleBalanceTx params txUtxo cChangeAddr utxoProvider errorReporter fee unbalancedBodyContent + (txBodyContent, _) <- handleBalanceTx params txUtxo cChangeAddr utxoProvider errorReporter fee unbalancedBodyContent newFee <- either errorReporter pure $ do - let cUtxo = fromPlutusIndex $ txUtxo <> extraUtxos - estimateCardanoBuildTxFee params cUtxo (CardanoBuildTx txBodyContent) + estimateCardanoBuildTxFee params (CardanoBuildTx txBodyContent) if newFee /= fee then if n == (0 :: Int) @@ -132,11 +129,10 @@ makeAutoBalancedTransactionWithUtxoProvider params txUtxo cChangeAddr utxoProvid theFee <- calcFee 5 initialFeeEstimate - (txBodyContent, extraUtxos) <- handleBalanceTx params txUtxo cChangeAddr utxoProvider errorReporter theFee unbalancedBodyContent + (txBodyContent, _) <- handleBalanceTx params txUtxo cChangeAddr utxoProvider errorReporter theFee unbalancedBodyContent either errorReporter pure $ do - let cUtxo = fromPlutusIndex $ txUtxo <> extraUtxos - C.makeSignedTransaction [] <$> makeTransactionBody params cUtxo (CardanoBuildTx txBodyContent) + C.makeSignedTransaction [] <$> makeTransactionBody (CardanoBuildTx txBodyContent) -- | Balance an unbalanced transaction by adding missing inputs and outputs handleBalanceTx @@ -351,9 +347,5 @@ fromLedgerUTxO (UTxO utxo) = $ utxo -- Adapted from cardano-api Cardano.API.Fee to avoid PParams conversion -evaluateTransactionFee :: PParams -> C.Api.TxBody C.Api.BabbageEra -> Word -> C.Api.Lovelace -evaluateTransactionFee pparams txbody keywitcount = case C.Api.makeSignedTransaction [] txbody of - C.Api.ShelleyTx _ tx -> evalShelleyBasedEra tx - where - evalShelleyBasedEra :: C.Ledger.Tx (C.Api.ShelleyLedgerEra C.Api.BabbageEra) -> C.Api.Lovelace - evalShelleyBasedEra tx = C.Api.fromShelleyLovelace $ C.Ledger.evaluateTransactionFee pparams tx keywitcount +evaluateTransactionFee :: C.BundledProtocolParameters C.Api.BabbageEra -> C.Api.TxBody C.Api.BabbageEra -> Word -> C.Api.Lovelace +evaluateTransactionFee params txbody keywitcount = C.evaluateTransactionFee params txbody keywitcount 0 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 3efe7ab91d..7d02886021 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 @@ -5,14 +5,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE TupleSections #-} -- | The set of parameters, like protocol parameters and slot configuration. module Cardano.Node.Emulator.Internal.Node.Params ( Params(..), paramsWithProtocolsParameters, slotConfigL, emulatorPParamsL, - pParamsFromProtocolParams, pProtocolParams, + pParamsFromProtocolParams, + bundledProtocolParameters, protocolParamsL, networkIdL, increaseTransactionLimits, @@ -30,10 +32,12 @@ module Cardano.Node.Emulator.Internal.Node.Params ( import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C +import Cardano.Ledger.Alonzo.PParams qualified as C +import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo import Cardano.Ledger.Babbage (BabbageEra) -import Cardano.Ledger.Babbage.PParams (retractPP) import Cardano.Ledger.Babbage.PParams qualified as C import Cardano.Ledger.BaseTypes (boundRational) +import Cardano.Ledger.Core qualified as C import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Shelley.API (Coin (Coin), Globals, ShelleyGenesis, mkShelleyGlobals) import Cardano.Ledger.Shelley.API qualified as C.Ledger @@ -47,17 +51,18 @@ import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), (.:), import Data.Aeson qualified as JSON import Data.Aeson.Types (prependFailure, typeMismatch) import Data.Default (Default (def)) -import Data.Map (fromList) -import Data.Maybe (fromMaybe) +import Data.Map qualified as Map +import Data.Maybe (fromJust, fromMaybe) import Data.Ratio ((%)) +import Data.SOP.Counting qualified as Ouroboros import Data.SOP.Strict (K (K), NP (Nil, (:*))) import GHC.Generics (Generic) import GHC.Natural (Natural) import Ledger.Test (testnet) import Ouroboros.Consensus.HardFork.History qualified as Ouroboros -import Ouroboros.Consensus.Util.Counting qualified as Ouroboros -import Plutus.V1.Ledger.Api (POSIXTime (POSIXTime)) -import PlutusCore (defaultCostModelParams) +import Plutus.Script.Utils.Scripts (Language (PlutusV3)) +import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParams) +import PlutusLedgerApi.V1 (POSIXTime (POSIXTime)) import Prettyprinter (Pretty (pretty), viaShow, vsep, (<+>)) -- | The default era for the emulator @@ -94,7 +99,13 @@ pProtocolParams :: Params -> C.ProtocolParameters pProtocolParams p = C.fromLedgerPParams C.ShelleyBasedEraBabbage $ emulatorPParams p pParamsFromProtocolParams :: C.ProtocolParameters -> PParams -pParamsFromProtocolParams = C.toLedgerPParams C.ShelleyBasedEraBabbage +pParamsFromProtocolParams = either (error . show) id . C.toLedgerPParams C.ShelleyBasedEraBabbage + +bundledProtocolParameters :: Params -> C.BundledProtocolParameters C.BabbageEra +bundledProtocolParameters params = C.BundleAsShelleyBasedProtocolParameters + C.ShelleyBasedEraBabbage + (pProtocolParams params) + (emulatorPParams params) paramsWithProtocolsParameters :: SlotConfig -> C.ProtocolParameters -> C.NetworkId -> Params paramsWithProtocolsParameters sc p = Params sc (pParamsFromProtocolParams p) @@ -114,7 +125,7 @@ instance ToJSON Params where instance FromJSON Params where parseJSON (Object v) = Params <$> (v .: "pSlotConfig" >>= parseJSON) - <*> (C.toLedgerPParams C.ShelleyBasedEraBabbage <$> (v .: "pProtocolParams" >>= parseJSON)) + <*> (pParamsFromProtocolParams <$> (v .: "pProtocolParams" >>= parseJSON)) <*> (v .: "pNetworkId" >>= parseJSON) parseJSON _ = fail "Can't parse a Param" @@ -163,9 +174,10 @@ instance Default C.ProtocolParameters where , protocolParamMonetaryExpansion = 3 % 1000 , protocolParamTreasuryCut = 1 % 5 , protocolParamUTxOCostPerWord = Nothing -- Obsolete from babbage onwards - , protocolParamCostModels = fromList - [ (C.AnyPlutusScriptVersion C.PlutusScriptV1, C.CostModel $ fromMaybe (error "Ledger.Params: defaultCostModelParams is broken") defaultCostModelParams) - , (C.AnyPlutusScriptVersion C.PlutusScriptV2, C.CostModel $ fromMaybe (error "Ledger.Params: defaultCostModelParams is broken") defaultCostModelParams) ] + , protocolParamCostModels = + let costModel = fromJust $ defaultCostModelParams >>= Alonzo.costModelFromMap PlutusV3 + costModels = Map.fromList $ map (, costModel) [minBound .. maxBound] + in C.fromAlonzoCostModels $ Alonzo.CostModels costModels mempty mempty , protocolParamPrices = Just (C.ExecutionUnitPrices {priceExecutionSteps = 721 % 10000000, priceExecutionMemory = 577 % 10000}) , protocolParamMaxTxExUnits = Just (C.ExecutionUnits {executionSteps = 10000000000, executionMemory = 14000000}) , protocolParamMaxBlockExUnits = Just (C.ExecutionUnits {executionSteps = 40000000000, executionMemory = 62000000}) @@ -192,14 +204,18 @@ emulatorGlobals :: Params -> Globals emulatorGlobals params = mkShelleyGlobals (genesisDefaultsFromParams params) (fixedEpochInfo emulatorEpochSize (slotLength params)) - (fst $ C.protocolParamProtocolVersion $ pProtocolParams params) + (toEnum $ fromIntegral $ fst $ C.protocolParamProtocolVersion $ pProtocolParams params) -genesisDefaultsFromParams :: Params -> ShelleyGenesis EmulatorEra +genesisDefaultsFromParams :: Params -> ShelleyGenesis StandardCrypto genesisDefaultsFromParams params@Params { pSlotConfig, pNetworkId } = C.shelleyGenesisDefaults { C.sgSystemStart = posixTimeToUTCTime $ scSlotZeroTime pSlotConfig , C.sgNetworkMagic = case pNetworkId of C.Testnet (C.NetworkMagic nm) -> nm; _ -> 0 , C.sgNetworkId = case pNetworkId of C.Testnet _ -> C.Ledger.Testnet; C.Mainnet -> C.Ledger.Mainnet - , C.sgProtocolParams = retractPP (Coin 0) d C.Ledger.NeutralNonce $ emulatorPParams params + , C.sgProtocolParams = emulatorPParams params + & C.downgradePParams (C.DowngradeBabbagePParams d C.Ledger.NeutralNonce) + & C.downgradePParams (C.DowngradeAlonzoPParams (Coin 0)) + & C.downgradePParams () + & C.downgradePParams () } where d = fromMaybe (error "3 % 5 should be valid UnitInterval") $ boundRational (3 % 5) @@ -209,4 +225,4 @@ emulatorEraHistory :: Params -> C.EraHistory C.CardanoMode emulatorEraHistory params = C.EraHistory C.CardanoMode (Ouroboros.mkInterpreter $ Ouroboros.summaryWithExactly list) where one = Ouroboros.nonEmptyHead $ Ouroboros.getSummary $ Ouroboros.neverForksSummary emulatorEpochSize (slotLength params) - list = Ouroboros.Exactly $ K one :* K one :* K one :* K one :* K one :* K one :* Nil + list = Ouroboros.Exactly $ K one :* K one :* K one :* K one :* K one :* K one :* K one :* Nil diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/TimeSlot.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/TimeSlot.hs index 2dd55c9eba..208942c913 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/TimeSlot.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/TimeSlot.hs @@ -33,9 +33,9 @@ import Data.Time.Clock.POSIX qualified as Time import GHC.Generics (Generic) import Ledger.Orphans () import Ledger.Slot (Slot (Slot), SlotRange) -import Plutus.V1.Ledger.Interval (Extended (Finite), Interval (Interval), LowerBound (LowerBound), - UpperBound (UpperBound), interval, member) -import Plutus.V1.Ledger.Time (POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange) +import PlutusLedgerApi.V1.Interval (Extended (Finite), Interval (Interval), LowerBound (LowerBound), + UpperBound (UpperBound), interval, member) +import PlutusLedgerApi.V1.Time (POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange) import PlutusTx.Lift (makeLift) import PlutusTx.Prelude (Integer, divide, fmap, ($), (*), (+), (-), (.)) import Prelude (Eq, IO, Show, (<$>)) 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 e2680ac009..2b61e4cc58 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 @@ -37,47 +37,39 @@ module Cardano.Node.Emulator.Internal.Node.Validation ( ) where import Cardano.Api.Shelley qualified as C -import Cardano.Ledger.Alonzo.PlutusScriptApi (collectTwoPhaseScriptInputs, evalScripts) -import Cardano.Ledger.Alonzo.Rules.Utxos (UtxosPredicateFailure (CollectErrors)) -import Cardano.Ledger.Alonzo.Scripts (CostModels, Script, unCostModels) -import Cardano.Ledger.Alonzo.Tools qualified as C.Ledger -import Cardano.Ledger.Alonzo.Tx (IsValid (IsValid), ValidatedTx (ValidatedTx)) +import Cardano.Ledger.Alonzo.PlutusScriptApi (CollectError, collectTwoPhaseScriptInputs, evalScripts) +import Cardano.Ledger.Alonzo.Scripts (AlonzoScript) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (AlonzoTx), IsValid (IsValid)) import Cardano.Ledger.Alonzo.TxInfo (ExtendedUTxO, ScriptResult (Fails, Passes)) -import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo -import Cardano.Ledger.Babbage.PParams (PParams' (_costmdls, _maxTxExUnits, _protocolVersion)) -import Cardano.Ledger.BaseTypes (Globals (systemStart), ProtVer, epochInfo) +import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded) +import Cardano.Ledger.Api.PParams (AlonzoEraPParams, ppProtocolVersionL) +import Cardano.Ledger.Api.Tx (AlonzoEraTxWits, MaryEraTxBody, TransactionScriptFailure (ValidationFailure), + ValidationFailed (ValidationFailedV1, ValidationFailedV2), evalTxExUnitsWithLogs) +import Cardano.Ledger.Api.UTxO (EraUTxO, ScriptsNeeded) +import Cardano.Ledger.BaseTypes (Globals (systemStart), epochInfo) import Cardano.Ledger.Core qualified as Core -import Cardano.Ledger.Era (Crypto, ValidateScript) import Cardano.Ledger.Shelley.API (Coin (Coin), LedgerEnv (LedgerEnv, ledgerSlotNo), - LedgerState (lsDPState, lsUTxOState), MempoolEnv, MempoolState, TxIn, UTxO (UTxO), - Validated, unsafeMakeValidated) + LedgerState (lsCertState, lsUTxOState), MempoolEnv, UTxO (UTxO), Validated, + unsafeMakeValidated) import Cardano.Ledger.Shelley.API qualified as C.Ledger -import Cardano.Ledger.Shelley.LedgerState (LedgerState (LedgerState), UTxOState (_utxo), smartUTxOState) -import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (UtxoEnv)) -import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl) -import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval) +import Cardano.Ledger.Shelley.LedgerState (LedgerState (LedgerState), smartUTxOState, utxosUtxo) +import Cardano.Node.Emulator.Internal.Node.Params (EmulatorEra, Params (emulatorPParams), emulatorGlobals, + emulatorPParams) import Cardano.Slotting.Slot (SlotNo (SlotNo)) -import Control.Lens (makeLenses, over, (&), (.~), (^.)) +import Control.Lens (makeLenses, over, view, (&), (.~), (^.)) import Control.Monad.Except (MonadError (throwError)) -import Data.Array (array) -import Data.Bifunctor (Bifunctor (bimap, first)) +import Data.Bifunctor (Bifunctor (first)) import Data.Default (def) import Data.Map qualified as Map -import Data.Sequence.Strict (StrictSeq) -import Data.Set (Set) import Data.Text qualified as Text -import GHC.Records (HasField (getField)) +import Ledger.Blockchain (OnChainTx (OnChainTx)) import Ledger.Index (genesisTxIn, getCollateral) import Ledger.Index.Internal qualified as P import Ledger.Slot (Slot) import Ledger.Tx (CardanoTx (CardanoEmulatorEraTx)) import Ledger.Tx.CardanoAPI qualified as P -import Plutus.V1.Ledger.Api qualified as V1 hiding (TxOut (..)) -import Plutus.V1.Ledger.Scripts qualified as P - -import Cardano.Node.Emulator.Internal.Node.Params (EmulatorEra, Params (emulatorPParams), emulatorGlobals, - emulatorPParams) -import Ledger.Blockchain (OnChainTx (OnChainTx)) +import PlutusLedgerApi.V1 qualified as V1 hiding (TxOut (..)) +import PlutusLedgerApi.V1.Scripts qualified as P type CardanoLedgerError = Either P.ValidationErrorInPhase P.ToCardanoError @@ -125,7 +117,7 @@ validating machinery. data EmulatedLedgerState = EmulatedLedgerState { _ledgerEnv :: !(MempoolEnv EmulatorEra) - , _memPoolState :: !(MempoolState EmulatorEra) + , _memPoolState :: !(LedgerState EmulatorEra) , _currentBlock :: !EmulatorBlock , _previousBlocks :: ![EmulatorBlock] } @@ -146,10 +138,10 @@ setSlot sl = over ledgerEnv (\l -> l{ledgerSlotNo=sl}) {-| Set the utxo -} -setUtxo :: UTxO EmulatorEra -> EmulatedLedgerState -> EmulatedLedgerState -setUtxo utxo els@EmulatedLedgerState{_memPoolState} = els { _memPoolState = newPoolState } +setUtxo :: Params -> UTxO EmulatorEra -> EmulatedLedgerState -> EmulatedLedgerState +setUtxo params utxo els@EmulatedLedgerState{_memPoolState} = els { _memPoolState = newPoolState } where - newPoolState = _memPoolState { lsUTxOState = smartUTxOState utxo (Coin 0) (Coin 0) def } + newPoolState = _memPoolState { lsUTxOState = smartUTxOState (emulatorPParams params) utxo (Coin 0) (Coin 0) def } {-| Make a block with all transactions that have been validated in the current block, add the block to the blockchain, and empty the current block. @@ -171,8 +163,8 @@ initialState params = EmulatedLedgerState , C.Ledger.ledgerAccount = C.Ledger.AccountState (Coin 0) (Coin 0) } , _memPoolState = LedgerState - { lsUTxOState = smartUTxOState (UTxO mempty) (Coin 0) (Coin 0) def - , lsDPState = C.Ledger.DPState def def + { lsUTxOState = smartUTxOState (emulatorPParams params) (UTxO mempty) (Coin 0) (Coin 0) def + , lsCertState = def } , _currentBlock = [] , _previousBlocks = [] @@ -180,7 +172,7 @@ initialState params = EmulatedLedgerState utxoEnv :: Params -> SlotNo -> C.Ledger.UtxoEnv EmulatorEra -utxoEnv params slotNo = C.Ledger.UtxoEnv slotNo (emulatorPParams params) mempty (C.Ledger.GenDelegs mempty) +utxoEnv params slotNo = C.Ledger.UtxoEnv slotNo (emulatorPParams params) def (C.Ledger.GenDelegs mempty) applyTx :: Params -> @@ -202,12 +194,12 @@ hasValidationErrors params slotNo utxoIndex tx'@(C.ShelleyTx _ tx) = Right report -> P.Success vtx report where utxo = P.fromPlutusIndex utxoIndex - state = setSlot slotNo $ setUtxo utxo $ initialState params + state = setSlot slotNo $ setUtxo params utxo $ initialState params res = do vtx <- first (P.CardanoLedgerValidationError . Text.pack . show) (constructValidated (emulatorGlobals params) (utxoEnv params slotNo) (lsUTxOState (_memPoolState state)) tx) fmap OnChainTx <$> applyTx params state vtx --- | Construct a 'ValidatedTx' from a 'Core.Tx' by setting the `IsValid` +-- | Construct a 'AlonzoTx' from a 'Core.Tx' by setting the `IsValid` -- flag. -- -- Note that this simply constructs the transaction; it does not validate @@ -218,37 +210,35 @@ hasValidationErrors params slotNo utxoIndex tx'@(C.ShelleyTx _ tx) = -- in https://github.com/input-output-hk/cardano-ledger/commit/721adb55b39885847562437a6fe7e998f8e48c03 constructValidated :: forall era m. - ( MonadError [UtxosPredicateFailure era] m, - Core.Script era ~ Script era, - Core.Witnesses era ~ Alonzo.TxWitness era, - ValidateScript era, - HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), - HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), - HasField "_costmdls" (Core.PParams era) CostModels, - HasField "_protocolVersion" (Core.PParams era) ProtVer, - HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), - HasField "vldt" (Core.TxBody era) ValidityInterval, + ( Core.EraTx era, + MaryEraTxBody era, + MonadError [CollectError (Core.EraCrypto era)] m, + Core.Script era ~ AlonzoScript era, + ScriptsNeeded era ~ AlonzoScriptsNeeded era, + AlonzoEraTxWits era, + EraUTxO era, + AlonzoEraPParams era, ExtendedUTxO era ) => Globals -> - UtxoEnv era -> - UTxOState era -> + C.Ledger.UtxoEnv era -> + C.Ledger.UTxOState era -> Core.Tx era -> - m (ValidatedTx era) -constructValidated globals (UtxoEnv _ pp _ _) st tx = + m (AlonzoTx era) +constructValidated globals (C.Ledger.UtxoEnv _ pp _ _) st tx = case collectTwoPhaseScriptInputs ei sysS pp tx utxo of - Left errs -> throwError [CollectErrors errs] + Left errs -> throwError errs Right sLst -> - let scriptEvalResult = evalScripts @era (getField @"_protocolVersion" pp) tx sLst + let scriptEvalResult = evalScripts @era (view ppProtocolVersionL pp) tx sLst vTx = - ValidatedTx - (getField @"body" tx) - (getField @"wits" tx) + AlonzoTx + (view Core.bodyTxL tx) + (view Core.witsTxL tx) (IsValid (lift scriptEvalResult)) - (getField @"auxiliaryData" tx) + (view Core.auxDataTxL tx) in pure vTx where - utxo = _utxo st + utxo = utxosUtxo st sysS = systemStart globals ei = epochInfo globals lift (Passes _) = True @@ -257,7 +247,7 @@ constructValidated globals (UtxoEnv _ pp _ _) st tx = unsafeMakeValid :: CardanoTx -> OnChainTx unsafeMakeValid (CardanoEmulatorEraTx (C.Tx txBody _)) = let C.ShelleyTxBody _ txBody' _ _ _ _ = txBody - vtx :: Core.Tx EmulatorEra = ValidatedTx txBody' mempty (IsValid True) C.Ledger.SNothing + vtx :: Core.Tx EmulatorEra = AlonzoTx txBody' mempty (IsValid True) C.Ledger.SNothing in OnChainTx $ unsafeMakeValidated vtx validateCardanoTx @@ -273,26 +263,20 @@ validateCardanoTx params slot utxo ctx@(CardanoEmulatorEraTx tx@(C.Tx (C.TxBody getTxExUnitsWithLogs :: Params -> UTxO EmulatorEra -> C.Tx C.BabbageEra -> Either P.ValidationErrorInPhase P.RedeemerReport getTxExUnitsWithLogs params utxo (C.ShelleyTx _ tx) = - case C.Ledger.evaluateTransactionExecutionUnitsWithLogs (emulatorPParams params) tx utxo ei ss costmdls of + 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 where eg = emulatorGlobals params ss = systemStart eg ei = epochInfo eg - costmdls = array (minBound, maxBound) . Map.toList $ unCostModels $ getField @"_costmdls" $ emulatorPParams params - toCardanoLedgerError (C.Ledger.ValidationFailedV1 (V1.CekError ce) logs) = + toCardanoLedgerError (ValidationFailure (ValidationFailedV1 (V1.CekError ce) logs _)) = Left (P.Phase2, P.ScriptFailure (P.EvaluationError logs ("CekEvaluationFailure: " ++ show ce))) - toCardanoLedgerError (C.Ledger.ValidationFailedV2 (V1.CekError ce) logs) = + toCardanoLedgerError (ValidationFailure (ValidationFailedV2 (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) makeTransactionBody - :: Params - -> UTxO EmulatorEra - -> P.CardanoBuildTx + :: P.CardanoBuildTx -> Either CardanoLedgerError (C.TxBody C.BabbageEra) -makeTransactionBody params utxo txBodyContent = do - txTmp <- bimap Right (C.makeSignedTransaction []) $ P.makeTransactionBody (Just $ emulatorPParams params) mempty txBodyContent - exUnits <- bimap Left (Map.map snd) $ getTxExUnitsWithLogs params utxo txTmp - first Right $ P.makeTransactionBody (Just $ emulatorPParams params) exUnits txBodyContent +makeTransactionBody = first (Right . P.TxBodyError . C.displayError) . C.createAndValidateTransactionBody . P.getCardanoBuildTx diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Test.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Test.hs index 01e9b2b179..bf1eca4ef0 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Test.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Test.hs @@ -31,7 +31,7 @@ import Cardano.Node.Emulator.API (EmulatorLogs, EmulatorM, EmulatorMsg (ChainEve emptyEmulatorStateWithInitialDist, esChainState, getParams) import Cardano.Node.Emulator.Generators (knownAddresses) import Cardano.Node.Emulator.Internal.Node qualified as E -import Cardano.Node.Emulator.Internal.Node.Params (pNetworkId, pProtocolParams) +import Cardano.Node.Emulator.Internal.Node.Params (pNetworkId) import Control.Lens (use, view, (^.)) import Control.Monad.Except (runExceptT) import Control.Monad.RWS.Strict (evalRWS) @@ -135,7 +135,7 @@ propRunActionsWithOptions initialDist params predicate actions = monadic runFinalPredicate monadicPredicate where finalState = stateAfter actions - ps = pProtocolParams params + ps = E.bundledProtocolParameters params monadicPredicate :: PropertyM (RunMonad EmulatorM) Property monadicPredicate = do diff --git a/cardano-node-emulator/test/Cardano/Node/Emulator/GeneratorsSpec.hs b/cardano-node-emulator/test/Cardano/Node/Emulator/GeneratorsSpec.hs index 905034ecd6..72cdf2e73c 100644 --- a/cardano-node-emulator/test/Cardano/Node/Emulator/GeneratorsSpec.hs +++ b/cardano-node-emulator/test/Cardano/Node/Emulator/GeneratorsSpec.hs @@ -10,7 +10,7 @@ import Cardano.Node.Emulator.Generators qualified as Gen import Cardano.Node.Emulator.Internal.Node.TimeSlot (SlotConfig (scSlotLength)) import Cardano.Node.Emulator.Internal.Node.TimeSlot qualified as TimeSlot import Data.Aeson qualified as JSON -import Data.Aeson.Internal qualified as Aeson +import Data.Aeson.Types qualified as Aeson import Data.String (fromString) import Hedgehog (Gen, Property, forAll, property) import Hedgehog qualified @@ -19,10 +19,10 @@ import Hedgehog.Range qualified as Range import Ledger (DiffMilliSeconds (DiffMilliSeconds), Interval (Interval), LowerBound (LowerBound), Slot (Slot), UpperBound (UpperBound), fromMilliSeconds, interval) import Ledger qualified -import Ledger.Bytes qualified as Bytes -import Ledger.Interval qualified as Interval import Ledger.Value.CardanoAPI qualified as C -import Plutus.V1.Ledger.Value qualified as Value +import PlutusLedgerApi.V1.Bytes qualified as Bytes +import PlutusLedgerApi.V1.Interval qualified as Interval +import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.Prelude qualified as PlutusTx import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) @@ -93,8 +93,9 @@ ledgerBytesShowFromHexProp :: Property ledgerBytesShowFromHexProp = property $ do bts <- forAll $ Bytes.LedgerBytes . PlutusTx.toBuiltin <$> Gen.genSizedByteString 32 let result = Bytes.fromHex $ fromString $ show bts - - Hedgehog.assert $ result == Right bts + case result of + Left _ -> Hedgehog.failure + Right res -> Hedgehog.assert $ res == bts ledgerBytesToJSONProp :: Property ledgerBytesToJSONProp = property $ do diff --git a/cardano-node-emulator/test/Plutus/Example/Game.hs b/cardano-node-emulator/test/Plutus/Example/Game.hs index d5c90c5640..1d4d777edf 100644 --- a/cardano-node-emulator/test/Plutus/Example/Game.hs +++ b/cardano-node-emulator/test/Plutus/Example/Game.hs @@ -28,14 +28,14 @@ import Control.Monad (void) import Data.ByteString.Char8 qualified as C import Data.Map qualified as Map import GHC.Generics (Generic) -import Ledger (CardanoAddress, POSIXTime, PaymentPrivateKey, UtxoIndex, getValidator) +import Ledger (CardanoAddress, POSIXTime, PaymentPrivateKey, UtxoIndex, Validator, getValidator) import Ledger.Address (mkValidatorCardanoAddress) import Ledger.Tx.CardanoAPI qualified as C import Ledger.Typed.Scripts qualified as Scripts import Plutus.Script.Utils.Typed (ScriptContextV2, Versioned) import Plutus.Script.Utils.V2.Typed.Scripts qualified as V2 -import Plutus.V2.Ledger.Api (Address, Validator) -import Plutus.V2.Ledger.Contexts qualified as V2 +import PlutusLedgerApi.V2 (Address) +import PlutusLedgerApi.V2.Contexts qualified as V2 import PlutusTx (FromData, ToData) import PlutusTx qualified import PlutusTx.Prelude () @@ -126,7 +126,7 @@ data GuessArgs = mkLockTx :: LockArgs -> (C.CardanoBuildTx, UtxoIndex) mkLockTx LockArgs { lockArgsGameParam, lockArgsSecret, lockArgsValue } = let gameAddr = mkGameAddress lockArgsGameParam - datum = C.fromPlutusData $ PlutusTx.toData $ hashString lockArgsSecret + datum = C.unsafeHashableScriptData $ C.fromPlutusData $ PlutusTx.toData $ hashString lockArgsSecret txOut = C.TxOut gameAddr (C.toCardanoTxOutValue lockArgsValue) @@ -143,8 +143,8 @@ mkGuessTx -> GuessArgs -> (C.CardanoBuildTx, UtxoIndex) mkGuessTx utxos GuessArgs { guessArgsGameParam, guessArgsSecret } = - let witnessHeader = either (error . show) id $ C.toCardanoTxInScriptWitnessHeader (getValidator <$> mkGameValidator guessArgsGameParam) - redeemer = C.fromPlutusData $ PlutusTx.toData $ clearString guessArgsSecret + let witnessHeader = C.toCardanoTxInScriptWitnessHeader (getValidator <$> mkGameValidator guessArgsGameParam) + redeemer = C.unsafeHashableScriptData $ C.fromPlutusData $ PlutusTx.toData $ clearString guessArgsSecret witness = C.BuildTxWith $ C.ScriptWitness C.ScriptWitnessForSpending $ witnessHeader C.InlineScriptDatum redeemer C.zeroExecutionUnits txIns = (, witness) <$> Map.keys (C.unUTxO utxos) diff --git a/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal b/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal index bec2f8c4d3..a665138450 100644 --- a/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal +++ b/cardano-node-socket-emulator/cardano-node-socket-emulator.cabal @@ -43,36 +43,39 @@ library , cardano-node-emulator >=1.2.0 , freer-extras >=1.2.0 , plutus-ledger >=1.2.0 + , plutus-script-utils >=1.2.0 -------------------------- -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 + , cardano-ledger-allegra , cardano-ledger-alonzo , cardano-ledger-byron , cardano-ledger-core + , cardano-ledger-mary , cardano-ledger-shelley - , cardano-ledger-shelley-ma , cardano-slotting + , cardano-strict-containers , cryptonite , exceptions , io-classes , iohk-monitoring , memory , ouroboros-consensus - , ouroboros-consensus-byron , ouroboros-consensus-cardano + , ouroboros-consensus-diffusion , ouroboros-consensus-protocol - , ouroboros-consensus-shelley , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework - , plutus-core >=1.0.0 - , plutus-ledger-api >=1.0.0 - , plutus-tx >=1.0.0 - , quickcheck-contractmodel >=0.1.4.0 + , ouroboros-network-protocols + , plutus-core >=1.0.0 + , plutus-ledger-api >=1.0.0 + , plutus-tx >=1.0.0 + , quickcheck-contractmodel >=0.1.4.0 , serialise - , strict-containers , text-class , typed-protocols diff --git a/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Server.hs b/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Server.hs index bab0214829..5b519fcd8a 100644 --- a/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Server.hs +++ b/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Server.hs @@ -48,8 +48,8 @@ import Ouroboros.Network.Block (Point (..), pointSlot) import Ouroboros.Network.Block qualified as O import Ouroboros.Network.IOManager import Ouroboros.Network.Mux -import Ouroboros.Network.NodeToClient (NodeToClientProtocols (..), nodeToClientCodecCBORTerm, - nodeToClientHandshakeCodec, nullErrorPolicies, versionedNodeToClientProtocols) +import Ouroboros.Network.NodeToClient (NodeToClientProtocols (..), nodeToClientCodecCBORTerm, nullErrorPolicies, + versionedNodeToClientProtocols) import Ouroboros.Network.Point qualified as OP (Block (..)) import Ouroboros.Network.Protocol.Handshake.Codec import Ouroboros.Network.Protocol.Handshake.Version @@ -428,6 +428,8 @@ protocolLoop socketPath internalState = liftIO $ withIOManager $ \iocp -> do _ <- async $ cleanNetworkMutableState networkState withServerNode (localSnocket iocp) + makeLocalBearer + (\_ _ -> pure ()) nullNetworkServerTracers networkState (AcceptedConnectionsLimit maxBound maxBound 0) @@ -435,7 +437,7 @@ protocolLoop socketPath internalState = liftIO $ withIOManager $ \iocp -> do nodeToClientHandshakeCodec noTimeLimitsHandshake (cborTermVersionDataCodec nodeToClientCodecCBORTerm) - acceptableVersion + (HandshakeCallbacks acceptableVersion queryVersion) (SomeResponderApplication <$> versionedNodeToClientProtocols nodeToClientVersion diff --git a/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Types.hs b/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Types.hs index 057f88277c..a48ec98451 100644 --- a/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Types.hs +++ b/cardano-node-socket-emulator/src/Cardano/Node/Socket/Emulator/Types.hs @@ -1,16 +1,17 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -244,20 +245,20 @@ nodeToClientVersion = NodeToClientV_13 -- argument to the client connection function in a future PR (the network magic -- number matches the one in the test net created by scripts) nodeToClientVersionData :: NodeToClientVersionData -nodeToClientVersionData = NodeToClientVersionData { networkMagic = testNetworkMagic } +nodeToClientVersionData = NodeToClientVersionData { networkMagic = testNetworkMagic, query = False } -- | A protocol client that will never leave the initial state. doNothingInitiatorProtocol :: MonadTimer m => RunMiniProtocol 'InitiatorMode BSL.ByteString m a Void doNothingInitiatorProtocol = InitiatorProtocolOnly $ MuxPeerRaw $ - const $ forever $ threadDelay 1e6 + const $ forever $ threadDelay 1_000_000 doNothingResponderProtocol :: MonadTimer m => RunMiniProtocol 'ResponderMode BSL.ByteString m Void a doNothingResponderProtocol = ResponderProtocolOnly $ MuxPeerRaw $ - const $ forever $ threadDelay 1e6 + const $ forever $ threadDelay 1_000_000 -- | Boilerplate codecs used for protocol serialisation. @@ -282,6 +283,7 @@ codecConfig = Shelley.ShelleyCodecConfig Shelley.ShelleyCodecConfig Shelley.ShelleyCodecConfig + Shelley.ShelleyCodecConfig nodeToClientCodecs :: forall m. MonadST m diff --git a/doc/adr/0007-support-inline-datums-in-constraint-library.rst b/doc/adr/0007-support-inline-datums-in-constraint-library.rst index f20c7d65ce..e0dcfc99ca 100644 --- a/doc/adr/0007-support-inline-datums-in-constraint-library.rst +++ b/doc/adr/0007-support-inline-datums-in-constraint-library.rst @@ -29,7 +29,7 @@ Thus, we need to adapt our transaction constraint data type (``TxConstraints``) Decision -------- -* We will replace the ``Datum`` parameter in ``TxConstraints``'s data constructor ``MustPayToPubKeyAddress`` with ``Plutus.V2.Ledger.Api.OutputDatum``. +* We will replace the ``Datum`` parameter in ``TxConstraints``'s data constructor ``MustPayToPubKeyAddress`` with ``PlutusLedgerApi.V2.OutputDatum``. In the offchain implementation of the constraint, we will use this new data constructor parameter to support either adding the datum in the datum witness set (by using the datum lookups to resolve the hash) or inline it in the transaction output. In the PlutusV1 on-chain implementation of the constraint, we will return ``False`` if the datum value matches ``OutputDatum Datum`` because the ledger forbids using Babbage era features with PlutusV1. The PlutusV2 on-chain implementation of the constraint is trivial. @@ -45,8 +45,8 @@ Argument -------- The main decision was to find out which data type will replace ``Datum`` in the interface of ``MustPayToPubKeyAddress`` and ``MustPayToOtherScript``. -The decision to use ``Plutus.V2.Ledger.Api.OutputDatum`` was mainly because of the constraint library's main design: the parameters of ``TxConstraints``'s data constructor must work with the on-chain as well as the off-chain implementation. -Therefore, we decided to use ``OutputDatum`` which we know works in on-chain code because this type is used in ``Plutus.V2.Ledger.Api.ScriptContext``. +The decision to use ``PlutusLedgerApi.V2.OutputDatum`` was mainly because of the constraint library's main design: the parameters of ``TxConstraints``'s data constructor must work with the on-chain as well as the off-chain implementation. +Therefore, we decided to use ``OutputDatum`` which we know works in on-chain code because this type is used in ``PlutusLedgerApi.V2.ScriptContext``. Notes ----- diff --git a/doc/adr/0011-tx-validity-time-range-fix.rst b/doc/adr/0011-tx-validity-time-range-fix.rst index 3058c570f7..82645924a0 100644 --- a/doc/adr/0011-tx-validity-time-range-fix.rst +++ b/doc/adr/0011-tx-validity-time-range-fix.rst @@ -42,7 +42,7 @@ Currently, provided a ``POSIXTimeRange``, ``plutus-contract`` does the following Cardano.Api.TxValidityUpperBound)`` (essentially a ``(Maybe Slot, Maybe Slot)``) The issue with these conversion is that the ``POSIXTimeRange`` and ``SlotRange`` intervals are -type synonyms of the ``Plutus.V1.Ledger.Api.Interval.Interval a`` datatype which has has a "Closure" +type synonyms of the ``PlutusLedgerApi.V1.Interval.Interval a`` datatype which has has a "Closure" flag for each of the bounds. Therefore, the conversions yields a discrepency when `cardano-ledger` converts the diff --git a/doc/plutus-doc.cabal b/doc/plutus-doc.cabal index 05d76c2d2e..e5ab17c9d1 100644 --- a/doc/plutus-doc.cabal +++ b/doc/plutus-doc.cabal @@ -91,7 +91,7 @@ executable doc-doctests -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , plutus-core >=1.0.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 diff --git a/doc/plutus/howtos/analysing-scripts.rst b/doc/plutus/howtos/analysing-scripts.rst index b886b62c86..46620139d5 100644 --- a/doc/plutus/howtos/analysing-scripts.rst +++ b/doc/plutus/howtos/analysing-scripts.rst @@ -58,7 +58,7 @@ results in the following output: Writing script: ./tmp/auction_2-5.flat (Size: 9.1kB, Cost: ExCPU 1126876612, ExMemory 3408894) .. note:: - The program writes out fully applied validators by default. Fully applied validators are larger than unapplied validators because they contain not just the validator code itself but also all arguments, including the :hsobj:`Plutus.V1.Ledger.Contexts.ScriptContext`. The script context can be quite large as it is a representation of the entire transaction body. + The program writes out fully applied validators by default. Fully applied validators are larger than unapplied validators because they contain not just the validator code itself but also all arguments, including the :hsobj:`PlutusLedgerApi.V1.Contexts.ScriptContext`. The script context can be quite large as it is a representation of the entire transaction body. Running the program in the unapplied validator mode gives us a more realistic picture: @@ -84,7 +84,7 @@ Partial transactions ~~~~~~~~~~~~~~~~~~~~ .. code-block:: shell - + cabal run plutus-use-cases-scripts -- ./tmp transactions -p ./plutus-use-cases/scripts/protocol-parameters.json results in diff --git a/doc/plutus/tutorials/BasicApps.hs b/doc/plutus/tutorials/BasicApps.hs index 3cb88afa43..bd1cf6ac01 100644 --- a/doc/plutus/tutorials/BasicApps.hs +++ b/doc/plutus/tutorials/BasicApps.hs @@ -34,8 +34,8 @@ import Plutus.Contract (Contract, Endpoint, Promise, endpoint, getParams, logInf import Plutus.Contract.Test (w1, w2) import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Trace.Emulator qualified as Trace -import Plutus.V1.Ledger.Api (Address, ScriptContext (ScriptContext, scriptContextTxInfo), TxInfo (txInfoOutputs), - TxOut (TxOut, txOutAddress, txOutValue), Value) +import PlutusLedgerApi.V1 (Address, ScriptContext (ScriptContext, scriptContextTxInfo), TxInfo (txInfoOutputs), + TxOut (TxOut, txOutAddress, txOutValue), Value) import PlutusTx qualified import PlutusTx.Prelude (Bool, Maybe (Just, Nothing), Semigroup ((<>)), mapMaybe, mconcat, ($), (&&), (-), (.), (==), (>=)) diff --git a/doc/plutus/tutorials/Escrow2.hs b/doc/plutus/tutorials/Escrow2.hs index bbcf86da66..0527330a4d 100644 --- a/doc/plutus/tutorials/Escrow2.hs +++ b/doc/plutus/tutorials/Escrow2.hs @@ -29,7 +29,7 @@ import Plutus.Contract.Test (Wallet, mockWalletPaymentPubKeyHash, w1, w2, w3, w4 import Plutus.Contract.Test.ContractModel qualified as CM import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value qualified as Value -import Plutus.V1.Ledger.Api (Datum) +import PlutusLedgerApi.V1 (Datum) import Plutus.Contracts.Tutorial.Escrow (EscrowError, EscrowParams (EscrowParams, escrowTargets), EscrowSchema, payEp, payToPaymentPubKeyTarget, redeemEp) diff --git a/doc/plutus/tutorials/Escrow3.hs b/doc/plutus/tutorials/Escrow3.hs index 25ae3e4c87..212766a939 100644 --- a/doc/plutus/tutorials/Escrow3.hs +++ b/doc/plutus/tutorials/Escrow3.hs @@ -28,7 +28,7 @@ import Plutus.Contract.Test (Wallet, mockWalletPaymentPubKeyHash, w1, w2, w3, w4 import Plutus.Contract.Test.ContractModel qualified as CM import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value qualified as Value -import Plutus.V1.Ledger.Api (Datum) +import PlutusLedgerApi.V1 (Datum) import Plutus.Contracts.Tutorial.Escrow (EscrowError, EscrowParams (EscrowParams, escrowTargets), EscrowSchema, payEp, payToPaymentPubKeyTarget, redeemEp, refundEp) diff --git a/doc/plutus/tutorials/Escrow4.hs b/doc/plutus/tutorials/Escrow4.hs index 5f52e6ccf9..22a55c1dfc 100644 --- a/doc/plutus/tutorials/Escrow4.hs +++ b/doc/plutus/tutorials/Escrow4.hs @@ -29,7 +29,7 @@ import Plutus.Contract.Test (Wallet, mockWalletPaymentPubKeyHash, w1, w2, w3, w4 import Plutus.Contract.Test.ContractModel qualified as CM import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value qualified as Value -import Plutus.V1.Ledger.Api (Datum) +import PlutusLedgerApi.V1 (Datum) import Plutus.Trace.Emulator qualified as Trace import PlutusTx.Monoid (inv) diff --git a/doc/plutus/tutorials/Escrow5.hs b/doc/plutus/tutorials/Escrow5.hs index 27110a8bc3..0e47cc9b3d 100644 --- a/doc/plutus/tutorials/Escrow5.hs +++ b/doc/plutus/tutorials/Escrow5.hs @@ -29,7 +29,7 @@ import Plutus.Contract.Test (Wallet, mockWalletPaymentPubKeyHash, w1, w2, w3, w4 import Plutus.Contract.Test.ContractModel qualified as CM import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value qualified as Value -import Plutus.V1.Ledger.Api (Datum) +import PlutusLedgerApi.V1 (Datum) import Plutus.Trace.Emulator qualified as Trace import PlutusTx.Monoid (inv) diff --git a/doc/plutus/tutorials/Escrow6.hs b/doc/plutus/tutorials/Escrow6.hs index 5d6b3092ca..18ef0fade0 100644 --- a/doc/plutus/tutorials/Escrow6.hs +++ b/doc/plutus/tutorials/Escrow6.hs @@ -37,7 +37,7 @@ import Plutus.Contract.Test (Wallet, mockWalletPaymentPubKeyHash, w1, w2, w3, w4 import Plutus.Contract.Test.ContractModel qualified as CM import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value qualified as Value -import Plutus.V1.Ledger.Api (Datum) +import PlutusLedgerApi.V1 (Datum) import Plutus.Trace.Emulator qualified as Trace import PlutusTx.Monoid (inv) diff --git a/doc/plutus/tutorials/EscrowImpl.hs b/doc/plutus/tutorials/EscrowImpl.hs index 3139e3c7c4..57af108645 100644 --- a/doc/plutus/tutorials/EscrowImpl.hs +++ b/doc/plutus/tutorials/EscrowImpl.hs @@ -56,7 +56,6 @@ import GHC.Generics (Generic) import Ledger (POSIXTime, PaymentPubKeyHash (unPaymentPubKeyHash), ScriptContext (ScriptContext, scriptContextTxInfo), TxId, getCardanoTxId, interval, scriptOutputsAt, txSignedBy, valuePaidTo) import Ledger qualified -import Ledger.Interval (after, before, from) import Ledger.Tx qualified as Tx import Ledger.Tx.Constraints (TxConstraints) import Ledger.Tx.Constraints qualified as Constraints @@ -66,8 +65,9 @@ import Ledger.Typed.Scripts qualified as Scripts import Plutus.Script.Utils.Scripts qualified as Scripts import Plutus.Script.Utils.V1.Scripts qualified as Scripts import Plutus.Script.Utils.Value (Value, geq, lt) -import Plutus.V1.Ledger.Api (Datum (Datum), DatumHash, ValidatorHash) -import Plutus.V1.Ledger.Contexts (ScriptContext (ScriptContext, scriptContextTxInfo), TxInfo (txInfoValidRange)) +import PlutusLedgerApi.V1 (Datum (Datum), DatumHash, ValidatorHash) +import PlutusLedgerApi.V1.Contexts (ScriptContext (ScriptContext, scriptContextTxInfo), TxInfo (txInfoValidRange)) +import PlutusLedgerApi.V1.Interval (after, before, from) import Cardano.Node.Emulator.Internal.Node.Params qualified as Params import Plutus.Contract (AsContractError (_ContractError), Contract, ContractError, Endpoint, HasEndpoint, Promise, diff --git a/doc/plutus/tutorials/basic-apps.rst b/doc/plutus/tutorials/basic-apps.rst index 433d47ed52..4d49f8737a 100644 --- a/doc/plutus/tutorials/basic-apps.rst +++ b/doc/plutus/tutorials/basic-apps.rst @@ -24,7 +24,7 @@ You start by defining some data types that you're going to need for the *Split* ``SplitData`` describes the two recipients of the funds, and the total amount of the funds denoted in ada. -You are using the :hsobj:`Plutus.V1.Ledger.Api.Address` type to identify the recipients. +You are using the :hsobj:`PlutusLedgerApi.V1.Address` type to identify the recipients. When making the payment you can use the hashes to create two public key outputs. Instances for data types @@ -60,13 +60,13 @@ You are going to use the validator script to lock a script output that contains In this tutorial you only need a single validator. Its datum type is ``SplitData`` and its redeemer type is ``()`` (the unit type). -The validator looks at the :hsobj:`Plutus.V1.Ledger.Api.ScriptContext` value to see if the conditions for making the payment are met: +The validator looks at the :hsobj:`PlutusLedgerApi.V1.ScriptContext` value to see if the conditions for making the payment are met: .. literalinclude:: BasicApps.hs :start-after: BLOCK2 :end-before: BLOCK3 -The validator checks that the transaction, represented by :hsobj:`Plutus.V1.Ledger.Api.scriptContextTxInfo`, pays half the specified amount to each recipient. +The validator checks that the transaction, represented by :hsobj:`PlutusLedgerApi.V1.scriptContextTxInfo`, pays half the specified amount to each recipient. You then need some boilerplate to compile the validator to a Plutus script (see `Writing basic validator scripts `_ diff --git a/doc/plutus/tutorials/contract-models.rst b/doc/plutus/tutorials/contract-models.rst index bce72a7337..96ed95e08e 100644 --- a/doc/plutus/tutorials/contract-models.rst +++ b/doc/plutus/tutorials/contract-models.rst @@ -440,7 +440,7 @@ framework (including wallet contents, slot number etc), but it contains the "contract state", which is the state we have defined ourselves, the ``EscrowModel``. The *lens* ``contractState . contributions . to fold`` extracts the ``EscrowModel``, extracts the -``contributions`` field from it, and then combines all the :hsobj:`Plutus.V1.Ledger.Value.Value` +``contributions`` field from it, and then combines all the :hsobj:`PlutusLedgerApi.V1.Value.Value` using |fold|_. When we apply it to ``s`` using |^.|_, we get the total value of all contributions. Likewise, the second lens application computes the combined value of all the targets. If the @@ -457,10 +457,10 @@ of :hsobj:`Plutus.Contract.Test.ContractModel.Interface.Action`, so we just add .. note:: - We can't use ``(>=)`` to compare :hsobj:`Plutus.V1.Ledger.Value.Value`; there is no - ``Ord`` instance. That is because some :hsobj:`Plutus.V1.Ledger.Value.Value` are incomparable, + We can't use ``(>=)`` to compare :hsobj:`PlutusLedgerApi.V1.Value.Value`; there is no + ``Ord`` instance. That is because some :hsobj:`PlutusLedgerApi.V1.Value.Value` are incomparable, such as one Ada and one NFT, which would break our expectations about - ``Ord``. That is why we have to compare them using :hsobj:`Plutus.V1.Ledger.Value.geq` instead. + ``Ord``. That is why we have to compare them using :hsobj:`PlutusLedgerApi.V1.Value.geq` instead. With this precondition, the failing test we have seen can no longer be generated, and will not appear again in our |quickCheck|_ runs. @@ -1212,7 +1212,7 @@ model state, :hsobj:`Plutus.Contract.Test.ContractModel.Interface.lockedValue` i that computes the total value held by contracts, and :hsobj:`Plutus.Contract.Test.ContractModel.Interface.symIsZero` checks that this is zero. The value is returned here as a :hsobj:`Test.QuickCheck.ContractModel.Internal.Symbolics.SymValue`, but for now it can be thought of just as a normal -Plutus :hsobj:`Plutus.V1.Ledger.Value.Value` with an extra type wrapper. +Plutus :hsobj:`PlutusLedgerApi.V1.Value.Value` with an extra type wrapper. This scenario just tests that the given finishing strategy always succeeds in recovering all tokens from contracts, no matter what @@ -1681,9 +1681,9 @@ a new field :hsobj:`Plutus.Contracts.Escrow.escrowDeadline`, and so far, our cod initialise it. We will generate the deadlines, so that they vary from test to test, but there is a slight mismatch to overcome first. In a contract model we measure time in *slots*, but the :hsobj:`Plutus.Contracts.Escrow.escrowDeadline` -field is not a slot number, it is a :hsobj:`Plutus.V1.Ledger.Time.POSIXTime`. So while we shall +field is not a slot number, it is a :hsobj:`Ledger.Time.POSIXTime`. So while we shall generate the deadline as a slot number (for convenience in the model), -we must convert it to a :hsobj:`Plutus.V1.Ledger.Time.POSIXTime` before we can pass it to the +we must convert it to a :hsobj:`Ledger.Time.POSIXTime` before we can pass it to the contract under test. To do so, we need to know when slot 0 happens in POSIX time, and how @@ -1711,7 +1711,7 @@ configuration. Putting all this together, we can add a deadline to our If you are familiar with the |Clock.POSIXTime|_ type from |Data.Time.Clock.POSIX|_, then beware that *this is not the same type*. That type has a resolution of picoseconds, while Plutus uses - its own :hsobj:`Plutus.V1.Ledger.Time.POSIXTime` type with a resolution of milliseconds. + its own :hsobj:`Ledger.Time.POSIXTime` type with a resolution of milliseconds. .. |Clock.POSIXTime| replace:: ``POSIXTime`` .. _Clock.POSIXTime: https://hackage.haskell.org/package/time-1.13/docs/Data-Time-Clock-POSIX.html#t:POSIXTime @@ -2668,7 +2668,7 @@ test another contract, and we'll see how they reveal some surprising behaviour. The contract we take this time is the auction contract in :hsmod:`Plutus.Contracts.Auction`. This module actually defines *two* contracts, a seller contract and a buyer contract. The seller puts up -a :hsobj:`Plutus.V1.Ledger.Value.Value` for sale, creating an auction UTXO containing the value, +a :hsobj:`PlutusLedgerApi.V1.Value.Value` for sale, creating an auction UTXO containing the value, and buyers can then bid Ada for it. When the auction deadline is reached, the highest bidder receives the auctioned value, and the seller receives the bid. @@ -2907,8 +2907,8 @@ Now ``prop_Auction`` fails! .. note:: - The balance change is actually a :hsobj:`Test.QuickCheck.ContractModel.Internal.Symbolics.SymValue`, not a :hsobj:`Plutus.V1.Ledger.Value.Value`, - but as you can see it *contains* a :hsobj:`Plutus.V1.Ledger.Value.Value`, which is all we care + The balance change is actually a :hsobj:`Test.QuickCheck.ContractModel.Internal.Symbolics.SymValue`, not a :hsobj:`PlutusLedgerApi.V1.Value.Value`, + but as you can see it *contains* a :hsobj:`PlutusLedgerApi.V1.Value.Value`, which is all we care about right now. Even in this simple case, the seller does not receive the right diff --git a/flake.lock b/flake.lock index e89dcdd838..084c968270 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1683628047, - "narHash": "sha256-p8H6fHmcTlerNB/SxHoWjXR5A0+rFUXJb39jP2jon1g=", + "lastModified": 1693988844, + "narHash": "sha256-0fvQy6GxgSkpufa0QeEtYNEY4G5nSQ7L4VIkGdfTt+w=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "94cad9a3163ffc48b8d736ca9a448b4801b697e9", + "rev": "27f047c00b5d079e6322a3eab53549cad9e77680", "type": "github" }, "original": { @@ -48,21 +48,6 @@ "type": "github" } }, - "blank_2": { - "locked": { - "lastModified": 1625557891, - "narHash": "sha256-O8/MWsPBGhhyPoPLHZAuoZiiHo9q6FLlEeIDEXuj6T4=", - "owner": "divnix", - "repo": "blank", - "rev": "5a5d2684073d9f563072ed07c871d577a6c614a8", - "type": "github" - }, - "original": { - "owner": "divnix", - "repo": "blank", - "type": "github" - } - }, "cabal-32": { "flake": false, "locked": { @@ -83,11 +68,11 @@ "cabal-34": { "flake": false, "locked": { - "lastModified": 1640353650, - "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", + "lastModified": 1645834128, + "narHash": "sha256-wG3d+dOt14z8+ydz4SL7pwGfe7SiimxcD/LOuPCV6xM=", "owner": "haskell", "repo": "cabal", - "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", + "rev": "5ff598c67f53f7c4f48e31d722ba37172230c462", "type": "github" }, "original": { @@ -100,11 +85,11 @@ "cabal-36": { "flake": false, "locked": { - "lastModified": 1641652457, - "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", + "lastModified": 1669081697, + "narHash": "sha256-I5or+V7LZvMxfbYgZATU4awzkicBwwok4mVoje+sGmU=", "owner": "haskell", "repo": "cabal", - "rev": "f27667f8ec360c475027dcaee0138c937477b070", + "rev": "8fd619e33d34924a94e691c5fea2c42f0fc7f144", "type": "github" }, "original": { @@ -131,35 +116,6 @@ } }, "devshell": { - "inputs": { - "flake-utils": [ - "haskell-nix", - "tullia", - "std", - "flake-utils" - ], - "nixpkgs": [ - "haskell-nix", - "tullia", - "std", - "nixpkgs" - ] - }, - "locked": { - "lastModified": 1663445644, - "narHash": "sha256-+xVlcK60x7VY1vRJbNUEAHi17ZuoQxAIH4S4iUFUGBA=", - "owner": "numtide", - "repo": "devshell", - "rev": "e3dc3e21594fe07bdb24bdf1c8657acaa4cb8f66", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "devshell", - "type": "github" - } - }, - "devshell_2": { "inputs": { "flake-utils": [ "std", @@ -185,35 +141,6 @@ } }, "dmerge": { - "inputs": { - "nixlib": [ - "haskell-nix", - "tullia", - "std", - "nixpkgs" - ], - "yants": [ - "haskell-nix", - "tullia", - "std", - "yants" - ] - }, - "locked": { - "lastModified": 1659548052, - "narHash": "sha256-fzI2gp1skGA8mQo/FBFrUAtY0GQkAIAaV/V127TJPyY=", - "owner": "divnix", - "repo": "data-merge", - "rev": "d160d18ce7b1a45b88344aa3f13ed1163954b497", - "type": "github" - }, - "original": { - "owner": "divnix", - "repo": "data-merge", - "type": "github" - } - }, - "dmerge_2": { "inputs": { "nixlib": [ "std", @@ -272,22 +199,6 @@ } }, "flake-compat_3": { - "flake": false, - "locked": { - "lastModified": 1650374568, - "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=", - "owner": "edolstra", - "repo": "flake-compat", - "rev": "b4a34015c698c7793d592d66adbab377907a2be8", - "type": "github" - }, - "original": { - "owner": "edolstra", - "repo": "flake-compat", - "type": "github" - } - }, - "flake-compat_4": { "flake": false, "locked": { "lastModified": 1673956053, @@ -305,65 +216,21 @@ }, "flake-utils": { "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", + "lastModified": 1679360468, + "narHash": "sha256-LGnza3cfXF10Biw3ZTg0u9o9t7s680Ww200t5KkHTh8=", + "owner": "hamishmack", "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", + "rev": "e1ea268ff47ad475443dbabcd54744b4e5b9d4f5", "type": "github" }, "original": { - "owner": "numtide", + "owner": "hamishmack", + "ref": "hkm/nested-hydraJobs", "repo": "flake-utils", "type": "github" } }, "flake-utils_2": { - "locked": { - "lastModified": 1653893745, - "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_3": { - "locked": { - "lastModified": 1659877975, - "narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "c0e246b9b83f637f4681389ecabcb2681b4f3af0", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_4": { - "locked": { - "lastModified": 1653893745, - "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_5": { "locked": { "lastModified": 1644229661, "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", @@ -378,7 +245,7 @@ "type": "github" } }, - "flake-utils_6": { + "flake-utils_3": { "locked": { "lastModified": 1659877975, "narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=", @@ -393,7 +260,7 @@ "type": "github" } }, - "flake-utils_7": { + "flake-utils_4": { "locked": { "lastModified": 1653893745, "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", @@ -466,33 +333,14 @@ "type": "github" } }, - "gomod2nix": { - "inputs": { - "nixpkgs": "nixpkgs_2", - "utils": "utils" - }, - "locked": { - "lastModified": 1655245309, - "narHash": "sha256-d/YPoQ/vFn1+GTmSdvbSBSTOai61FONxB4+Lt6w/IVI=", - "owner": "tweag", - "repo": "gomod2nix", - "rev": "40d32f82fc60d66402eb0972e6e368aeab3faf58", - "type": "github" - }, - "original": { - "owner": "tweag", - "repo": "gomod2nix", - "type": "github" - } - }, "hackage-nix": { "flake": false, "locked": { - "lastModified": 1682036591, - "narHash": "sha256-QPrmInnsudgOP+bpJKzosItR0H1C5F54SmPLV8AlFPg=", + "lastModified": 1693959895, + "narHash": "sha256-qLmbEucG4NTA507cQzhsqnE3nJqUSVAALQX6MgzDwGo=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "9d83fdf40d77bc15719c6e498da98dbd0714dfa4", + "rev": "d0d990c3a8daba50aee6ee31794cb87226f4e18f", "type": "github" }, "original": { @@ -504,16 +352,16 @@ "haskell-language-server": { "flake": false, "locked": { - "lastModified": 1663135728, - "narHash": "sha256-ghyyig0GZXRXS56FxH8unpDceU06i/uGBCBmRwneZPw=", + "lastModified": 1672051165, + "narHash": "sha256-j3XRQTWa7jsVlimaxFZNnlE9IzWII9Prj1/+otks5FQ=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "ddb21a0c8d4e657c4b81ce250239bccf28fc9524", + "rev": "1916b5782d9f3204d25a1d8f94da4cfd83ae2607", "type": "github" }, "original": { "owner": "haskell", - "ref": "1.8.0.0", + "ref": "1.9.0.0", "repo": "haskell-language-server", "type": "github" } @@ -531,6 +379,8 @@ "hackage": [ "hackage-nix" ], + "hls-1.10": "hls-1.10", + "hls-2.0": "hls-2.0", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -542,17 +392,17 @@ "nixpkgs-2111": "nixpkgs-2111", "nixpkgs-2205": "nixpkgs-2205", "nixpkgs-2211": "nixpkgs-2211", + "nixpkgs-2305": "nixpkgs-2305", "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": "old-ghc-nix", - "stackage": "stackage", - "tullia": "tullia" + "stackage": "stackage" }, "locked": { - "lastModified": 1675900540, - "narHash": "sha256-yItNeUA3yG0VBle6PG0KOnKV/ZVMG8gAMLZKGp0HiWY=", + "lastModified": 1687308678, + "narHash": "sha256-Vlj+78vMgRQLPbHJYH3ZatYQW7RAk4xJTTaop3SYAzA=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "7075077d46e684d50e1b00759bb4590426c99c70", + "rev": "f1c9456823444534696710a2f78e61be3f10f2f8", "type": "github" }, "original": { @@ -561,6 +411,40 @@ "type": "github" } }, + "hls-1.10": { + "flake": false, + "locked": { + "lastModified": 1680000865, + "narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "1.10.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.0": { + "flake": false, + "locked": { + "lastModified": 1684398654, + "narHash": "sha256-RW44up2BIyBBYN6tZur5f9kDDR3kr0Rd+TgPbLTfwB4=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "20c6d1e731cd9c0beef7338e2fc7a8126ba9b6fb", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.0.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hpc-coveralls": { "flake": false, "locked": { @@ -588,11 +472,11 @@ ] }, "locked": { - "lastModified": 1646878427, - "narHash": "sha256-KtbrofMtN8GlM7D+n90kixr7QpSlVmdN+vK5CA/aRzc=", + "lastModified": 1671755331, + "narHash": "sha256-hXsgJj0Cy0ZiCiYdW2OdBz5WmFyOMKuw4zyxKpgUKm4=", "owner": "NixOS", "repo": "hydra", - "rev": "28b682b85b7efc5cf7974065792a1f22203a5927", + "rev": "f48f00ee6d5727ae3e488cbf9ce157460853fea8", "type": "github" }, "original": { @@ -669,49 +553,9 @@ "type": "github" } }, - "mdbook-kroki-preprocessor_2": { - "flake": false, - "locked": { - "lastModified": 1661755005, - "narHash": "sha256-1TJuUzfyMycWlOQH67LR63/ll2GDZz25I3JfScy/Jnw=", - "owner": "JoelCourtney", - "repo": "mdbook-kroki-preprocessor", - "rev": "93adb5716d035829efed27f65f2f0833a7d3e76f", - "type": "github" - }, - "original": { - "owner": "JoelCourtney", - "repo": "mdbook-kroki-preprocessor", - "type": "github" - } - }, "n2c": { "inputs": { "flake-utils": "flake-utils_4", - "nixpkgs": [ - "haskell-nix", - "tullia", - "std", - "nixpkgs" - ] - }, - "locked": { - "lastModified": 1665039323, - "narHash": "sha256-SAh3ZjFGsaCI8FRzXQyp56qcGdAqgKEfJWPCQ0Sr7tQ=", - "owner": "nlewo", - "repo": "nix2container", - "rev": "b008fe329ffb59b67bf9e7b08ede6ee792f2741a", - "type": "github" - }, - "original": { - "owner": "nlewo", - "repo": "nix2container", - "type": "github" - } - }, - "n2c_2": { - "inputs": { - "flake-utils": "flake-utils_7", "nixpkgs": [ "std", "nixpkgs" @@ -738,110 +582,21 @@ "nixpkgs-regression": "nixpkgs-regression" }, "locked": { - "lastModified": 1643066034, - "narHash": "sha256-xEPeMcNJVOeZtoN+d+aRwolpW8mFSEQx76HTRdlhPhg=", + "lastModified": 1661606874, + "narHash": "sha256-9+rpYzI+SmxJn+EbYxjGv68Ucp22bdFUSy/4LkHkkDQ=", "owner": "NixOS", "repo": "nix", - "rev": "a1cd7e58606a41fcf62bf8637804cf8306f17f62", + "rev": "11e45768b34fdafdcf019ddbd337afa16127ff0f", "type": "github" }, "original": { "owner": "NixOS", - "ref": "2.6.0", + "ref": "2.11.0", "repo": "nix", "type": "github" } }, - "nix-nomad": { - "inputs": { - "flake-compat": "flake-compat_3", - "flake-utils": [ - "haskell-nix", - "tullia", - "nix2container", - "flake-utils" - ], - "gomod2nix": "gomod2nix", - "nixpkgs": [ - "haskell-nix", - "tullia", - "nixpkgs" - ], - "nixpkgs-lib": [ - "haskell-nix", - "tullia", - "nixpkgs" - ] - }, - "locked": { - "lastModified": 1658277770, - "narHash": "sha256-T/PgG3wUn8Z2rnzfxf2VqlR1CBjInPE0l1yVzXxPnt0=", - "owner": "tristanpemble", - "repo": "nix-nomad", - "rev": "054adcbdd0a836ae1c20951b67ed549131fd2d70", - "type": "github" - }, - "original": { - "owner": "tristanpemble", - "repo": "nix-nomad", - "type": "github" - } - }, - "nix2container": { - "inputs": { - "flake-utils": "flake-utils_2", - "nixpkgs": "nixpkgs_3" - }, - "locked": { - "lastModified": 1658567952, - "narHash": "sha256-XZ4ETYAMU7XcpEeAFP3NOl9yDXNuZAen/aIJ84G+VgA=", - "owner": "nlewo", - "repo": "nix2container", - "rev": "60bb43d405991c1378baf15a40b5811a53e32ffa", - "type": "github" - }, - "original": { - "owner": "nlewo", - "repo": "nix2container", - "type": "github" - } - }, "nixago": { - "inputs": { - "flake-utils": [ - "haskell-nix", - "tullia", - "std", - "flake-utils" - ], - "nixago-exts": [ - "haskell-nix", - "tullia", - "std", - "blank" - ], - "nixpkgs": [ - "haskell-nix", - "tullia", - "std", - "nixpkgs" - ] - }, - "locked": { - "lastModified": 1661824785, - "narHash": "sha256-/PnwdWoO/JugJZHtDUioQp3uRiWeXHUdgvoyNbXesz8=", - "owner": "nix-community", - "repo": "nixago", - "rev": "8c1f9e5f1578d4b2ea989f618588d62a335083c3", - "type": "github" - }, - "original": { - "owner": "nix-community", - "repo": "nixago", - "type": "github" - } - }, - "nixago_2": { "inputs": { "flake-utils": [ "std", @@ -872,17 +627,18 @@ }, "nixpkgs": { "locked": { - "lastModified": 1632864508, - "narHash": "sha256-d127FIvGR41XbVRDPVvozUPQ/uRHbHwvfyKHwEt5xFM=", + "lastModified": 1657693803, + "narHash": "sha256-G++2CJ9u0E7NNTAi9n5G8TdDmGJXcIjkJ3NF8cetQB8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "82891b5e2c2359d7e58d08849e4c89511ab94234", + "rev": "365e1b3a859281cf11b94f87231adeabbdd878a2", "type": "github" }, "original": { - "id": "nixpkgs", - "ref": "nixos-21.05-small", - "type": "indirect" + "owner": "NixOS", + "ref": "nixos-22.05-small", + "repo": "nixpkgs", + "type": "github" } }, "nixpkgs-2003": { @@ -935,11 +691,11 @@ }, "nixpkgs-2205": { "locked": { - "lastModified": 1663981975, - "narHash": "sha256-TKaxWAVJR+a5JJauKZqibmaM5e/Pi5tBDx9s8fl/kSE=", + "lastModified": 1682600000, + "narHash": "sha256-ha4BehR1dh8EnXSoE1m/wyyYVvHI9txjW4w5/oxsW5Y=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "309faedb8338d3ae8ad8f1043b3ccf48c9cc2970", + "rev": "50fc86b75d2744e1ab3837ef74b53f103a9b55a0", "type": "github" }, "original": { @@ -951,11 +707,11 @@ }, "nixpkgs-2211": { "locked": { - "lastModified": 1676253841, - "narHash": "sha256-jhuI8Mmky8VCD45OoJEuF6HdPLFBwNrHA0ljjZ/zkfw=", + "lastModified": 1685314633, + "narHash": "sha256-8LXBPqTQXl5ofkjpJ18JcbmLJ/lWDoMxtUwiDYv0wro=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "a45a8916243a7d27acc358f4fc18c4491f3eeca8", + "rev": "c8a17ce7abc03c50cd072e9e6c9b389c5f61836b", "type": "github" }, "original": { @@ -965,101 +721,71 @@ "type": "github" } }, - "nixpkgs-regression": { - "locked": { - "lastModified": 1643052045, - "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", - "type": "github" - }, - "original": { - "id": "nixpkgs", - "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", - "type": "indirect" - } - }, - "nixpkgs-stable": { + "nixpkgs-2305": { "locked": { - "lastModified": 1676177817, - "narHash": "sha256-OQnBnuKkpwkfNY31xQyfU5hNpLs1ilWt+hVY6ztEEOM=", + "lastModified": 1685338297, + "narHash": "sha256-+Aq4O0Jn1W1q927ZHc3Zn6RO7bwQGmb6O8xYoGy0KrM=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "1b82144edfcd0c86486d2e07c7298f85510e7fb8", + "rev": "6287b47dbfabbb8bfbb9b1b53d198ad58a774de4", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-22.11", + "ref": "nixpkgs-23.05-darwin", "repo": "nixpkgs", "type": "github" } }, - "nixpkgs-unstable": { + "nixpkgs-regression": { "locked": { - "lastModified": 1663905476, - "narHash": "sha256-0CSwRKaYravh9v6qSlBpM0gNg0UhKT2lL7Yn6Zbx7UM=", + "lastModified": 1643052045, + "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e14f9fb57315f0d4abde222364f19f88c77d2b79", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", "repo": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", "type": "github" } }, - "nixpkgs_2": { + "nixpkgs-stable": { "locked": { - "lastModified": 1653581809, - "narHash": "sha256-Uvka0V5MTGbeOfWte25+tfRL3moECDh1VwokWSZUdoY=", + "lastModified": 1676177817, + "narHash": "sha256-OQnBnuKkpwkfNY31xQyfU5hNpLs1ilWt+hVY6ztEEOM=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "83658b28fe638a170a19b8933aa008b30640fbd1", + "rev": "1b82144edfcd0c86486d2e07c7298f85510e7fb8", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-unstable", + "ref": "nixos-22.11", "repo": "nixpkgs", "type": "github" } }, - "nixpkgs_3": { + "nixpkgs-unstable": { "locked": { - "lastModified": 1654807842, - "narHash": "sha256-ADymZpr6LuTEBXcy6RtFHcUZdjKTBRTMYwu19WOx17E=", + "lastModified": 1685347552, + "narHash": "sha256-9woSppRyUFo26yUffORTzttJ+apOt8MmCv6RxpPNTU4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "fc909087cc3386955f21b4665731dbdaceefb1d8", + "rev": "f2f1ec390714d303cf84ba086e34e45b450dd8c4", "type": "github" }, "original": { "owner": "NixOS", - "repo": "nixpkgs", - "type": "github" - } - }, - "nixpkgs_4": { - "locked": { - "lastModified": 1665087388, - "narHash": "sha256-FZFPuW9NWHJteATOf79rZfwfRn5fE0wi9kRzvGfDHPA=", - "owner": "nixos", - "repo": "nixpkgs", - "rev": "95fda953f6db2e9496d2682c4fc7b82f959878f7", - "type": "github" - }, - "original": { - "owner": "nixos", "ref": "nixpkgs-unstable", "repo": "nixpkgs", "type": "github" } }, - "nixpkgs_5": { + "nixpkgs_2": { "locked": { "lastModified": 1663905476, "narHash": "sha256-0CSwRKaYravh9v6qSlBpM0gNg0UhKT2lL7Yn6Zbx7UM=", @@ -1093,8 +819,8 @@ }, "pre-commit-hooks-nix": { "inputs": { - "flake-compat": "flake-compat_4", - "flake-utils": "flake-utils_5", + "flake-compat": "flake-compat_3", + "flake-utils": "flake-utils_2", "gitignore": "gitignore", "nixpkgs": [ "nixpkgs" @@ -1124,10 +850,10 @@ "haskell-language-server": "haskell-language-server", "haskell-nix": "haskell-nix", "iohk-nix": "iohk-nix", - "nixpkgs": "nixpkgs_5", + "nixpkgs": "nixpkgs_2", "pre-commit-hooks-nix": "pre-commit-hooks-nix", "sphinxcontrib-haddock": "sphinxcontrib-haddock", - "std": "std_2" + "std": "std" } }, "sphinxcontrib-haddock": { @@ -1149,11 +875,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1667524765, - "narHash": "sha256-rY58ROG9paYqqhUPFxZArU59qOIatIFHrurhVo7JXX4=", + "lastModified": 1687306175, + "narHash": "sha256-wZzi1m5hteGQjZAhPQ+mp7T+buaV9WwHwy0sNJzPjI8=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "ed1ec5f81f9eb32eb627fd447088eb782e7ff71b", + "rev": "57f5246f08e0ebbe9f1612b67408391c81bde02e", "type": "github" }, "original": { @@ -1169,58 +895,20 @@ "dmerge": "dmerge", "flake-utils": "flake-utils_3", "makes": [ - "haskell-nix", - "tullia", "std", "blank" ], "mdbook-kroki-preprocessor": "mdbook-kroki-preprocessor", "microvm": [ - "haskell-nix", - "tullia", "std", "blank" ], "n2c": "n2c", "nixago": "nixago", - "nixpkgs": "nixpkgs_4", - "yants": "yants" - }, - "locked": { - "lastModified": 1665513321, - "narHash": "sha256-D6Pacw9yf/HMs84KYuCxHXnNDL7v43gtcka5URagFqE=", - "owner": "divnix", - "repo": "std", - "rev": "94a90eedb9cfc115b12ae8f6622d9904788559e4", - "type": "github" - }, - "original": { - "owner": "divnix", - "repo": "std", - "type": "github" - } - }, - "std_2": { - "inputs": { - "blank": "blank_2", - "devshell": "devshell_2", - "dmerge": "dmerge_2", - "flake-utils": "flake-utils_6", - "makes": [ - "std", - "blank" - ], - "mdbook-kroki-preprocessor": "mdbook-kroki-preprocessor_2", - "microvm": [ - "std", - "blank" - ], - "n2c": "n2c_2", - "nixago": "nixago_2", "nixpkgs": [ "nixpkgs" ], - "yants": "yants_2" + "yants": "yants" }, "locked": { "lastModified": 1665513321, @@ -1236,69 +924,7 @@ "type": "github" } }, - "tullia": { - "inputs": { - "nix-nomad": "nix-nomad", - "nix2container": "nix2container", - "nixpkgs": [ - "haskell-nix", - "nixpkgs" - ], - "std": "std" - }, - "locked": { - "lastModified": 1666200256, - "narHash": "sha256-cJPS8zBu30SMhxMe7I8DWutwqMuhPsEez87y9gxMKc4=", - "owner": "input-output-hk", - "repo": "tullia", - "rev": "575362c2244498e8d2c97f72861510fa72e75d44", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "repo": "tullia", - "type": "github" - } - }, - "utils": { - "locked": { - "lastModified": 1653893745, - "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, "yants": { - "inputs": { - "nixpkgs": [ - "haskell-nix", - "tullia", - "std", - "nixpkgs" - ] - }, - "locked": { - "lastModified": 1660507851, - "narHash": "sha256-BKjq7JnVuUR/xDtcv6Vm9GYGKAblisXrAgybor9hT/s=", - "owner": "divnix", - "repo": "yants", - "rev": "0b895ca02a8fa72bad50b454cb3e7d8a66407c96", - "type": "github" - }, - "original": { - "owner": "divnix", - "repo": "yants", - "type": "github" - } - }, - "yants_2": { "inputs": { "nixpkgs": [ "std", diff --git a/flake.nix b/flake.nix index ae640a5985..4f307c4149 100644 --- a/flake.nix +++ b/flake.nix @@ -56,8 +56,7 @@ flake = false; }; haskell-language-server = { - # TODO Bump to 1.9.0.0 once plutus-apps hits GHC 9.2 - url = "github:haskell/haskell-language-server?ref=1.8.0.0"; + url = "github:haskell/haskell-language-server?ref=1.9.0.0"; flake = false; }; }; diff --git a/freer-extras/src/Control/Monad/Freer/Extras/Beam/Effects.hs b/freer-extras/src/Control/Monad/Freer/Extras/Beam/Effects.hs index 678cfc427a..8d94bf8ae3 100644 --- a/freer-extras/src/Control/Monad/Freer/Extras/Beam/Effects.hs +++ b/freer-extras/src/Control/Monad/Freer/Extras/Beam/Effects.hs @@ -32,7 +32,7 @@ import Database.Beam (Beamable, DatabaseEntity, FromBackendRow, HasQBuilder, Ide SqlInsert, SqlSelect, SqlUpdate, TableEntity, asc_, filter_, insertValues, limit_, orderBy_, runDelete, runInsert, runSelectReturningList, runSelectReturningOne, runUpdate, select, val_, (>.)) -import Database.Beam.Backend.SQL (BeamSqlBackend, BeamSqlBackendSyntax, HasSqlValueSyntax, +import Database.Beam.Backend.SQL (BeamSqlBackendSyntax, HasSqlValueSyntax, IsSql92ExpressionSyntax (Sql92ExpressionValueSyntax), IsSql92SelectSyntax (Sql92SelectSelectTableSyntax), IsSql92SelectTableSyntax (Sql92SelectTableExpressionSyntax), @@ -180,8 +180,7 @@ combined ops handleBeam :: forall dbt (dbM :: Type -> Type) effs. - ( BeamSqlBackend dbt - , MonadBeam dbt dbM + ( MonadBeam dbt dbM , BeamHasInsertOnConflict dbt ) =>(Trace IO BeamLog -> dbM ~> Eff effs) diff --git a/freer-extras/test/Control/Monad/Freer/Extras/BeamSpec.hs b/freer-extras/test/Control/Monad/Freer/Extras/BeamSpec.hs index a32ae9a213..cd1c49d2fb 100644 --- a/freer-extras/test/Control/Monad/Freer/Extras/BeamSpec.hs +++ b/freer-extras/test/Control/Monad/Freer/Extras/BeamSpec.hs @@ -46,6 +46,7 @@ import Database.Beam.Sqlite.Migrate qualified as Sqlite import Database.Beam.Sqlite.Syntax (SqliteValueSyntax) import Database.SQLite.Simple qualified as Sqlite +import Data.Kind (Type) import Data.Maybe (listToMaybe) import Data.Set (Set) import Hedgehog (Property, PropertyT, assert, forAll, property, (===)) @@ -68,7 +69,7 @@ newtype Db f = Db } deriving (Generic) deriving anyclass (Database be) -type AllTables (c :: * -> Constraint) f = +type AllTables (c :: Type -> Constraint) f = ( c (f (TableEntity TestRowT)) ) deriving via (GenericSemigroupMonoid (Db f)) instance AllTables Semigroup f => Semigroup (Db f) diff --git a/nix/pkgs/haskell/sha256map.nix b/nix/pkgs/haskell/sha256map.nix index 68d2882155..ffcd4415b0 100644 --- a/nix/pkgs/haskell/sha256map.nix +++ b/nix/pkgs/haskell/sha256map.nix @@ -1,6 +1 @@ -{ - "https://github.com/input-output-hk/cardano-addresses"."b7273a5d3c21f1a003595ebf1e1f79c28cd72513" = "129r5kyiw10n2021bkdvnr270aiiwyq58h472d151ph0r7wpslgp"; - "https://github.com/input-output-hk/cardano-ledger"."da3e9ae10cf9ef0b805a046c84745f06643583c2" = "sha256-3VUZKkLu1R43GUk9IwgsGQ55O0rnu8NrCkFX9gqA4ck="; - "https://github.com/input-output-hk/cardano-wallet"."18a931648550246695c790578d4a55ee2f10463e" = "0i40hp1mdbljjcj4pn3n6zahblkb2jmpm8l4wnb36bya1pzf66fx"; - "https://github.com/input-output-hk/marconi"."7285a3bc1ae53bf672c7cc2359210c6c29fbce44" = "sha256-Z1ex1CqsIDzhzE8tbHtFvK+V+W3Fn1me2tHL/D+HhUE="; -} +{ } diff --git a/pab-blockfrost/src/Plutus/Blockfrost/Responses.hs b/pab-blockfrost/src/Plutus/Blockfrost/Responses.hs index e009bd6aa8..1ab123c2e3 100644 --- a/pab-blockfrost/src/Plutus/Blockfrost/Responses.hs +++ b/pab-blockfrost/src/Plutus/Blockfrost/Responses.hs @@ -37,11 +37,11 @@ import Ledger.Tx (DatumFromQuery (DatumUnknown), DecoratedTxOut (..), Language ( TxOutRef (..), Versioned (Versioned), mkPubkeyDecoratedTxOut, mkScriptDecoratedTxOut) import Plutus.ChainIndex.Api (IsUtxoResponse (..), QueryResponse (..), TxosResponse (..), UtxosResponse (..)) import Plutus.ChainIndex.Types (BlockId (..), BlockNumber (..), ChainIndexTx (..), ChainIndexTxOutputs (..), Tip (..)) -import Plutus.V1.Ledger.Api (PubKeyHash) -import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential)) -import Plutus.V1.Ledger.Scripts (Datum, MintingPolicy, StakeValidator, Validator (..), ValidatorHash (..)) -import Plutus.V1.Ledger.Scripts qualified as Ledger (DatumHash, Script, ScriptHash (..)) -import Plutus.V1.Ledger.Tx qualified +import PlutusLedgerApi.V1 (PubKeyHash) +import PlutusLedgerApi.V1.Credential (Credential (PubKeyCredential, ScriptCredential)) +import PlutusLedgerApi.V1.Scripts (Datum, MintingPolicy, StakeValidator, Validator (..), ValidatorHash (..)) +import PlutusLedgerApi.V1.Scripts qualified as Ledger (DatumHash, Script, ScriptHash (..)) +import PlutusLedgerApi.V1.Tx qualified import PlutusTx qualified @@ -50,7 +50,7 @@ import Control.Monad ((<=<)) import Plutus.Blockfrost.Types import Plutus.Blockfrost.Utils import Plutus.ChainIndex.Types qualified as CI -import Plutus.V2.Ledger.Api qualified as PV2 +import PlutusLedgerApi.V2 qualified as PV2 class FromJSON a => PlutusValidator a where @@ -257,7 +257,7 @@ processGetTxFromTxId (Just TxResponse{..}) = do datElems <- sequence newElems return $ fromList $ zip newKeys datElems - getAllRedeemersMap :: Map Integer (ValidationPurpose, ScriptDatum) -> IO Plutus.V1.Ledger.Tx.Redeemers + getAllRedeemersMap :: Map Integer (ValidationPurpose, ScriptDatum) -> IO PlutusLedgerApi.V1.Tx.Redeemers getAllRedeemersMap datumMap = do let indexs = keys datumMap st = map (toPlutusScriptTag . fst) (elems datumMap) diff --git a/pab-blockfrost/src/Plutus/Blockfrost/Utils.hs b/pab-blockfrost/src/Plutus/Blockfrost/Utils.hs index 150f58b1df..4bd51ac282 100644 --- a/pab-blockfrost/src/Plutus/Blockfrost/Utils.hs +++ b/pab-blockfrost/src/Plutus/Blockfrost/Utils.hs @@ -24,12 +24,12 @@ import Ledger.Tx.CardanoAPI hiding (fromCardanoAddressInEra) import Ledger.Value.CardanoAPI qualified as Value import Money (Approximation (Round), DecimalConf (..), SomeDiscrete, UnitScale, defaultDecimalConf, discreteToDecimal, scale, someDiscreteAmount, someDiscreteCurrency) -import Plutus.V1.Ledger.Address qualified as LA -import Plutus.V1.Ledger.Api (Credential (..), TxId (TxId), fromBuiltin, toBuiltin, unCurrencySymbol, unTokenName) -import Plutus.V1.Ledger.Api qualified (DatumHash, RedeemerHash) -import Plutus.V1.Ledger.Interval (always, from, interval, to) -import Plutus.V1.Ledger.Scripts qualified as PS -import Plutus.V1.Ledger.Value (AssetClass, unAssetClass) +import PlutusLedgerApi.V1 (Credential (..), TxId (TxId), fromBuiltin, toBuiltin, unCurrencySymbol, unTokenName) +import PlutusLedgerApi.V1 qualified (DatumHash, RedeemerHash) +import PlutusLedgerApi.V1.Address qualified as LA +import PlutusLedgerApi.V1.Interval (always, from, interval, to) +import PlutusLedgerApi.V1.Scripts qualified as PS +import PlutusLedgerApi.V1.Value (AssetClass, unAssetClass) class Show a => ToBlockfrostScriptHash a where @@ -44,8 +44,8 @@ class Show a => ToBlockfrostDatumHash a where toBlockfrostDatumHash :: a -> Blockfrost.DatumHash toBlockfrostDatumHash = fromString . show -instance ToBlockfrostDatumHash Plutus.V1.Ledger.Api.DatumHash -instance ToBlockfrostDatumHash Plutus.V1.Ledger.Api.RedeemerHash +instance ToBlockfrostDatumHash PlutusLedgerApi.V1.DatumHash +instance ToBlockfrostDatumHash PlutusLedgerApi.V1.RedeemerHash toBlockfrostTxHash :: TxId -> TxHash toBlockfrostTxHash = TxHash . pack . show diff --git a/plutus-chain-index-core/plutus-chain-index-core.cabal b/plutus-chain-index-core/plutus-chain-index-core.cabal index 4c801c01bd..8d006cf2d3 100644 --- a/plutus-chain-index-core/plutus-chain-index-core.cabal +++ b/plutus-chain-index-core/plutus-chain-index-core.cabal @@ -55,7 +55,6 @@ library Plutus.ChainIndex.Emulator.Handlers Plutus.ChainIndex.Emulator.Server Plutus.ChainIndex.Handlers - Plutus.ChainIndex.Marconi Plutus.ChainIndex.Server Plutus.ChainIndex.Tx Plutus.ChainIndex.TxIdState @@ -74,8 +73,6 @@ library , cardano-node-emulator >=1.2.0 , cardano-node-socket-emulator >=1.2.0 , freer-extras >=1.2.0 - , marconi-chain-index >=1.2.0 - , marconi-core >=1.2.0 , plutus-ledger >=1.2.0 , plutus-script-utils >=1.2.0 @@ -83,10 +80,12 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 + , cardano-crypto-class , iohk-monitoring , ouroboros-network , ouroboros-network-framework + , ouroboros-network-protocols , plutus-core >=1.0.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 @@ -142,26 +141,23 @@ test-suite plutus-chain-index-test Plutus.ChainIndex.Emulator.DiskStateSpec Plutus.ChainIndex.Emulator.HandlersSpec Plutus.ChainIndex.HandlersSpec - Plutus.ChainIndex.MarconiSpec Util -------------------- -- Local components -------------------- build-depends: - , cardano-node-emulator >=1.2.0 - , freer-extras >=1.2.0 - , marconi-chain-index:{marconi-chain-index, marconi-chain-index-test-lib} >=1.2.0 - , marconi-core >=1.2.0 - , plutus-chain-index-core >=1.2.0 - , plutus-ledger >=1.2.0 - , plutus-script-utils >=1.2.0 + , cardano-node-emulator >=1.2.0 + , freer-extras >=1.2.0 + , plutus-chain-index-core >=1.2.0 + , plutus-ledger >=1.2.0 + , plutus-script-utils >=1.2.0 -------------------------- -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} >=1.35 + , cardano-api:{cardano-api, gen} >=8.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 diff --git a/plutus-chain-index-core/src/Cardano/Protocol/Socket/Client.hs b/plutus-chain-index-core/src/Cardano/Protocol/Socket/Client.hs index a8b5298433..753c51770a 100644 --- a/plutus-chain-index-core/src/Cardano/Protocol/Socket/Client.hs +++ b/plutus-chain-index-core/src/Cardano/Protocol/Socket/Client.hs @@ -14,7 +14,7 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text, pack) import GHC.Generics (Generic) -import Cardano.Api (BlockInMode (..), CardanoMode, ChainPoint (..), ChainTip (..), ConsensusModeParams (..), +import Cardano.Api (BlockInMode (..), CardanoMode, ChainPoint (..), ChainTip (..), ConsensusModeParams (..), File (..), LocalChainSyncClient (..), LocalNodeClientProtocols (..), LocalNodeClientProtocolsInMode, LocalNodeConnectInfo (..), NetworkId, connectToLocalNode) import Cardano.BM.Data.Trace (Trace) @@ -104,7 +104,7 @@ runChainSync socketPath trace slotConfig networkId resumePoints onChainSyncEvent localNodeConnectInfo = LocalNodeConnectInfo { localConsensusModeParams = CardanoModeParams epochSlots, localNodeNetworkId = networkId, - localNodeSocketPath = socketPath } + localNodeSocketPath = File socketPath } localNodeClientProtocols :: LocalNodeClientProtocolsInMode CardanoMode localNodeClientProtocols = LocalNodeClientProtocols { localChainSyncClient = diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs index 6aff85bfd7..6d248e7a38 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Api.hs @@ -32,15 +32,15 @@ import Data.OpenApi qualified as OpenApi import Data.Proxy (Proxy (..)) import GHC.Generics (Generic) import Ledger.Address (CardanoAddress) -import Ledger.Credential (Credential) import Ledger.Tx (DatumFromQuery, DecoratedTxOut, TxOutRef, Versioned) import Plutus.ChainIndex.Tx (ChainIndexTx) import Plutus.ChainIndex.Types (Diagnostics, Tip) -import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), - PubKeyHash, Redeemer, RedeemerHash (RedeemerHash), StakeValidator (StakeValidator), - StakeValidatorHash (StakeValidatorHash), StakingCredential, TxId, Validator, - ValidatorHash (ValidatorHash)) -import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) +import Plutus.Script.Utils.Scripts (MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), + StakeValidator (StakeValidator), StakeValidatorHash (StakeValidatorHash), Validator, + ValidatorHash (ValidatorHash)) +import PlutusLedgerApi.V1 (Datum, DatumHash, PubKeyHash, Redeemer, RedeemerHash (RedeemerHash), StakingCredential, TxId) +import PlutusLedgerApi.V1.Credential (Credential) +import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) import Servant qualified import Servant.API (Description, Get, JSON, NoContent, Post, Put, ReqBody, (:<|>), (:>)) import Servant.OpenApi (toOpenApi) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexLog.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexLog.hs index 5e92f99c85..e9dffae23b 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexLog.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexLog.hs @@ -13,7 +13,7 @@ import Plutus.ChainIndex.ChainIndexError (ChainIndexError) import Plutus.ChainIndex.Tx (ChainIndexTxOut) import Plutus.ChainIndex.Types (Tip (..)) import Plutus.Contract.CardanoAPI (FromCardanoError (..)) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) import Prettyprinter (Pretty (..), colon, viaShow, (<+>)) data ChainIndexLog = diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs index 46b241109e..dca9357256 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Client.hs @@ -41,8 +41,9 @@ import Plutus.ChainIndex.Api (API, IsUtxoResponse, QueryAtAddressRequest (QueryA import Plutus.ChainIndex.Effects (ChainIndexQueryEffect (..)) import Plutus.ChainIndex.Tx (ChainIndexTx) import Plutus.ChainIndex.Types (Tip) -import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, - StakeValidatorHash, TxId, Validator, ValidatorHash) +import Plutus.Script.Utils.Scripts (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, + StakeValidator, StakeValidatorHash, Validator, ValidatorHash) +import PlutusLedgerApi.V1 (TxId) import Servant (NoContent, (:<|>) (..)) import Servant.Client (ClientEnv, ClientError (..), ClientM, client, runClientM) import Servant.Client.Core.Response (ResponseF (..)) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs index 30347c83ba..a3a270ace7 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/DbSchema.hs @@ -29,7 +29,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL import Data.Coerce (coerce) import Data.Either (fromRight) -import Data.Kind (Constraint) +import Data.Kind (Constraint, Type) import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) import Data.Word (Word64) import Database.Beam (Beamable, Columnar, Database, DatabaseSettings, FromBackendRow, Generic, Identity, Table (..), @@ -37,16 +37,16 @@ import Database.Beam (Beamable, Columnar, Database, DatabaseSettings, FromBacken import Database.Beam.Migrate (CheckedDatabaseSettings, defaultMigratableDbSettings, renameCheckedEntity, unCheckDatabase) import Database.Beam.Sqlite (Sqlite) -import Ledger (BlockId (..), DecoratedTxOut (..), Slot, Versioned) +import Ledger (BlockId (..), Credential, Datum, DatumHash (..), DecoratedTxOut (..), MintingPolicy, + MintingPolicyHash (..), Redeemer, RedeemerHash (..), Script, Slot, StakeValidator, + StakeValidatorHash (..), TxOutRef (..), Validator, ValidatorHash (..), Versioned) import Plutus.ChainIndex.Tx (ChainIndexTx) import Plutus.ChainIndex.Tx qualified as CI import Plutus.ChainIndex.Types (BlockNumber (..), Tip (..)) -import Plutus.V1.Ledger.Api (Credential, Datum, DatumHash (..), MintingPolicy, MintingPolicyHash (..), Redeemer, - RedeemerHash (..), Script, StakeValidator, StakeValidatorHash (..), TxId (..), - TxOutRef (..), Validator, ValidatorHash (..)) -import Plutus.V1.Ledger.Scripts (ScriptHash (..)) -import Plutus.V1.Ledger.Value (AssetClass) +import PlutusLedgerApi.V1 (TxId (..)) +import PlutusLedgerApi.V1.Scripts (ScriptHash (..)) +import PlutusLedgerApi.V1.Value (AssetClass) import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.Builtins.Internal (BuiltinByteString (..), emptyByteString) @@ -193,7 +193,7 @@ data Db f = Db , unmatchedInputRows :: f (TableEntity UnmatchedInputRowT) } deriving (Generic, Database be) -type AllTables (c :: * -> Constraint) f = +type AllTables (c :: Type -> Constraint) f = ( c (f (TableEntity DatumRowT)) , c (f (TableEntity ScriptRowT)) , c (f (TableEntity RedeemerRowT)) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs index 5649a7d454..284db55507 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs @@ -38,9 +38,10 @@ import Ledger.Tx (DecoratedTxOut, TxOutRef, Versioned) import Plutus.ChainIndex.Api (IsUtxoResponse, QueryResponse, TxosResponse, UtxosResponse) import Plutus.ChainIndex.Tx (ChainIndexTx) import Plutus.ChainIndex.Types (ChainSyncBlock, Diagnostics, Point, Tip) -import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, - StakeValidatorHash, TxId, Validator, ValidatorHash) -import Plutus.V1.Ledger.Value (AssetClass) +import Plutus.Script.Utils.Scripts (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, + StakeValidator, StakeValidatorHash, Validator, ValidatorHash) +import PlutusLedgerApi.V1 (TxId) +import PlutusLedgerApi.V1.Value (AssetClass) data ChainIndexQueryEffect r where diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs index a4829218cb..a52af10510 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/DiskState.hs @@ -35,12 +35,12 @@ import Data.Set (Set) import Data.Set qualified as Set import GHC.Generics (Generic) import Ledger (Datum, DatumHash, Redeemer, RedeemerHash, Script, ScriptHash, TxOutRef, cardanoAddressCredential) -import Ledger.Credential (Credential) import Ledger.Tx (Versioned) import Plutus.ChainIndex.Tx (ChainIndexTx, ChainIndexTxOut (..), citxData, citxScripts, citxTxId, txOutsWithRef, txRedeemersWithHash) import Plutus.ChainIndex.Types (Diagnostics (..)) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) +import PlutusLedgerApi.V1.Credential (Credential) -- | Set of transaction output references for each address. newtype CredentialMap = CredentialMap { _unCredentialMap :: Map Credential (Set TxOutRef) } diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs index 8f01cd7fc0..39d7ef4b74 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs @@ -56,12 +56,11 @@ import Plutus.ChainIndex.Types (ChainIndexTx, ChainIndexTxOut (..), ChainSyncBlo fromReferenceScript) import Plutus.ChainIndex.UtxoState (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex, tip, utxoState) import Plutus.ChainIndex.UtxoState qualified as UtxoState -import Plutus.Script.Utils.Scripts (datumHash) -import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), Datum, DatumHash, - MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), Script, - StakeValidator (StakeValidator), StakeValidatorHash (StakeValidatorHash), TxId, - Validator (Validator), ValidatorHash (ValidatorHash)) -import Plutus.V2.Ledger.Api (OutputDatum (..)) +import Plutus.Script.Utils.Scripts (MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), Script, + StakeValidator (StakeValidator), StakeValidatorHash (StakeValidatorHash), + Validator (Validator), ValidatorHash (ValidatorHash), datumHash) +import PlutusLedgerApi.V1 (Credential (PubKeyCredential, ScriptCredential), Datum, DatumHash, TxId) +import PlutusLedgerApi.V2 (OutputDatum (..)) data ChainIndexEmulatorState = ChainIndexEmulatorState @@ -146,7 +145,7 @@ makeChainIndexTxOut txout@(ChainIndexTxOut address value datum refScript) = do -- We need to handle them differently. case cardanoAddressCredential $ citoAddress txout of PubKeyCredential _ -> pure $ L.mkPubkeyDecoratedTxOut address value datumWithHash script - ScriptCredential (ValidatorHash h) -> do + ScriptCredential (ScriptHash h) -> do case datumWithHash of Just d -> do v <- getScriptFromHash (ScriptHash h) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs index dffd4cdecc..bc59669a36 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Handlers.hs @@ -66,7 +66,7 @@ import Plutus.ChainIndex.UtxoState qualified as UtxoState import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Scripts (datumHash) import Plutus.Script.Utils.Value (AssetClass (AssetClass), flattenValue) -import Plutus.V2.Ledger.Api (Credential (..), TxId) +import PlutusLedgerApi.V2 (Credential (..), TxId) import PlutusTx.Builtins.Internal (emptyByteString) type ChainIndexState = UtxoIndex TxUtxoBalance diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Marconi.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Marconi.hs deleted file mode 100644 index 08e4b8bc9a..0000000000 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Marconi.hs +++ /dev/null @@ -1,212 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - -module Plutus.ChainIndex.Marconi where - -import Cardano.Api (AddressInEra (AddressInEra), AddressTypeInEra (..), TxIx (TxIx), toAddressAny) -import Cardano.Api qualified as C -import Cardano.BM.Trace (Trace) -import Control.Concurrent (MVar, newMVar, putMVar, takeMVar) -import Control.Lens (Lens', _1, folded, makeLenses, views, (&), (.~), (^.), (^..)) -import Control.Monad.Freer (Eff, LastMember, Member, interpret, type (~>)) -import Control.Monad.Freer.Error (Error, runError, throwError) -import Control.Monad.Freer.Extras -import Control.Monad.Freer.Extras.Pagination (PageQuery, pageOf) -import Control.Monad.Freer.Reader (Reader, ask, runReader) -import Control.Monad.Freer.State qualified as Eff (State, get, put, runState) -import Control.Monad.Freer.TH (makeEffect) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.Foldable (foldl') -import Data.Map (elems) -import Data.Set qualified as Set -import Ledger.Address (CardanoAddress) -import Ledger.Tx (CardanoTx (CardanoTx)) -import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (UtxoEvent), StorableQuery (UtxoByAddress), UtxoHandle, - getInputs, getUtxoResult, getUtxosFromTxBody, txId, txIx, urUtxo) -import Marconi.Core.Storable (HasPoint, QueryInterval (QEverything), Queryable, State, StorableMonad, StorablePoint, - StorableResult, insertMany, query) -import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse)) -import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..)) -import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog) -import Plutus.ChainIndex.Compatibility (toCardanoPoint) -import Plutus.ChainIndex.Effects (ChainIndexControlEffect (AppendBlocks), ChainIndexQueryEffect (UtxoSetAtAddress)) -import Plutus.ChainIndex.Types (ChainSyncBlock (..), Tip (TipAtGenesis), citxCardanoTx, tipAsPoint) -import Plutus.Contract.CardanoAPI (fromCardanoTxId) -import Plutus.Monitoring.Util (PrettyObject (PrettyObject), convertLog, runLogEffects) -import Plutus.V2.Ledger.Api (TxOutRef (TxOutRef)) - -{- Handling ChainIndexEffects with Marconi - Developer notes: - - The general idea is to transform `ChainIndexQueryEffect` into a @MarconiEffect@ for an handler, - and to resolve these effects afterwards with a bunch of calls to `handleMarconiQuery`. - - The main reason for this is that we mutualise the code that queries the handlers (see @handleMarconiQuery@) and we have a - uniform way to query the different indexers. - - And a minor one: - - * There's no need of different handlers for @MarconiEffect@ at this stage but we leave the door open to it. - A possible use case might be to provide a simpler indexer backend for the emulator. - - How to add new indexer to support new effect? - - 1. add the indexer MVar to `ChainIndexIndexersMvar` and the corresponding indexer to `ChainIndexIndexers` - 2. edit `getChainIndexIndexers` and `putChainIndexIndexers` accordingly - 3. handle the appropriate queries of `ChainIndexQueries` in `handleQuery` - 4. Add the indexer update in the control operations --} - -data ChainIndexIndexers -- We don't use `newtype` since other indexers will be needed - = ChainIndexIndexers - { _utxosIndexer :: State UtxoHandle - } - -makeLenses ''ChainIndexIndexers - -data ChainIndexIndexersMVar -- We don't use `newtype` since other indexers will be needed - = ChainIndexIndexersMVar - { _utxosIndexerMVar :: MVar (State UtxoHandle) - } - -boxChainIndexIndexers :: ChainIndexIndexers -> IO ChainIndexIndexersMVar -boxChainIndexIndexers ci = - ChainIndexIndexersMVar <$> - (newMVar $ ci ^. utxosIndexer) - -makeLenses ''ChainIndexIndexersMVar - -getChainIndexIndexers :: ChainIndexIndexersMVar -> IO ChainIndexIndexers -getChainIndexIndexers mvarCi = - ChainIndexIndexers <$> takeMVar (mvarCi ^. utxosIndexerMVar) - -putChainIndexIndexers :: ChainIndexIndexers -> ChainIndexIndexersMVar -> IO () -putChainIndexIndexers ci mvarCi = do - putMVar (mvarCi ^. utxosIndexerMVar) (ci ^. utxosIndexer) - - - -data MarconiEffect handle r where - QueryIndexer :: StorableQuery handle -> MarconiEffect handle (StorableResult handle) - -makeEffect ''MarconiEffect - -handleMarconiQuery :: - ( LastMember IO effs - , Member (Eff.State ChainIndexIndexers) effs - , StorableMonad handle ~ IO - , HasPoint (StorableEvent handle) (StorablePoint handle) - , Ord (StorablePoint handle) - , Queryable handle - ) - => Lens' ChainIndexIndexers (State handle) -> MarconiEffect handle ~> Eff effs -handleMarconiQuery l (QueryIndexer q) = do - ci <- Eff.get - liftIO $ query QEverything (ci ^. l) q - -getUtxoSetAtAddress - :: forall effs. - ( Member (MarconiEffect UtxoHandle) effs - ) - => PageQuery TxOutRef - -> CardanoAddress - -> Eff effs UtxosResponse -getUtxoSetAtAddress pageQuery addrInEra = let - toTxOutRef utxo = TxOutRef - (fromCardanoTxId $ utxo ^. txId) - (toInteger . (\(TxIx x) -> x) $ utxo ^. txIx) - addr = case addrInEra of - AddressInEra ByronAddressInAnyEra addr' -> toAddressAny addr' - AddressInEra (ShelleyAddressInEra _) addr' -> toAddressAny addr' - in UtxosResponse TipAtGenesis - . pageOf pageQuery - . Set.fromList - . fmap (views urUtxo toTxOutRef) - . getUtxoResult - <$> queryIndexer (UtxoByAddress addr Nothing) - - -getUtxoEvents - :: [CardanoTx] - -> C.ChainPoint - -> StorableEvent UtxoHandle -- ^ UtxoEvents are stored in storage after conversion to UtxoRow -getUtxoEvents txs cp = - let utxosFromCardanoTx (CardanoTx (C.Tx txBody _) _) = elems $ getUtxosFromTxBody Nothing txBody - inputsFromCardanoTx (CardanoTx (C.Tx txBody _) _) = getInputs txBody - utxos = Set.fromList $ concatMap utxosFromCardanoTx txs - ins = foldl' Set.union Set.empty $ inputsFromCardanoTx <$> txs - in UtxoEvent utxos ins cp - --- | The required arguments to run the chain index effects. -data RunRequirements = RunRequirements - { trace :: !(Trace IO (PrettyObject ChainIndexLog)) - , indexers :: !ChainIndexIndexersMVar - } - - --- | Run the chain index effects. -runChainIndexEffects - :: RunRequirements - -> Eff '[ChainIndexQueryEffect, ChainIndexControlEffect] a - -> IO (Either ChainIndexError a) -runChainIndexEffects runReq action = - runLogEffects (convertLog PrettyObject $ trace runReq) - $ runReader (indexers runReq) - $ handleChainIndexEffects - $ raiseEnd action - -handleControl :: - ( LastMember IO effs - , Member (Eff.State ChainIndexIndexers) effs - , Member (Error ChainIndexError) effs - ) => - ChainIndexControlEffect ~> Eff effs -handleControl = \case - AppendBlocks xs -> do - ci <- Eff.get - utxosIndexer' <- liftIO $ insertMany (extractUtxosEvent <$> xs) (ci ^. utxosIndexer) - Eff.put (ci & utxosIndexer .~ utxosIndexer') - _other -> throwError UnsupportedControlOperation - where - extractUtxosEvent Block{blockTip,blockTxs} = let - point = toCardanoPoint $ tipAsPoint blockTip - in getUtxoEvents - (blockTxs ^.. folded . _1 . citxCardanoTx . folded) - point - -handleQuery :: - ( LastMember IO effs - , Member (Eff.State ChainIndexIndexers) effs - , Member (Error ChainIndexError) effs - ) => ChainIndexQueryEffect - ~> Eff effs -handleQuery = \case - UtxoSetAtAddress pageQuery addr -> - interpret (handleMarconiQuery utxosIndexer) $ getUtxoSetAtAddress pageQuery addr - _eff -> throwError UnsupportedQuery - --- | Handle the chain index effects from the set of all effects. -handleChainIndexEffects :: - ( LastMember IO effs - , Member (Reader ChainIndexIndexersMVar) effs - ) - => Eff (ChainIndexQueryEffect ': ChainIndexControlEffect ': effs) a - -> Eff effs (Either ChainIndexError a) -handleChainIndexEffects action = do - mIndexers <- ask - indexers <- liftIO $ getChainIndexIndexers mIndexers - (result, indexers') <- Eff.runState indexers - $ runError @ChainIndexError - $ interpret handleControl - $ interpret handleQuery - $ raiseMUnderN @[_,_] @[_,_] action - liftIO $ putChainIndexIndexers indexers' mIndexers - pure result diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs index 1ab304365d..a0ba8f015b 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs @@ -49,7 +49,7 @@ import Ledger.Scripts (Redeemer, RedeemerHash) import Plutus.ChainIndex.Types import Plutus.Contract.CardanoAPI (fromCardanoTx) import Plutus.Script.Utils.Scripts (redeemerHash) -import Plutus.V2.Ledger.Api (Address (..), OutputDatum (..), Value (..)) +import PlutusLedgerApi.V2 (Address (..), OutputDatum (..), Value (..)) -- | Get tx outputs from tx. txOuts :: ChainIndexTx -> [ChainIndexTxOut] diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs index 594d890f1c..e030128fbd 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs @@ -27,7 +27,7 @@ import Plutus.ChainIndex.Types (BlockNumber (..), Depth (..), Point (..), Rollba TxConfirmedState (..), TxIdState (..), TxStatus, TxStatusFailure (..), TxValidity (..)) import Plutus.ChainIndex.UtxoState (RollbackFailed (..), RollbackResult (..), UtxoIndex, UtxoState (..), rollbackWith, tip, utxoState, viewTip) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) -- | The 'TxStatus' of a transaction right after it was added to the chain initialStatus :: OnChainTx -> TxStatus diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs index 53366fc8a9..0478b03513 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs @@ -91,16 +91,17 @@ import Data.Set qualified as Set import Data.Typeable (Proxy (Proxy), Typeable) import Data.Word (Word64) import GHC.Generics (Generic) -import Ledger (CardanoAddress, CardanoTx, Language, SlotRange, TxOutRef (..), Versioned, toPlutusAddress) +import Ledger (CardanoAddress, CardanoTx, Language, Script, SlotRange, TxOutRef (..), Validator (Validator), Versioned, + toPlutusAddress) import Ledger.Blockchain (BlockId (..)) import Ledger.Blockchain qualified as Ledger import Ledger.Slot (Slot (Slot)) import Ledger.Tx.CardanoAPI (fromCardanoScriptInAnyLang) -import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script, ScriptHash (..)) -import Plutus.V1.Ledger.Tx (RedeemerPtr, Redeemers, ScriptTag, TxId (TxId)) -import Plutus.V2.Ledger.Api (CurrencySymbol (CurrencySymbol), Extended, Interval (..), LowerBound, OutputDatum (..), - Redeemer (Redeemer), TokenName (TokenName), UpperBound, Validator (Validator), Value (..)) import PlutusCore.Data +import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash), ScriptHash (..)) +import PlutusLedgerApi.V1.Tx (RedeemerPtr, Redeemers, ScriptTag, TxId (TxId)) +import PlutusLedgerApi.V2 (CurrencySymbol (CurrencySymbol), Extended, Interval (..), LowerBound, OutputDatum (..), + Redeemer (Redeemer), TokenName (TokenName), UpperBound, Value (..)) import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Builtins.Internal (BuiltinData (..)) import PlutusTx.Lattice (MeetSemiLattice (..)) @@ -126,10 +127,10 @@ instance Serialise C.ScriptInAnyLang where let -- Since lang is a GADT we have to encode the script in all branches other = case lang of - C.SimpleScriptLanguage C.SimpleScriptV1 -> encodeWord 0 <> encode (C.serialiseToCBOR script) - C.SimpleScriptLanguage C.SimpleScriptV2 -> encodeWord 1 <> encode (C.serialiseToCBOR script) - C.PlutusScriptLanguage C.PlutusScriptV1 -> encodeWord 2 <> encode (C.serialiseToCBOR script) - C.PlutusScriptLanguage C.PlutusScriptV2 -> encodeWord 3 <> encode (C.serialiseToCBOR script) + C.SimpleScriptLanguage -> encodeWord 0 <> encode (C.serialiseToCBOR script) + C.PlutusScriptLanguage C.PlutusScriptV1 -> encodeWord 1 <> encode (C.serialiseToCBOR script) + C.PlutusScriptLanguage C.PlutusScriptV2 -> encodeWord 2 <> encode (C.serialiseToCBOR script) + C.PlutusScriptLanguage C.PlutusScriptV3 -> encodeWord 3 <> encode (C.serialiseToCBOR script) in encodeListLen 2 <> other decode = do len <- decodeListLen @@ -137,17 +138,17 @@ instance Serialise C.ScriptInAnyLang where script <- decode case (len, langWord) of (2, 0) -> do - let decoded = either (error "Failed to deserialise AsSimpleScriptV1 from CBOR ") id (C.deserialiseFromCBOR (C.AsScript C.AsSimpleScriptV1) script) - pure $ C.ScriptInAnyLang (C.SimpleScriptLanguage C.SimpleScriptV1) decoded + let decoded = either (error "Failed to deserialise AsSimpleScriptV1 from CBOR ") id (C.deserialiseFromCBOR (C.AsScript C.AsSimpleScript) script) + pure $ C.ScriptInAnyLang C.SimpleScriptLanguage decoded (2, 1) -> do - let decoded = either (error "Failed to deserialise AsSimpleScriptV2 from CBOR ") id (C.deserialiseFromCBOR (C.AsScript C.AsSimpleScriptV2) script) - pure $ C.ScriptInAnyLang (C.SimpleScriptLanguage C.SimpleScriptV2) decoded - (2, 2) -> do let decoded = either (error "Failed to deserialise AsPlutusScriptV1 from CBOR ") id (C.deserialiseFromCBOR (C.AsScript C.AsPlutusScriptV1) script) pure $ C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV1) decoded - (2, 3) -> do + (2, 2) -> do let decoded = either (error "Failed to deserialise AsPlutusScriptV2 from CBOR ") id (C.deserialiseFromCBOR (C.AsScript C.AsPlutusScriptV2) script) pure $ C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV2) decoded + (2, 3) -> do + let decoded = either (error "Failed to deserialise AsPlutusScriptV3 from CBOR ") id (C.deserialiseFromCBOR (C.AsScript C.AsPlutusScriptV3) script) + pure $ C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV3) decoded _ -> fail "Invalid ScriptInAnyLang encoding" instance OpenApi.ToSchema C.ScriptInAnyLang where @@ -237,8 +238,6 @@ data ChainIndexTxOutputs = | ValidTx [ChainIndexTxOut] deriving (Show, Eq, Generic, ToJSON, FromJSON, Serialise, OpenApi.ToSchema) -makePrisms ''ChainIndexTxOutputs - chainIndexTxOutputs :: Traversal' ChainIndexTxOutputs ChainIndexTxOut chainIndexTxOutputs = traversal go where @@ -299,7 +298,6 @@ data ChainIndexTx = ChainIndexTx { -- are in the emulator. } deriving (Show, Eq, Generic, ToJSON, FromJSON, Serialise, OpenApi.ToSchema) -makeLenses ''ChainIndexTx instance Pretty ChainIndexTx where pretty ChainIndexTx{_citxTxId, _citxInputs, _citxOutputs = ValidTx outputs, _citxValidRange, _citxData, _citxRedeemers, _citxScripts} = @@ -353,7 +351,6 @@ data Tip = deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, OpenApi.ToSchema) -makePrisms ''Tip -- | When performing a rollback the chain sync protocol does not provide a block -- number where to resume from. @@ -366,7 +363,6 @@ data Point = deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) -makePrisms ''Point instance Ord Point where PointAtGenesis <= _ = True @@ -606,7 +602,6 @@ instance Monoid TxOutBalance where mappend = (<>) mempty = TxOutBalance mempty mempty -makeLenses ''TxOutBalance -- | The effect of a transaction (or a number of them) on the utxo set. data TxUtxoBalance = @@ -619,7 +614,6 @@ data TxUtxoBalance = deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON, ToJSON, Serialise) -makeLenses ''TxUtxoBalance instance Semigroup TxUtxoBalance where l <> r = @@ -656,3 +650,10 @@ data ChainSyncBlock = Block , blockTxs :: [(ChainIndexTx, TxProcessOption)] } deriving (Show) + +makeLenses ''ChainIndexTx +makePrisms ''ChainIndexTxOutputs +makePrisms ''Tip +makePrisms ''Point +makeLenses ''TxOutBalance +makeLenses ''TxUtxoBalance diff --git a/plutus-chain-index-core/test/Generators.hs b/plutus-chain-index-core/test/Generators.hs index 412f2a95ea..3059734b55 100644 --- a/plutus-chain-index-core/test/Generators.hs +++ b/plutus-chain-index-core/test/Generators.hs @@ -51,7 +51,6 @@ import Hedgehog (Gen, MonadGen) import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Ledger.Address (CardanoAddress, PaymentPubKey (PaymentPubKey), pubKeyAddress) -import Ledger.Interval qualified as Interval import Ledger.Slot (Slot (Slot)) import Ledger.Tx (TxOutRef (TxOutRef)) import Ledger.Tx.CardanoAPI (toCardanoAddressInEra) @@ -63,7 +62,8 @@ import Plutus.ChainIndex.TxOutBalance qualified as TxOutBalance import Plutus.ChainIndex.TxUtxoBalance qualified as TxUtxoBalance import Plutus.ChainIndex.Types (BlockId (BlockId), BlockNumber (BlockNumber), Tip (Tip, tipBlockId, tipBlockNo, tipSlot), TxIdState, TxOutBalance, TxUtxoBalance) -import Plutus.V1.Ledger.Api (TxId (..)) +import PlutusLedgerApi.V1 (TxId (..)) +import PlutusLedgerApi.V1.Interval qualified as Interval import PlutusTx.Prelude qualified as PlutusTx -- | Generate a random tx id diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs index 8a66585923..d8568037d1 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/Emulator/HandlersSpec.hs @@ -28,7 +28,7 @@ import Plutus.ChainIndex.ChainIndexError (ChainIndexError) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect, getTip) import Plutus.ChainIndex.Emulator.Handlers (ChainIndexEmulatorState, handleControl, handleQuery) import Plutus.ChainIndex.Tx (ChainIndexTxOut (citoValue), txOuts) -import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) +import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) import Hedgehog (Property, assert, forAll, property, (===)) import Ledger.Tx.CardanoAPI (fromCardanoAssetId) diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs index 331b193789..24cc1a9da5 100644 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs +++ b/plutus-chain-index-core/test/Plutus/ChainIndex/HandlersSpec.hs @@ -34,7 +34,7 @@ import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse), isUtxo) import Plutus.ChainIndex.DbSchema (checkedSqliteDb) import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect, getTip) import Plutus.Script.Utils.Ada qualified as Ada -import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) +import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) import Util (utxoSetFromBlockAddrs) diff --git a/plutus-chain-index-core/test/Plutus/ChainIndex/MarconiSpec.hs b/plutus-chain-index-core/test/Plutus/ChainIndex/MarconiSpec.hs deleted file mode 100644 index 1a7ac95ee3..0000000000 --- a/plutus-chain-index-core/test/Plutus/ChainIndex/MarconiSpec.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TupleSections #-} -module Plutus.ChainIndex.MarconiSpec (tests) where - -import Control.Monad.IO.Class (MonadIO, liftIO) - -import Hedgehog.Internal.Property (Property, forAll, property) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (testPropertyNamed) - -import Cardano.Api qualified as C -import Control.Concurrent (readMVar) -import Control.Lens (_1, folded, to, toListOf, (^.), (^..), (^?)) -import Control.Monad (void) -import Control.Tracer (nullTracer) -import Data.Default (def) -import Gen.Marconi.ChainIndex.Mockchain (MockBlock (MockBlock), genMockchain) -import Hedgehog (Gen) -import Hedgehog qualified -import Ledger.Tx (TxOutRef) -import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (..), UtxoHandle) -import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo -import Marconi.Core.Storable qualified as Storable -import Plutus.ChainIndex (ChainIndexTxOut, ChainSyncBlock (Block), appendBlocks, citoAddress, citxInputs, citxOutputs, - utxoSetAtAddress) -import Plutus.ChainIndex.Compatibility (tipFromCardanoBlockHeader) -import Plutus.ChainIndex.Marconi (ChainIndexIndexers (ChainIndexIndexers), ChainIndexIndexersMVar, - RunRequirements (RunRequirements), boxChainIndexIndexers, runChainIndexEffects, - utxosIndexerMVar) -import Plutus.ChainIndex.Types (ChainSyncBlock (blockTxs), chainIndexTxOutputs) -import Plutus.Contract.CardanoAPI (fromCardanoTx) - -tests :: TestTree -tests = testGroup "Plutus.ChainIndex.MarconiSpec" - [ testGroup "testSetAtAddress" - [ testPropertyNamed "Indexer do store blocks txOuts" "checkTxOutStorage" - checkTxOutStorage - , testPropertyNamed "Indexer do store blocks txIn" "checkTxInStorage" - checkTxInStorage - ] - ] - -genBlocks :: Gen [ChainSyncBlock] -genBlocks = fmap fromMockBlock <$> genMockchain - where - fromMockBlock :: MockBlock C.BabbageEra -> ChainSyncBlock - fromMockBlock (MockBlock header txs) = - Block - (tipFromCardanoBlockHeader header) - ((,def) . fromCardanoTx C.BabbageEraInCardanoMode <$> txs) - -newChainIndexIndexers :: IO ChainIndexIndexersMVar -newChainIndexIndexers = do - indexers <- ChainIndexIndexers - <$> Utxo.open ":memory:" (Utxo.Depth 10) False -- do not perfrom SQLite vacuum, see: https://www.sqlite.org/lang_vacuum.html - boxChainIndexIndexers indexers - -getUtxoEvents :: MonadIO m => ChainIndexIndexersMVar -> m [StorableEvent UtxoHandle] -getUtxoEvents indexers = - liftIO $ readMVar (indexers ^. utxosIndexerMVar) >>= Storable.getEvents - -allTxOuts :: ChainSyncBlock -> [ChainIndexTxOut] -allTxOuts = - toListOf (to blockTxs . folded . _1 . citxOutputs . chainIndexTxOutputs) - -allTxIns :: ChainSyncBlock -> [TxOutRef] -allTxIns = - toListOf (to blockTxs . folded . _1 . citxInputs . folded) - - -checkTxOutStorage :: Property -checkTxOutStorage = property $ do - blocks <- forAll genBlocks - indexers <- liftIO newChainIndexIndexers - let txOutAddr = blocks ^? folded . to blockTxs . folded . _1 - . citxOutputs . chainIndexTxOutputs . to citoAddress - maybe - Hedgehog.success - (\addr -> do - void $ liftIO $ runChainIndexEffects (RunRequirements nullTracer indexers) $ do - appendBlocks blocks - utxoSetAtAddress def addr - events <- getUtxoEvents indexers - let originalTxOuts = blocks >>= allTxOuts - Hedgehog.annotateShow events - Hedgehog.annotateShow originalTxOuts - let eventUtxos = events ^.. folded . to ueUtxos . folded - length eventUtxos Hedgehog.=== length originalTxOuts - ) - txOutAddr - -checkTxInStorage :: Property -checkTxInStorage = property $ do - blocks <- forAll genBlocks - indexers <- liftIO newChainIndexIndexers - let txOutAddr = blocks ^? folded . to blockTxs . folded . _1 - . citxOutputs . chainIndexTxOutputs . to citoAddress - maybe - Hedgehog.success - (\addr -> do - void $ liftIO $ runChainIndexEffects (RunRequirements nullTracer indexers) $ do - appendBlocks blocks - utxoSetAtAddress def addr - events <- getUtxoEvents indexers - let originalTxIns = blocks >>= allTxIns - Hedgehog.annotateShow events - Hedgehog.annotateShow originalTxIns - let eventTxIns = events ^.. folded . to ueInputs . folded - length eventTxIns Hedgehog.=== length originalTxIns - ) - txOutAddr - diff --git a/plutus-chain-index-core/test/Spec.hs b/plutus-chain-index-core/test/Spec.hs index 81073b0a19..2dc9f3931a 100644 --- a/plutus-chain-index-core/test/Spec.hs +++ b/plutus-chain-index-core/test/Spec.hs @@ -39,8 +39,6 @@ import Plutus.ChainIndex.UtxoState qualified as UtxoState import Test.Tasty import Test.Tasty.Hedgehog (testPropertyNamed) -import Plutus.ChainIndex.MarconiSpec qualified as Marconi - main :: IO () main = defaultMain tests @@ -50,7 +48,6 @@ tests = [ testGroup "tx out balance" txOutBalanceTests , testGroup "utxo balance" utxoBalanceTests , testGroup "txidstate" txIdStateTests - , Marconi.tests , testPropertyNamed "lift tx output status to tx status" "txOutStatusTxStatusProp" txOutStatusTxStatusProp , testPropertyNamed "tx output status" "txOutStatusSpentUnspentProp" txOutStatusSpentUnspentProp , DiskStateSpec.tests diff --git a/plutus-chain-index/plutus-chain-index.cabal b/plutus-chain-index/plutus-chain-index.cabal index f172ef5b5f..d95619ba78 100644 --- a/plutus-chain-index/plutus-chain-index.cabal +++ b/plutus-chain-index/plutus-chain-index.cabal @@ -66,7 +66,7 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , iohk-monitoring , ouroboros-network , plutus-ledger-api >=1.0.0 diff --git a/plutus-contract-model/plutus-contract-model.cabal b/plutus-contract-model/plutus-contract-model.cabal index 550b658d22..cbdc455510 100644 --- a/plutus-contract-model/plutus-contract-model.cabal +++ b/plutus-contract-model/plutus-contract-model.cabal @@ -74,7 +74,7 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 , quickcheck-contractmodel >=0.1.4.0 diff --git a/plutus-contract-model/src/Plutus/Contract/Test/ContractModel/Internal.hs b/plutus-contract-model/src/Plutus/Contract/Test/ContractModel/Internal.hs index 81818cb413..67f44f3cc0 100644 --- a/plutus-contract-model/src/Plutus/Contract/Test/ContractModel/Internal.hs +++ b/plutus-contract-model/src/Plutus/Contract/Test/ContractModel/Internal.hs @@ -78,7 +78,7 @@ import Plutus.Contract.Test hiding (not) import Plutus.Trace.Effects.EmulatorControl (EmulatorControl, discardWallets) import Plutus.Trace.Emulator as Trace (BaseEmulatorEffects, EmulatorEffects, EmulatorTrace, activateContract, freezeContractInstance, waitNSlots) -import Plutus.V1.Ledger.Crypto +import PlutusLedgerApi.V1.Crypto import PlutusTx.Builtins qualified as Builtins import PlutusTx.Coverage hiding (_coverageIndex) import PlutusTx.ErrorCodes diff --git a/plutus-contract-model/test/Spec/ErrorChecking.hs b/plutus-contract-model/test/Spec/ErrorChecking.hs index 253d0c3544..34f9e6815f 100644 --- a/plutus-contract-model/test/Spec/ErrorChecking.hs +++ b/plutus-contract-model/test/Spec/ErrorChecking.hs @@ -29,7 +29,7 @@ import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.V1.Scripts (validatorHash) import Plutus.Script.Utils.V1.Typed.Scripts.Validators hiding (validatorHash) import Plutus.Trace.Emulator as Trace -import Plutus.V1.Ledger.Api (Datum (Datum), ScriptContext) +import PlutusLedgerApi.V1 (Datum (Datum), ScriptContext) import PlutusTx qualified import PlutusTx.IsData.Class import PlutusTx.Prelude hiding ((<$)) diff --git a/plutus-contract/plutus-contract.cabal b/plutus-contract/plutus-contract.cabal index 2332d7af1c..ff35d9c134 100644 --- a/plutus-contract/plutus-contract.cabal +++ b/plutus-contract/plutus-contract.cabal @@ -128,16 +128,16 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , cardano-crypto , cardano-crypto-class , cardano-ledger-alonzo , cardano-ledger-babbage , cardano-ledger-core , cardano-ledger-shelley - , plutus-core >=1.0.0 - , plutus-ledger-api >=1.0.0 - , plutus-tx >=1.0.0 + , plutus-core:{plutus-core, plutus-ir} >=1.0.0 + , plutus-ledger-api >=1.0.0 + , plutus-tx >=1.0.0 if !(impl(ghcjs) || os(ghcjs)) build-depends: plutus-tx-plugin >=1.0.0 @@ -146,12 +146,13 @@ library -- Non-IOG dependencies ------------------------ build-depends: - , aeson >=2 + , aeson >=2 , aeson-pretty - , base >=4.7 && <5 + , base >=4.7 && <5 , bytestring + , cardano-strict-containers , containers - , cryptonite >=0.25 + , cryptonite >=0.25 , data-default , directory , filepath @@ -167,16 +168,15 @@ library , mmorph , mtl , pretty - , prettyprinter >=1.1.0.1 + , prettyprinter >=1.1.0.1 , profunctors , QuickCheck - , row-types >=1.0.1.0 + , row-types >=1.0.1.0 , semigroupoids , serialise , servant , stm , streaming - , strict-containers , template-haskell , text , text-class @@ -265,12 +265,12 @@ test-suite plutus-contract-test -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} >=1.35 - , plutus-core >=1.0.0 - , plutus-ledger-api >=1.0.0 - , plutus-tx >=1.0.0 - , quickcheck-contractmodel >=0.1.4.0 - , quickcheck-dynamic >=3.0.2 + , cardano-api:{cardano-api, gen} >=8.0 + , plutus-core:{plutus-core, plutus-ir} >=1.0.0 + , plutus-ledger-api >=1.0.0 + , plutus-tx >=1.0.0 + , quickcheck-contractmodel >=0.1.4.0 + , quickcheck-dynamic >=3.0.2 if !(impl(ghcjs) || os(ghcjs)) build-depends: plutus-tx-plugin >=1.0.0 diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index 2d170f7fa5..f88a60b433 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -101,7 +101,6 @@ import GHC.Generics (Generic) import Ledger.Address (CardanoAddress, toPlutusAddress) import Ledger.Scripts (Validator) import Ledger.Slot (Slot, SlotRange) -import Ledger.Time (POSIXTime, POSIXTimeRange) import Ledger.Tx (CardanoTx, DecoratedTxOut, Versioned, getCardanoTxId) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) import Plutus.ChainIndex (Page (pageItems), PageQuery) @@ -109,9 +108,10 @@ import Plutus.ChainIndex.Api (IsUtxoResponse (IsUtxoResponse), QueryResponse (Qu TxosResponse (TxosResponse), UtxosResponse (UtxosResponse)) import Plutus.ChainIndex.Tx (ChainIndexTx (_citxTxId)) import Plutus.ChainIndex.Types (Tip, TxOutStatus, TxStatus) -import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, - StakeValidatorHash, TxId, TxOutRef, ValidatorHash) -import Plutus.V1.Ledger.Value (AssetClass) +import PlutusLedgerApi.V1 (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, + StakeValidatorHash, TxId, TxOutRef, ValidatorHash) +import PlutusLedgerApi.V1.Time (POSIXTime, POSIXTimeRange) +import PlutusLedgerApi.V1.Value (AssetClass) import Prettyprinter (Pretty (pretty), hsep, indent, viaShow, vsep, (<+>)) import Wallet.Error (WalletAPIError) import Wallet.Types (ContractInstanceId, EndpointDescription, EndpointValue) diff --git a/plutus-contract/src/Plutus/Contract/Oracle.hs b/plutus-contract/src/Plutus/Contract/Oracle.hs index 425f2432ed..9e351ded35 100644 --- a/plutus-contract/src/Plutus/Contract/Oracle.hs +++ b/plutus-contract/src/Plutus/Contract/Oracle.hs @@ -68,9 +68,9 @@ import Ledger.Tx.Constraints (TxConstraints) import Ledger.Tx.Constraints qualified as Constraints import Ledger.Tx.Constraints.OnChain.V2 qualified as Constraints import Plutus.Script.Utils.Scripts qualified as Scripts -import Plutus.V1.Ledger.Bytes (LedgerBytes (LedgerBytes)) -import Plutus.V1.Ledger.Time (POSIXTime) -import Plutus.V2.Ledger.Contexts (ScriptContext) +import PlutusLedgerApi.V1.Bytes (LedgerBytes (LedgerBytes)) +import PlutusLedgerApi.V1.Time (POSIXTime) +import PlutusLedgerApi.V2.Contexts (ScriptContext) import Prelude qualified as Haskell @@ -101,6 +101,9 @@ data Observation a = Observation -- ^ The time at which the value was observed } deriving (Generic, Haskell.Show, Haskell.Eq) +makeLift ''Observation +makeIsDataIndexed ''Observation [('Observation,0)] + instance Eq a => Eq (Observation a) where l == r = obsValue l == obsValue r @@ -258,5 +261,3 @@ signObservation' time vl = signMessage' Observation{obsValue=vl, obsTime=time} makeLift ''SignedMessage makeIsDataIndexed ''SignedMessage [('SignedMessage,0)] -makeLift ''Observation -makeIsDataIndexed ''Observation [('Observation,0)] diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index 57dc52e064..a20be2d360 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -160,9 +160,9 @@ import Plutus.Contract.Schema (Input, Output) import Plutus.Contract.Types (Contract (Contract), MatchingError (WrongVariantError), Promise (Promise), mapError, runError, throwError) import Plutus.Contract.Util (loopM) -import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, - StakeValidatorHash, TxId, Validator) -import Plutus.V1.Ledger.Value (AssetClass) +import PlutusLedgerApi.V1 (Datum, DatumHash, MintingPolicy, MintingPolicyHash, Redeemer, RedeemerHash, StakeValidator, + StakeValidatorHash, TxId, Validator) +import PlutusLedgerApi.V1.Value (AssetClass) import PlutusTx qualified import Wallet.Emulator.Error (WalletAPIError (NoPaymentPubKeyHashError)) import Wallet.Types (ContractInstanceId, EndpointDescription (EndpointDescription), diff --git a/plutus-contract/src/Plutus/Contract/Schema.hs b/plutus-contract/src/Plutus/Contract/Schema.hs index 85621458a7..b983b3ae73 100644 --- a/plutus-contract/src/Plutus/Contract/Schema.hs +++ b/plutus-contract/src/Plutus/Contract/Schema.hs @@ -32,6 +32,7 @@ import Prettyprinter import Data.Row.Extras +import Data.Kind (Type) import GHC.TypeLits {- Note [Contract Schema] @@ -93,7 +94,7 @@ instance (Forall (Output s) Pretty) => Pretty (Handlers s) where hang 1 (braces $ vsep [lbl <> colon, vl]) initialise :: - forall (s :: Row *) l a. + forall (s :: Row Type) l a. ( KnownSymbol l , AllUniqueLabels (Output s) , HasType l a (Output s) @@ -105,10 +106,10 @@ initialise a = -- | Given a schema 's', 'Input s' is the 'Row' type of the inputs that -- contracts with this schema accept. See [Contract Schema] -type family Input (r :: Row *) where +type family Input (r :: Row Type) where Input ('R r) = 'R (InputR r) -type family InputR (r :: [LT *]) where +type family InputR (r :: [LT Type]) where InputR '[] = '[] InputR (l ':-> (t1, _) ': r) = l ':-> t1 ': InputR r @@ -118,10 +119,10 @@ type family InputR (r :: [LT *]) where -- | Given a schema 's', 'Output s' is the 'Row' type of the outputs that -- contracts with this schema produce. See [Contract Schema] -type family Output (r :: Row *) where +type family Output (r :: Row Type) where Output ('R r) = 'R (OutputR r) -type family OutputR (r :: [LT *]) where +type family OutputR (r :: [LT Type]) where OutputR '[] = '[] OutputR (l ':-> (_, t2) ': r) = l ':-> t2 ': OutputR r diff --git a/plutus-contract/src/Plutus/Contract/StateMachine.hs b/plutus-contract/src/Plutus/Contract/StateMachine.hs index 9974ae572d..76978f21e0 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine.hs @@ -88,7 +88,7 @@ import Plutus.Script.Utils.V2.Scripts (scriptCurrencySymbol) import Plutus.Script.Utils.V2.Typed.Scripts qualified as Typed import Plutus.Script.Utils.Value (Value) import Plutus.Script.Utils.Value qualified as Value -import Plutus.V2.Ledger.Tx qualified as V2 +import PlutusLedgerApi.V2.Tx qualified as V2 import PlutusTx qualified import PlutusTx.Monoid (inv) diff --git a/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs b/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs index 4cfa975c2d..a98bf602eb 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs @@ -33,11 +33,12 @@ import Ledger (CardanoAddress) import Ledger.Tx.Constraints (TxConstraints (txOwnOutputs), mustPayToTheScriptWithInlineDatum) import Ledger.Tx.Constraints.OnChain.V2 (checkScriptContext) import Ledger.Typed.Scripts (DatumType, RedeemerType, ValidatorTypes, validatorCardanoAddress, validatorHash) +import Plutus.Script.Utils.Scripts (ValidatorHash) +import Plutus.Script.Utils.V2.Contexts (ownHash) import Plutus.Script.Utils.V2.Typed.Scripts (TypedValidator, ValidatorType) import Plutus.Script.Utils.Value (Value, isZero) -import Plutus.V2.Ledger.Api (ValidatorHash) -import Plutus.V2.Ledger.Contexts (ScriptContext, TxInInfo (txInInfoResolved), findOwnInput, ownHash) -import Plutus.V2.Ledger.Tx qualified as PV2 +import PlutusLedgerApi.V2.Contexts (ScriptContext, TxInInfo (txInInfoResolved), findOwnInput) +import PlutusLedgerApi.V2.Tx qualified as PV2 import PlutusTx qualified import PlutusTx.Prelude hiding (check) import Prelude qualified as Haskell diff --git a/plutus-contract/src/Plutus/Contract/StateMachine/ThreadToken.hs b/plutus-contract/src/Plutus/Contract/StateMachine/ThreadToken.hs index 8260fb4890..d7d31b30e1 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine/ThreadToken.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine/ThreadToken.hs @@ -27,7 +27,7 @@ import Plutus.Contract.StateMachine.MintingPolarity (MintingPolarity (..)) import Plutus.Script.Utils.Typed (ScriptContextV2, mkUntypedMintingPolicy) import Plutus.Script.Utils.Value (CurrencySymbol, TokenName (..), Value (..)) import Plutus.Script.Utils.Value qualified as Value -import Plutus.V2.Ledger.Contexts qualified as V2 +import PlutusLedgerApi.V2.Contexts qualified as V2 import PlutusTx qualified import Prelude qualified as Haskell @@ -67,7 +67,7 @@ checkPolicy (TxOutRef refHash refIdx) (vHash, mintingPolarity) ctx@V2.ScriptCont curPolicy :: TxOutRef -> MintingPolicy curPolicy outRef = mkMintingPolicyScript $ $$(PlutusTx.compile [|| \r -> mkUntypedMintingPolicy @ScriptContextV2 (checkPolicy r) ||]) - `PlutusTx.applyCode` + `PlutusTx.unsafeApplyCode` PlutusTx.liftCode outRef {-# INLINABLE threadTokenValue #-} diff --git a/plutus-contract/src/Plutus/Contract/Test.hs b/plutus-contract/src/Plutus/Contract/Test.hs index 35092943f1..1dd0632f21 100644 --- a/plutus-contract/src/Plutus/Contract/Test.hs +++ b/plutus-contract/src/Plutus/Contract/Test.hs @@ -138,8 +138,8 @@ import Plutus.Contract.Types (Contract (..), IsContract (..), ResumableResult, s import Plutus.Trace.Emulator (EmulatorConfig (..), EmulatorTrace, params, runEmulatorStream) import Plutus.Trace.Emulator.Types (ContractConstraints, ContractInstanceLog, ContractInstanceState (..), ContractInstanceTag, UserThreadMsg) -import Plutus.V1.Ledger.Scripts qualified as PV1 -import Plutus.V1.Ledger.Value qualified as Plutus +import PlutusLedgerApi.V1.Scripts qualified as PV1 +import PlutusLedgerApi.V1.Value qualified as Plutus import PlutusTx (CompiledCode, FromData (..), getPir) import PlutusTx.Coverage import Streaming qualified as S diff --git a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Common.hs b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Common.hs index 30c06527ad..2e33dea571 100644 --- a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Common.hs +++ b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Common.hs @@ -29,12 +29,12 @@ import Text.Read (readMaybe) type Trm = Term NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun () type Typ = Type NamedTyDeBruijn DefaultUni () type Kin = Kind () -type Dat = Datatype NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun () +type Dat = Datatype NamedTyDeBruijn NamedDeBruijn DefaultUni () type Bind = Binding NamedTyDeBruijn NamedDeBruijn DefaultUni DefaultFun () type Trm' = Term TyName Name DefaultUni DefaultFun () type Typ' = Type TyName DefaultUni () -type Dat' = Datatype TyName Name DefaultUni DefaultFun () +type Dat' = Datatype TyName Name DefaultUni () type Bind' = Binding TyName Name DefaultUni DefaultFun () type Err' = Error DefaultUni DefaultFun () diff --git a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/DeBruijn.hs b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/DeBruijn.hs index 762af44254..2bb49fee19 100644 --- a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/DeBruijn.hs +++ b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/DeBruijn.hs @@ -32,6 +32,7 @@ import PlutusIR import PlutusTx.Code import PlutusTx.Code qualified as PlutusTx +import Data.Functor (void) import Plutus.Contract.Test.Coverage.Analysis.Common -- *** Conversion to DeBruijn @@ -103,6 +104,10 @@ toDeBruijn_Trm tyCtx trmCtx trm = case trm of Builtin _ b -> Builtin () b + Constr a t c ts -> Constr a (toDeBruijn_Typ tyCtx t) c (map (toDeBruijn_Trm tyCtx trmCtx) ts) + + Case a t t' ts -> Case a (toDeBruijn_Typ tyCtx t) (toDeBruijn_Trm tyCtx trmCtx t') (map (toDeBruijn_Trm tyCtx trmCtx) ts) + IWrap{} -> error "toDeBruijn_Trm: IWrap" Unwrap{} -> error "toDeBruijn_Trm: Unwrap" @@ -114,6 +119,7 @@ toDeBruijn_Typ tyCtx a = case a of TyForall _ x k a -> TyForall () (mkDeBruijn x 0) k (toDeBruijn_Typ (extendDBCtx tyCtx x) a) TyLam _ x k a -> TyLam () (mkDeBruijn x 0) k (toDeBruijn_Typ (extendDBCtx tyCtx x) a) TyApp _ a b -> TyApp () (toDeBruijn_Typ tyCtx a) (toDeBruijn_Typ tyCtx b) + TySOP a tss -> TySOP a (map (map (toDeBruijn_Typ tyCtx)) tss) TyIFix _ _ _ -> error "normalizeType: TyIFix" bindCtx_Dat :: HasCallStack => (DBCtx TyName, DBCtx Name) -> Dat' -> (DBCtx TyName, DBCtx Name) @@ -142,4 +148,4 @@ toDeBruijn_Bind r tyCtx _ (DatatypeBind _ dat) = DatatypeBind () (toDeBruijn_Dat r tyCtx dat) getTrm :: HasCallStack => CompiledCode a -> Trm -getTrm cc = let Program _ t = fromJust $ PlutusTx.getPir cc in toDeBruijn_Trm [] [] t +getTrm cc = let Program _ _ t = fromJust $ PlutusTx.getPir cc in toDeBruijn_Trm [] [] (void t) diff --git a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Interpreter.hs b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Interpreter.hs index a40eadaf36..6982eeb8b7 100644 --- a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Interpreter.hs +++ b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Interpreter.hs @@ -29,6 +29,7 @@ module Plutus.Contract.Test.Coverage.Analysis.Interpreter (allNonFailLocations) where import Control.Arrow hiding ((<+>)) +import Data.Default (def) import Data.Foldable import Data.List hiding (insert) import Data.Set (Set) @@ -297,6 +298,7 @@ pushWeakenTy (DTWk w a) = case a of DTLam x k t -> DTLam x k (wkT (shiftWeakening w) t) DTForall x k t -> DTForall x k (wkT (shiftWeakening w) t) DTyBuiltin k -> DTyBuiltin k + DTSOP tss -> DTSOP (map pushWeakenTy <$> tss) DTWk _ _ -> error "pushWeakenTy: DTWk" pushWeakenTy a = a @@ -307,6 +309,7 @@ normTy a = case pushWeakenTy a of DTLam x k t -> DTLam x k (normTy t) DTForall x k t -> DTForall x k (normTy t) DTyBuiltin k -> DTyBuiltin k + DTSOP tss -> DTSOP (map normTy <$> tss) DTWk{} -> error "normTy: DTWk" tyCheck :: TyCtx -> DTyp -> Dom -> Bool @@ -395,8 +398,6 @@ domApp ctx d arg = addLocations (topLevelLocations arg) $ case d of vcat ["d =" <+> pretty d ,"arg =" <+> pretty arg] - DError -> DError - DSusp locs d -> addLocations (locs <> allLocations ctx arg) d DIf ty locs -> case arg of @@ -539,6 +540,7 @@ tyInst i a b = case pushWeakenTy a of DTLam x k t -> DTLam x k (tyInst (i+1) t b) DTForall x k t -> DTForall x k (tyInst (i+1) t b) DTyBuiltin k -> DTyBuiltin k + DTSOP tss -> DTSOP (map (tyInst i a) <$> tss) DTWk _ _ -> error "tyInst: DTWk" domTyInst :: HasCallStack @@ -631,6 +633,7 @@ interpTy ctx substT ty args = case ty of arg : args -> interpTy ctx (substT :> arg) b args TyApp _ a b -> interpTy ctx substT a (interpTy ctx substT b [] : args) TyIFix _ _ _ -> error "interpTy: TyIFix" + TySOP _ tss -> DTSOP $ map (map (\ty -> interpTy ctx substT ty args)) tss -- interpDat :: {_ctx : TyCtx} (ctx : TyCtx) -- -> Subst _ctx (DTyp ctx) @@ -839,7 +842,7 @@ interp ctx substD substT trm args = | otherwise -> error "interp: Constant" Builtin _ b -> (Nil, domApps ctx (dTop (interpTy ctx substT - (toDeBruijn_Typ [] $ typeOfBuiltinFunction b) []) + (toDeBruijn_Typ [] $ typeOfBuiltinFunction def b) []) aggro mempty) args) IWrap{} -> error "interp: IWrap" diff --git a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Pretty.hs b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Pretty.hs index 5debaf5a7c..a5e4f33e0f 100644 --- a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Pretty.hs +++ b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Pretty.hs @@ -70,9 +70,9 @@ pParen :: Bool -> Doc -> Doc pParen False = id pParen True = parens -type PrettyTm tyname name uni fun = (Eq tyname, Pretty tyname +type PrettyTm tyname name uni = (Eq tyname, Pretty tyname , Pretty name, Pretty (SomeTypeIn uni) - , Pretty (Some (ValueOf uni)), Pretty fun) + , Pretty (Some (ValueOf uni))) type PrettyTy tyname uni = (Eq tyname, Pretty tyname, Pretty (SomeTypeIn uni)) instance Pretty Text.Text where @@ -81,8 +81,8 @@ instance Pretty Text.Text where instance Pretty (PlutusTx.CompiledCode a) where pretty = maybe "Nothing" pretty . PlutusTx.getPir -instance PrettyTm tyname name uni fun => Pretty (Program tyname name uni fun ann) where - prettyPrec p (Program _ t) = prettyPrec p t +instance (PrettyTm tyname name uni, Pretty fun) => Pretty (Program tyname name uni fun ann) where + prettyPrec p (Program _ _ t) = prettyPrec p t instance Pretty (SomeTypeIn DefaultUni) where pretty = text . show . Pp.pretty @@ -156,12 +156,13 @@ instance PrettyTy tyname uni => Pretty (Type tyname uni ann) where (hd, args) = viewApp a [] viewApp (TyApp _ a b) args = viewApp a (b : args) viewApp a args = (a, args) + TySOP _ tss -> sep $ punctuate " |" $ map (sep . punctuate " *" . map pretty) tss -- data Binding tyname name uni fun a = TermBind a Strictness (VarDecl tyname name uni fun a) (Term tyname name uni fun a) -- | TypeBind a (TyVarDecl tyname a) (Type tyname uni a) -- | DatatypeBind a (Datatype tyname name uni fun a) -instance PrettyTm tyname name uni fun => Pretty (Binding tyname name uni fun ann) where +instance (PrettyTm tyname name uni, Pretty fun) => Pretty (Binding tyname name uni fun ann) where pretty bind = case bind of TermBind _ s vdec t -> (pretty vdec <+> eq) pretty t where @@ -178,15 +179,15 @@ instance PrettyTy tyname uni => Pretty (TyDecl tyname uni ann) where instance Pretty tyname => Pretty (TyVarDecl tyname ann) where prettyPrec p (TyVarDecl _ x k) = pParen (p > 0) $ ppTyBind (x, k) -instance (PrettyTy tyname uni, Pretty name) => Pretty (VarDecl tyname name uni fun ann) where +instance (PrettyTy tyname uni, Pretty name) => Pretty (VarDecl tyname name uni ann) where prettyPrec p (VarDecl _ x a) = pParen (p > 0) $ pretty x <+> ":" <+> pretty a -instance PrettyTm tyname name uni fun => Pretty (Datatype tyname name uni fun ann) where +instance PrettyTm tyname name uni => Pretty (Datatype tyname name uni ann) where pretty (Datatype _ tydec pars name cs) = vcat [ "data" <+> pretty tydec <+> fsep (map pretty pars) <+> "/" <+> pretty name <+> "where" , nest 2 $ vcat $ map pretty cs ] -instance PrettyTm tyname name uni fun => Pretty (Term tyname name uni fun ann) where +instance (PrettyTm tyname name uni, Pretty fun) => Pretty (Term tyname name uni fun ann) where prettyPrec p t = case t of Let _ rec binds body -> pParen (p > 0) $ sep [kw <+> vcat (map pretty $ toList binds), "in" <+> pretty body] where @@ -205,6 +206,8 @@ instance PrettyTm tyname name uni fun => Pretty (Term tyname name uni fun ann) w TyInst{} -> ppApp p t Constant _ c -> pretty c Builtin _ b -> pretty b + Constr _ b _ ts -> ppApp' p "Constr" $ Left b : map Right ts + Case _ b t ts -> ppApp' p "Case" $ Left b : Right t : map Right ts Error _ ty -> pParen (p > 0) $ "error" <+> ":" <+> pretty ty IWrap _ a b t -> ppApp' p "Wrap" [Left a, Left b, Right t] Unwrap _ t -> ppApp' p "unwrap" [Right t] @@ -229,10 +232,10 @@ instance Pretty DDat where instance Pretty DCon where pretty (DCon ds) = pretty ds -ppApp :: PrettyTm tyname name uni fun => Int -> Term tyname name uni fun ann -> Doc +ppApp :: (PrettyTm tyname name uni, Pretty fun) => Int -> Term tyname name uni fun ann -> Doc ppApp p t = uncurry (ppApp' p . prettyPrec 10) (viewApp t) -ppApp' :: PrettyTm tyname name uni fun => Int -> Doc -> [Either (Type tyname uni ann) (Term tyname name uni fun ann)] -> Doc +ppApp' :: (PrettyTm tyname name uni, Pretty fun) => Int -> Doc -> [Either (Type tyname uni ann) (Term tyname name uni fun ann)] -> Doc ppApp' p hd args = pParen (p > 10) $ hd fsep (map ppArg args) where ppArg (Left a) = "@" <> prettyPrec 11 a diff --git a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Types.hs b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Types.hs index 40f7a8117d..478b378cf5 100644 --- a/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Types.hs +++ b/plutus-contract/src/Plutus/Contract/Test/Coverage/Analysis/Types.hs @@ -116,6 +116,7 @@ data DTyp = DTVar NamedTyDeBruijn [DTyp] | DTForall { dtName :: NamedTyDeBruijn, dtKind :: Kin, dtBody :: DTyp } | DTWk { dtWk :: Weakening , dtBody :: DTyp } | DTyBuiltin Kin -- we don't care which + | DTSOP [[DTyp]] deriving (Show, Eq, Generic) data DArg = TyArg DTyp | DArg Dom diff --git a/plutus-contract/src/Plutus/Trace/Effects/Waiting.hs b/plutus-contract/src/Plutus/Trace/Effects/Waiting.hs index 6ee9cc3483..f69502f215 100644 --- a/plutus-contract/src/Plutus/Trace/Effects/Waiting.hs +++ b/plutus-contract/src/Plutus/Trace/Effects/Waiting.hs @@ -24,10 +24,10 @@ import Control.Monad.Freer (Eff, Member, type (~>)) import Control.Monad.Freer.Coroutine (Yield) import Control.Monad.Freer.TH (makeEffect) import Ledger.Slot (Slot) -import Ledger.Time (DiffMilliSeconds, POSIXTime, fromMilliSeconds) import Numeric.Natural (Natural) import Plutus.Trace.Emulator.Types (EmulatorMessage (NewSlot)) import Plutus.Trace.Scheduler (EmSystemCall, Priority (Sleeping), sleep) +import PlutusLedgerApi.V1.Time (DiffMilliSeconds, POSIXTime, fromMilliSeconds) data Waiting r where WaitUntilSlot :: Slot -> Waiting Slot diff --git a/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs b/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs index 0540f501db..67d2dd7176 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs @@ -29,7 +29,7 @@ import Ledger.Tx.Constraints.OffChain (UnbalancedTx (..)) import Plutus.Contract.Request (MkTxLog) import Plutus.Trace.Emulator (EmulatorConfig (_params), EmulatorTrace) import Plutus.Trace.Emulator qualified as Trace -import Plutus.V1.Ledger.Api (ExBudget (..)) +import PlutusLedgerApi.V1 (ExBudget (..)) import Prettyprinter (Pretty (..)) import Streaming.Prelude qualified as S import System.Directory (createDirectoryIfMissing) diff --git a/plutus-contract/src/Plutus/Trace/Scheduler.hs b/plutus-contract/src/Plutus/Trace/Scheduler.hs index a2df75a771..4ff14e90a4 100644 --- a/plutus-contract/src/Plutus/Trace/Scheduler.hs +++ b/plutus-contract/src/Plutus/Trace/Scheduler.hs @@ -58,11 +58,11 @@ import Control.Monad.Freer.Coroutine import Control.Monad.Freer.Extras.Log (LogMsg, logDebug) import Control.Monad.Freer.Reader import Data.Aeson (FromJSON, ToJSON) +import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HashMap import Data.HashSet (HashSet) import Data.HashSet qualified as HashSet -import Data.Hashable (Hashable) import Data.Map as Map import Data.Sequence (Seq (..)) import Data.Sequence qualified as Seq diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index 7eec683b21..750bad9c08 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -77,7 +77,7 @@ import Ledger (Address, CardanoTx, Interval (Interval, ivFrom, ivTo), PaymentPub import Ledger.Tx.Constraints qualified as Constraints import Ledger.Tx.Constraints.OffChain (adjustUnbalancedTx) import Ledger.Tx.Constraints.ValidityInterval qualified as Interval -import Plutus.V1.Ledger.Value (Value) +import PlutusLedgerApi.V1.Value (Value) import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientParams, getClientSlot, ownAddresses, publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg (AdjustingUnbalancedTx)) diff --git a/plutus-contract/src/Wallet/Effects.hs b/plutus-contract/src/Wallet/Effects.hs index ff96c96a4c..29ed723dae 100644 --- a/plutus-contract/src/Wallet/Effects.hs +++ b/plutus-contract/src/Wallet/Effects.hs @@ -31,7 +31,7 @@ import Control.Monad.Freer.TH (makeEffect) import Data.List.NonEmpty (NonEmpty) import Ledger (CardanoAddress, CardanoTx, Slot) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) -import Plutus.V1.Ledger.Value (Value) +import PlutusLedgerApi.V1.Value (Value) import Wallet.Error (WalletAPIError) {-# DEPRECATED TotalFunds "We won't use the wallet for querying blockchain information. See https://plutus-apps.readthedocs.io/en/latest/adr/0005-pab-indexing-solution-integration.html" #-} diff --git a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs index 94352141dc..ba1d695e7f 100644 --- a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs +++ b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs @@ -45,7 +45,7 @@ import Ledger.Index qualified as Index import Ledger.Scripts (MintingPolicy (getMintingPolicy)) import Ledger.Slot (Slot) import Ledger.Tx.CardanoAPI (ToCardanoError, pattern CardanoEmulatorEraTx) -import Ledger.Tx.CardanoAPI.Internal qualified as C (toCardanoPlutusScript, toCardanoValidityRange, zeroExecutionUnits) +import Ledger.Tx.CardanoAPI.Internal qualified as C (toCardanoValidityRange, zeroExecutionUnits) import Ledger.Tx.CardanoAPI.Internal qualified as CardanoAPI (toCardanoAddressInEra, toCardanoTxOutValue) import Ledger.Tx.Internal (TxOut (TxOut), emptyTxBodyContent, txOutValue) import Ledger.Tx.Internal qualified as Tx (TxOut (getTxOut)) @@ -57,7 +57,7 @@ import Plutus.ChainIndex.Effects qualified as ChainIndex (ChainIndexControlEffec import Plutus.ChainIndex.Emulator.Handlers qualified as ChainIndex (handleControl, handleQuery) import Plutus.Trace.Emulator.Types (ContractInstanceLog, EmulatedWalletEffects, EmulatedWalletEffects', UserThreadMsg) import Plutus.Trace.Scheduler qualified as Scheduler -import Plutus.V1.Ledger.Scripts qualified as Script +import PlutusLedgerApi.V1.Scripts qualified as Script import PlutusTx (toData) import Prettyprinter (Pretty (pretty), colon, (<+>)) import Wallet.API qualified as WAPI @@ -290,14 +290,11 @@ emulatorStateInitialDist params mp = do minAdaEmptyTxOut <- mMinAdaTxOut outs <- traverse (mkOutputs minAdaEmptyTxOut) (Map.toList mp) validityRange <- C.toCardanoValidityRange WAPI.defaultSlotRange - mintWitness <- either (error . show) pure $ C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 - <$> (C.PScript <$> C.toCardanoPlutusScript - (C.AsPlutusScript C.AsPlutusScriptV2) - (getMintingPolicy alwaysSucceedPolicy)) - <*> pure C.NoScriptDatumForMint - <*> pure (C.fromPlutusData $ toData Script.unitRedeemer) - <*> pure C.zeroExecutionUnits - let + let mintWitness = C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 + (C.examplePlutusScriptAlwaysSucceeds C.WitCtxMint) + C.NoScriptDatumForMint + (C.fromPlutusData $ toData Script.unitRedeemer) + C.zeroExecutionUnits txBodyContent = emptyTxBodyContent { C.txIns = [ (Index.genesisTxIn, C.BuildTxWith (C.KeyWitness C.KeyWitnessForSpending)) ] , C.txInsCollateral = C.TxInsCollateral C.CollateralInBabbageEra [Index.genesisTxIn] diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index e90c48874e..e150811931 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -56,7 +56,6 @@ import Ledger.Address (CardanoAddress, PaymentPrivateKey (..), PaymentPubKey, Pa cardanoAddressCredential) import Ledger.CardanoWallet (MockWallet, WalletNumber) import Ledger.CardanoWallet qualified as CW -import Ledger.Credential (Credential (PubKeyCredential, ScriptCredential)) import Ledger.Tx qualified as Tx import Ledger.Tx.CardanoAPI (fromCardanoValue, getRequiredSigners) import Ledger.Tx.CardanoAPI qualified as CardanoAPI @@ -66,7 +65,8 @@ import Plutus.ChainIndex qualified as ChainIndex import Plutus.ChainIndex.Api (collectQueryResponse) import Plutus.ChainIndex.Emulator (ChainIndexEmulatorState, ChainIndexQueryEffect) import Plutus.Contract.Checkpoint (CheckpointLogMsg) -import Plutus.V1.Ledger.Api (ValidatorHash, Value) +import PlutusLedgerApi.V1 (ValidatorHash, Value) +import PlutusLedgerApi.V1.Credential (Credential (PubKeyCredential, ScriptCredential)) import Prettyprinter (Pretty (pretty)) import Servant.API (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece)) import Wallet.Effects (NodeClientEffect, diff --git a/plutus-contract/src/Wallet/Graph.hs b/plutus-contract/src/Wallet/Graph.hs index ed810faded..3d4e0d026d 100644 --- a/plutus-contract/src/Wallet/Graph.hs +++ b/plutus-contract/src/Wallet/Graph.hs @@ -27,10 +27,10 @@ import GHC.Generics (Generic) import Cardano.Api qualified as C import Ledger.Address import Ledger.Blockchain -import Ledger.Credential (Credential (..)) import Ledger.Crypto import Ledger.Index qualified as Index import Ledger.Tx +import PlutusLedgerApi.V1.Credential (Credential (..)) -- | The owner of an unspent transaction output. data UtxOwner diff --git a/plutus-contract/src/Wallet/Rollup.hs b/plutus-contract/src/Wallet/Rollup.hs index 1152d30750..4e08eafabc 100644 --- a/plutus-contract/src/Wallet/Rollup.hs +++ b/plutus-contract/src/Wallet/Rollup.hs @@ -27,7 +27,7 @@ import Ledger (Block, Blockchain, OnChainTx (..), TxOut, consumableInputs, onCha import Ledger.Index (genesisTxIn, toOnChain) import Ledger.Tx qualified as Tx import Ledger.Tx.CardanoAPI (fromCardanoValue) -import Plutus.V1.Ledger.Value (Value) +import PlutusLedgerApi.V1.Value (Value) import Wallet.Rollup.Types ------------------------------------------------------------ diff --git a/plutus-contract/src/Wallet/Rollup/Render.hs b/plutus-contract/src/Wallet/Rollup/Render.hs index 58bed3f189..dd638b73d6 100644 --- a/plutus-contract/src/Wallet/Rollup/Render.hs +++ b/plutus-contract/src/Wallet/Rollup/Render.hs @@ -44,7 +44,7 @@ import Plutus.Script.Utils.Ada (Ada (Lovelace)) import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName), Value) import Plutus.Script.Utils.Value qualified as Value -import Plutus.V2.Ledger.Api (TxId) +import PlutusLedgerApi.V2 (TxId) import PlutusTx qualified import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Prelude qualified as PlutusTx diff --git a/plutus-contract/src/Wallet/Rollup/Types.hs b/plutus-contract/src/Wallet/Rollup/Types.hs index 74e1452173..106aca09fc 100644 --- a/plutus-contract/src/Wallet/Rollup/Types.hs +++ b/plutus-contract/src/Wallet/Rollup/Types.hs @@ -15,7 +15,7 @@ import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) import Data.Map (Map) import GHC.Generics import Ledger (CardanoTx, PaymentPubKeyHash (PaymentPubKeyHash), TxOut, cardanoAddressCredential, txOutAddress) -import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), ValidatorHash, Value) +import PlutusLedgerApi.V1 (Credential (PubKeyCredential, ScriptCredential), ValidatorHash, Value) data SequenceId = SequenceId diff --git a/plutus-contract/test/Spec/Contract.hs b/plutus-contract/test/Spec/Contract.hs index 9469f71bd4..dbfd2cbb5c 100644 --- a/plutus-contract/test/Spec/Contract.hs +++ b/plutus-contract/test/Spec/Contract.hs @@ -45,7 +45,7 @@ import Plutus.Trace.Emulator.Types (ContractInstanceLog (_cilMessage), ContractInstanceMsg (ContractLog, CurrentRequests, HandledRequest, ReceiveEndpointCall, Started, StoppedNoError), ContractInstanceState (ContractInstanceState, instContractState), UserThreadMsg (UserLog)) -import Plutus.V1.Ledger.Api (Validator) +import PlutusLedgerApi.V1 (Validator) import PlutusTx qualified import Prelude hiding (not) import Wallet.Emulator qualified as EM diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustIncludeDatum.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustIncludeDatum.hs index bff378528b..5ba88cb678 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustIncludeDatum.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustIncludeDatum.hs @@ -25,10 +25,10 @@ import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Typed qualified as Typed import Plutus.Script.Utils.V1.Scripts qualified as PSU.V1 import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Api (CurrencySymbol (CurrencySymbol), Datum (Datum), Redeemer (Redeemer), - ScriptContext (scriptContextTxInfo), ToData (toBuiltinData), TxInfo (txInfoData), - UnsafeFromData (unsafeFromBuiltinData), Validator, ValidatorHash) -import Plutus.V1.Ledger.Value qualified as Value +import PlutusLedgerApi.V1 (CurrencySymbol (CurrencySymbol), Datum (Datum), Redeemer (Redeemer), + ScriptContext (scriptContextTxInfo), ToData (toBuiltinData), TxInfo (txInfoData), + UnsafeFromData (unsafeFromBuiltinData), Validator, ValidatorHash) +import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx qualified import PlutusTx.Prelude qualified as P diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustMint.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustMint.hs index 24c99fd079..0bf3dbb128 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustMint.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustMint.hs @@ -43,9 +43,9 @@ import Plutus.Script.Utils.V2.Scripts qualified as PSU.V2 import Plutus.Script.Utils.V2.Typed.Scripts qualified as PV2 import Plutus.Script.Utils.Value (TokenName (TokenName)) import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Api (Address, MintingPolicyHash (MintingPolicyHash), Redeemer, TxOutRef) -import Plutus.V1.Ledger.Value qualified as Value -import Plutus.V2.Ledger.Api qualified as PV2 +import PlutusLedgerApi.V1 (Address, MintingPolicyHash (MintingPolicyHash), Redeemer, TxOutRef) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 qualified as PV2 import PlutusTx qualified import Prelude hiding (not) diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustPayToPubKeyAddress.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustPayToPubKeyAddress.hs index 313f4dc241..dcfdd49a2a 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustPayToPubKeyAddress.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustPayToPubKeyAddress.hs @@ -29,7 +29,7 @@ import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.V1.Scripts qualified as PSU.V1 import Plutus.Script.Utils.V2.Scripts qualified as PSU.V2 import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Value qualified as Value +import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx qualified import PlutusTx.Prelude qualified as P diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustProduceAtLeast.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustProduceAtLeast.hs index 6a88a9d6fa..cfc11e990f 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustProduceAtLeast.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustProduceAtLeast.hs @@ -29,8 +29,8 @@ import Plutus.Contract.Test (assertContractError, assertEvaluationError, assertV changeInitialWalletValue, checkPredicateOptions, defaultCheckOptions, mockWalletAddress, w1, w6, (.&&.)) import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Api (Datum (Datum), ScriptContext) -import Plutus.V1.Ledger.Value qualified as Plutus +import PlutusLedgerApi.V1 (Datum (Datum), ScriptContext) +import PlutusLedgerApi.V1.Value qualified as Plutus import PlutusTx qualified import PlutusTx.Prelude qualified as P import Prelude hiding (not) diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustReferenceOutput.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustReferenceOutput.hs index f94f5009f1..18370f6a46 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustReferenceOutput.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustReferenceOutput.hs @@ -44,7 +44,7 @@ import Plutus.Script.Utils.Typed (Any) import Plutus.Script.Utils.V2.Address qualified as PSU.V2 import Plutus.Script.Utils.V2.Scripts qualified as PSU.V2 import Plutus.Trace qualified as Trace -import Plutus.V2.Ledger.Api qualified as PV2 +import PlutusLedgerApi.V2 qualified as PV2 import PlutusTx qualified import PlutusTx.Prelude qualified as P import Spec.Contract.Error (cardanoLedgerErrorContaining) diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSatisfyAnyOf.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSatisfyAnyOf.hs index 7998eaf728..d3e8c742c8 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSatisfyAnyOf.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSatisfyAnyOf.hs @@ -48,7 +48,7 @@ import Plutus.Script.Utils.V1.Generators (alwaysSucceedPolicyVersioned, someToke import Plutus.Script.Utils.V1.Scripts qualified as PSU.V1 import Plutus.Script.Utils.V2.Scripts qualified as PSU.V2 import Plutus.Trace.Emulator qualified as Trace (EmulatorTrace, activateContractWallet, params, waitNSlots) -import Plutus.V1.Ledger.Value +import PlutusLedgerApi.V1.Value import PlutusTx qualified import PlutusTx.Prelude qualified as P diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendAtLeast.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendAtLeast.hs index cb475907a1..19e3faf536 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendAtLeast.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendAtLeast.hs @@ -25,7 +25,7 @@ import Plutus.Contract.Test (assertContractError, assertEvaluationError, assertV import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Typed qualified as Typed import Plutus.Trace.Emulator qualified as Trace (EmulatorTrace, activateContractWallet, nextSlot, walletInstanceTag) -import Plutus.V1.Ledger.Api (Datum (Datum), ScriptContext, ValidatorHash) +import PlutusLedgerApi.V1 (Datum (Datum), ScriptContext, ValidatorHash) import PlutusTx qualified import PlutusTx.Prelude qualified as P import Prelude hiding (not) diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendPubKeyOutput.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendPubKeyOutput.hs index b3feba2537..a6d80591db 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendPubKeyOutput.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendPubKeyOutput.hs @@ -35,7 +35,7 @@ import Plutus.Contract.Test (assertContractError, assertEvaluationError, assertV import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Typed qualified as Typed import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Api (Datum (Datum), ScriptContext, TxOutRef (TxOutRef), Validator, ValidatorHash) +import PlutusLedgerApi.V1 (Datum (Datum), ScriptContext, TxOutRef (TxOutRef), Validator, ValidatorHash) import PlutusTx qualified import PlutusTx.Prelude qualified as P import Wallet.Emulator.Wallet as Wallet (WalletState, chainIndexEmulatorState, ownAddress, signPrivateKeys, diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendScriptOutput.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendScriptOutput.hs index d04653e2a2..17f5463266 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendScriptOutput.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustSpendScriptOutput.hs @@ -61,10 +61,10 @@ import Plutus.Script.Utils.V1.Typed.Scripts as PSU.V1 import Plutus.Script.Utils.V2.Address qualified as PSU.V2 import Plutus.Script.Utils.V2.Scripts qualified as PSU.V2 import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Api qualified as PV1 -import Plutus.V1.Ledger.Scripts (ScriptError, unitRedeemer) -import Plutus.V1.Ledger.Value qualified as V -import Plutus.V2.Ledger.Api qualified as PV2 +import PlutusLedgerApi.V1 qualified as PV1 +import PlutusLedgerApi.V1.Scripts (ScriptError, unitRedeemer) +import PlutusLedgerApi.V1.Value qualified as V +import PlutusLedgerApi.V2 qualified as PV2 import PlutusTx qualified import PlutusTx.Prelude qualified as P import Wallet.Emulator.Wallet (mockWalletAddress) diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustUseOutputAsCollateral.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustUseOutputAsCollateral.hs index d739838108..6df7c1f319 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/MustUseOutputAsCollateral.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/MustUseOutputAsCollateral.hs @@ -43,7 +43,7 @@ import Plutus.Script.Utils.V1.Scripts qualified as PSU.V1 import Plutus.Script.Utils.V2.Scripts qualified as PSU.V2 import Plutus.Trace.Emulator qualified as Trace (EmulatorTrace, activateContractWallet, nextSlot, params, setSigningProcess, walletInstanceTag) -import Plutus.V1.Ledger.Value qualified as Value +import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx qualified import PlutusTx.Prelude qualified as P import Wallet.Emulator.Wallet as Wallet (signPrivateKeys, walletToMockWallet') diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/RequiredSigner.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/RequiredSigner.hs index 1ac4093722..d6f5650088 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/RequiredSigner.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/RequiredSigner.hs @@ -26,8 +26,8 @@ import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Typed qualified as Scripts import Plutus.Script.Utils.V2.Typed.Scripts qualified as Scripts import Plutus.Trace.Emulator qualified as Trace (activateContractWallet, nextSlot, setSigningProcess) -import Plutus.V1.Ledger.Scripts (unitDatum) -import Plutus.V2.Ledger.Api qualified as PV2 +import PlutusLedgerApi.V1.Scripts (unitDatum) +import PlutusLedgerApi.V2 qualified as PV2 import PlutusTx qualified import Prelude import Spec.Contract.Error (cardanoLedgerErrorContaining) diff --git a/plutus-contract/test/Spec/Contract/Tx/Constraints/TimeValidity.hs b/plutus-contract/test/Spec/Contract/Tx/Constraints/TimeValidity.hs index db8ea5813c..d8d7312419 100644 --- a/plutus-contract/test/Spec/Contract/Tx/Constraints/TimeValidity.hs +++ b/plutus-contract/test/Spec/Contract/Tx/Constraints/TimeValidity.hs @@ -28,11 +28,11 @@ import Plutus.Contract.Test (assertEvaluationError, assertFailedTransaction, ass checkPredicateOptions, defaultCheckOptions, emulatorConfig, w1) import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Trace qualified as Trace -import Plutus.V1.Ledger.Api (POSIXTime, TxInfo, Validator) -import Plutus.V1.Ledger.Api qualified as P -import Plutus.V1.Ledger.Interval (contains, from) -import Plutus.V1.Ledger.Interval qualified as I -import Plutus.V1.Ledger.Scripts (unitDatum, unitRedeemer) +import PlutusLedgerApi.V1 (POSIXTime, TxInfo, Validator) +import PlutusLedgerApi.V1 qualified as P +import PlutusLedgerApi.V1.Interval (contains, from) +import PlutusLedgerApi.V1.Interval qualified as I +import PlutusLedgerApi.V1.Scripts (unitDatum, unitRedeemer) import PlutusTx qualified import PlutusTx.Prelude qualified as P import Prelude hiding (not) diff --git a/plutus-example/plutus-example.cabal b/plutus-example/plutus-example.cabal index 1fe66e22bd..8e8dc0b012 100644 --- a/plutus-example/plutus-example.cabal +++ b/plutus-example/plutus-example.cabal @@ -78,8 +78,8 @@ library -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 - , cardano-cli >=1.35 + , cardano-api >=8.0 + , cardano-cli >=8.0 , cardano-ledger-alonzo , cardano-ledger-babbage , cardano-ledger-core @@ -97,9 +97,9 @@ library build-depends: , aeson , bytestring + , cardano-strict-containers , containers , serialise - , strict-containers , text , transformers , transformers-except @@ -118,7 +118,7 @@ executable plutus-example -------------------------- -- Other IOG dependencies -------------------------- - build-depends: cardano-api >=1.35 + build-depends: cardano-api >=8.0 ------------------------ -- Non-IOG dependencies @@ -137,7 +137,7 @@ executable create-script-context -- Local components -------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , plutus-example -------------------------- @@ -168,8 +168,8 @@ test-suite plutus-example-test -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} >=1.35 - , cardano-cli >=1.35 + , cardano-api:{cardano-api, gen} >=8.0 + , cardano-cli >=8.0 , cardano-ledger-alonzo , cardano-ledger-core , cardano-ledger-shelley @@ -207,7 +207,7 @@ test-suite plutus-example-test ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T build-tool-depends: - , cardano-cli:cardano-cli >=1.35 - , cardano-node:cardano-node >=1.35 - , cardano-submit-api:cardano-submit-api >=1.35 + , cardano-cli:cardano-cli >=8.0 + , cardano-node:cardano-node >=8.0 + , cardano-submit-api:cardano-submit-api >=8.0 , plutus-example:create-script-context diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysFails.hs b/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysFails.hs index b3549e4e9b..0a40fda7ad 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysFails.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysFails.hs @@ -15,7 +15,7 @@ import Codec.Serialise import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS -import Plutus.V1.Ledger.Scripts qualified as Plutus +import PlutusLedgerApi.V1.Scripts qualified as Plutus import PlutusTx qualified import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysSucceeds.hs b/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysSucceeds.hs index 42202caf1e..914eba7b93 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysSucceeds.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/AlwaysSucceeds.hs @@ -15,7 +15,7 @@ import Codec.Serialise import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS -import Plutus.V1.Ledger.Api qualified as Plutus +import PlutusLedgerApi.V1 qualified as Plutus import PlutusTx qualified import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/CustomDatumRedeemerGuess.hs b/plutus-example/src/PlutusExample/PlutusVersion1/CustomDatumRedeemerGuess.hs index 8009c5451b..bc8390ad2f 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/CustomDatumRedeemerGuess.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/CustomDatumRedeemerGuess.hs @@ -20,8 +20,8 @@ import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed qualified as Scripts -import Plutus.V1.Ledger.Api qualified as Plutus -import Plutus.V1.Ledger.Contexts (ScriptContext) +import PlutusLedgerApi.V1 qualified as Plutus +import PlutusLedgerApi.V1.Contexts (ScriptContext) import PlutusTx qualified import PlutusTx.Prelude hiding (Semigroup ((<>)), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/DatumRedeemerGuess.hs b/plutus-example/src/PlutusExample/PlutusVersion1/DatumRedeemerGuess.hs index 72f266f339..b5b4c1d8ac 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/DatumRedeemerGuess.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/DatumRedeemerGuess.hs @@ -18,7 +18,7 @@ import Codec.Serialise import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS -import Plutus.V1.Ledger.Api qualified as Plutus +import PlutusLedgerApi.V1 qualified as Plutus import PlutusTx (toBuiltinData) import PlutusTx qualified import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/Loop.hs b/plutus-example/src/PlutusExample/PlutusVersion1/Loop.hs index 0b3de840ab..d27925d7c8 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/Loop.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/Loop.hs @@ -17,7 +17,7 @@ import Codec.Serialise import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS -import Plutus.V1.Ledger.Scripts qualified as Plutus +import PlutusLedgerApi.V1.Scripts qualified as Plutus import PlutusTx import PlutusTx.Builtins (unsafeDataAsI) import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/MintingScript.hs b/plutus-example/src/PlutusExample/PlutusVersion1/MintingScript.hs index b9793dcbe2..cd3a5f213e 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/MintingScript.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/MintingScript.hs @@ -19,8 +19,8 @@ import Data.ByteString.Lazy qualified as LB import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed qualified as Scripts -import Plutus.V1.Ledger.Api (MintingPolicy, Script, ScriptContext, Validator (Validator), mkMintingPolicyScript, - unMintingPolicyScript) +import PlutusLedgerApi.V1 (MintingPolicy, Script, ScriptContext, Validator (Validator), mkMintingPolicyScript, + unMintingPolicyScript) import PlutusTx qualified import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/RedeemerContextScripts.hs b/plutus-example/src/PlutusExample/PlutusVersion1/RedeemerContextScripts.hs index 0da2375da7..9b1ab9ad5d 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/RedeemerContextScripts.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/RedeemerContextScripts.hs @@ -28,7 +28,7 @@ import Data.ByteString.Lazy qualified as LB import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed as Scripts -import Plutus.V1.Ledger.Api qualified as Plutus +import PlutusLedgerApi.V1 qualified as Plutus import PlutusTx qualified import PlutusTx.AssocMap qualified as AMap import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion1/Sum.hs b/plutus-example/src/PlutusExample/PlutusVersion1/Sum.hs index 47ed5f8542..7938819d5d 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion1/Sum.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion1/Sum.hs @@ -20,8 +20,8 @@ import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed qualified as Scripts -import Plutus.V1.Ledger.Api (ScriptContext) -import Plutus.V1.Ledger.Scripts qualified as Plutus +import PlutusLedgerApi.V1 (ScriptContext) +import PlutusLedgerApi.V1.Scripts qualified as Plutus import PlutusTx qualified import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion2/EcdsaSecp256k1Loop.hs b/plutus-example/src/PlutusExample/PlutusVersion2/EcdsaSecp256k1Loop.hs index 75f6210775..8b2283573a 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion2/EcdsaSecp256k1Loop.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion2/EcdsaSecp256k1Loop.hs @@ -14,7 +14,7 @@ import Cardano.Api.Shelley (PlutusScript (..)) import Codec.Serialise (serialise) import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS -import Plutus.V2.Ledger.Api qualified as PlutusV2 +import PlutusLedgerApi.V2 qualified as PlutusV2 import PlutusTx qualified import PlutusTx.Builtins qualified as BI import PlutusTx.Prelude as P hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion2/MintingScript.hs b/plutus-example/src/PlutusExample/PlutusVersion2/MintingScript.hs index a176f6d4cd..4765f54d9c 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion2/MintingScript.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion2/MintingScript.hs @@ -20,8 +20,8 @@ import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed as Scripts -import Plutus.V2.Ledger.Api qualified as V2 -import Plutus.V2.Ledger.Contexts as V2 +import PlutusLedgerApi.V2 qualified as V2 +import PlutusLedgerApi.V2.Contexts as V2 import PlutusTx qualified import PlutusTx.Builtins import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion2/RedeemerContextEquivalence.hs b/plutus-example/src/PlutusExample/PlutusVersion2/RedeemerContextEquivalence.hs index dd7ab7efed..23b87f1175 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion2/RedeemerContextEquivalence.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion2/RedeemerContextEquivalence.hs @@ -24,8 +24,8 @@ import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed as Scripts -import Plutus.V2.Ledger.Api qualified as V2 -import Plutus.V2.Ledger.Contexts as V2 +import PlutusLedgerApi.V2 qualified as V2 +import PlutusLedgerApi.V2.Contexts as V2 import PlutusTx qualified import PlutusTx.Prelude as PlutusPrelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion2/RequireRedeemer.hs b/plutus-example/src/PlutusExample/PlutusVersion2/RequireRedeemer.hs index d064405ff6..5a36ececd4 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion2/RequireRedeemer.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion2/RequireRedeemer.hs @@ -15,8 +15,8 @@ import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed as Scripts -import Plutus.V2.Ledger.Api qualified as Plutus -import Plutus.V2.Ledger.Contexts as V2 +import PlutusLedgerApi.V2 qualified as Plutus +import PlutusLedgerApi.V2.Contexts as V2 import PlutusTx qualified import PlutusTx.Builtins import PlutusTx.Eq as PlutusTx diff --git a/plutus-example/src/PlutusExample/PlutusVersion2/SchnorrSecp256k1Loop.hs b/plutus-example/src/PlutusExample/PlutusVersion2/SchnorrSecp256k1Loop.hs index 8ab4b373ff..eaac744940 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion2/SchnorrSecp256k1Loop.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion2/SchnorrSecp256k1Loop.hs @@ -14,7 +14,7 @@ import Cardano.Api.Shelley (PlutusScript (..)) import Codec.Serialise (serialise) import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS -import Plutus.V2.Ledger.Api qualified as PlutusV2 +import PlutusLedgerApi.V2 qualified as PlutusV2 import PlutusTx qualified import PlutusTx.Builtins qualified as BI import PlutusTx.Prelude as P hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/PlutusVersion2/StakeScript.hs b/plutus-example/src/PlutusExample/PlutusVersion2/StakeScript.hs index 2d8eedbbd5..9b4c73826c 100644 --- a/plutus-example/src/PlutusExample/PlutusVersion2/StakeScript.hs +++ b/plutus-example/src/PlutusExample/PlutusVersion2/StakeScript.hs @@ -20,8 +20,8 @@ import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS import Plutus.Script.Utils.Typed as Scripts -import Plutus.V2.Ledger.Api qualified as V2 -import Plutus.V2.Ledger.Contexts as V2 +import PlutusLedgerApi.V2 qualified as V2 +import PlutusLedgerApi.V2.Contexts as V2 import PlutusTx qualified import PlutusTx.Builtins import PlutusTx.Prelude hiding (Semigroup (..), unless, (.)) diff --git a/plutus-example/src/PlutusExample/ScriptContextChecker.hs b/plutus-example/src/PlutusExample/ScriptContextChecker.hs index 0eff376419..6a9f7d97fc 100644 --- a/plutus-example/src/PlutusExample/ScriptContextChecker.hs +++ b/plutus-example/src/PlutusExample/ScriptContextChecker.hs @@ -31,8 +31,8 @@ import GHC.Records (HasField (..)) import Cardano.CLI.Shelley.Run.Query import Cardano.Ledger.Alonzo qualified as Alonzo -import Cardano.Ledger.Alonzo.PParams qualified as Alonzo import Cardano.Ledger.Alonzo.PlutusScriptApi qualified as Alonzo +import Cardano.Ledger.Alonzo.PParams qualified as Alonzo import Cardano.Ledger.Alonzo.Tx qualified as Alonzo import Cardano.Ledger.Alonzo.TxInfo qualified as Alonzo import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo @@ -49,8 +49,8 @@ import Control.Monad.Trans.Except import Ouroboros.Consensus.HardFork.Combinator.AcrossEras qualified as Consensus import Ouroboros.Consensus.HardFork.History qualified as Consensus -import Plutus.V1.Ledger.Api qualified as V1 -import Plutus.V2.Ledger.Api qualified as V2 +import PlutusLedgerApi.V1 qualified as V1 +import PlutusLedgerApi.V2 qualified as V2 import PlutusTx.AssocMap qualified as PMap import PlutusTx.Prelude as PPrelude hiding (Eq, Semigroup (..), unless, (.)) diff --git a/plutus-example/test/Test/PlutusExample/Gen.hs b/plutus-example/test/Test/PlutusExample/Gen.hs index 9ca32233eb..c7f0de40a7 100644 --- a/plutus-example/test/Test/PlutusExample/Gen.hs +++ b/plutus-example/test/Test/PlutusExample/Gen.hs @@ -16,9 +16,9 @@ import Cardano.Ledger.Shelley.UTxO qualified as Ledger import Cardano.Ledger.TxIn qualified as Ledger import Gen.Cardano.Api.Typed import Ledger qualified as Plutus -import Plutus.V1.Ledger.Tx qualified as PV1 import PlutusExample.PlutusVersion1.RedeemerContextScripts import PlutusExample.ScriptContextChecker +import PlutusLedgerApi.V1.Tx qualified as PV1 import Hedgehog (Gen) import Hedgehog.Gen qualified as Gen diff --git a/plutus-ledger/plutus-ledger.cabal b/plutus-ledger/plutus-ledger.cabal index 3459315f7a..f360564564 100644 --- a/plutus-ledger/plutus-ledger.cabal +++ b/plutus-ledger/plutus-ledger.cabal @@ -50,9 +50,9 @@ flag defer-plugin-errors manual: True library - import: lang - hs-source-dirs: src - default-language: Haskell2010 + import: lang + hs-source-dirs: src + default-language: Haskell2010 exposed-modules: Data.Aeson.Extras Data.Time.Units.Extra @@ -89,49 +89,40 @@ library Ledger.Typed.TypeUtils Ledger.Value.CardanoAPI Ledger.Value.Orphans - Prettyprinter.Extras - - reexported-modules: - Plutus.V1.Ledger.Bytes as Ledger.Bytes, - Plutus.V1.Ledger.Credential as Ledger.Credential, - Plutus.V1.Ledger.DCert as Ledger.DCert, - Plutus.V1.Ledger.Interval as Ledger.Interval, - Plutus.V1.Ledger.Time as Ledger.Time, -- The rest of the plutus-ledger-api modules are reexported from within -- the Haskell modules and not in the current cabal file. - -- For example: Plutus.V1.Ledger.Address is reexported by Ledger.Address - other-modules: - Codec.CBOR.Extras - Ledger.Tx.CardanoAPITemp + -- For example: PlutusLedgerApi.V1.Address is reexported by Ledger.Address + other-modules: Codec.CBOR.Extras -------------------- -- Local components -------------------- - build-depends: plutus-script-utils >=1.2.0 + build-depends: plutus-script-utils >=1.2.0 -------------------------- -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api:{cardano-api, internal} ^>=8.2 , cardano-binary , cardano-crypto , cardano-crypto-class + , cardano-ledger-allegra , cardano-ledger-alonzo , cardano-ledger-babbage , cardano-ledger-byron , cardano-ledger-core + , cardano-ledger-mary , cardano-ledger-shelley - , cardano-ledger-shelley-ma , cardano-slotting , data-default , iohk-monitoring - , ouroboros-consensus-shelley - , plutus-core >=1.0.0 - , plutus-ledger-api >=1.0.0 - , plutus-tx >=1.0.0 + , plutus-core >=1.0.0 + , plutus-ledger-api >=1.0.0 + , plutus-tx >=1.0.0 + -- , ouroboros-consensus-shelley >= 0.4.0.1 ------------------------ -- Non-IOG dependencies ------------------------ @@ -140,12 +131,13 @@ library -- defined there. build-depends: , aeson - , base >=4.9 && <5 + , base >=4.9 && <5 , base16-bytestring , bytestring + , cardano-strict-containers , cborg , containers - , cryptonite >=0.25 + , cryptonite >=0.25 , flat , hashable , http-api-data @@ -154,11 +146,9 @@ library , mtl , newtype-generics , prettyprinter - , quickcheck-contractmodel >=0.1.4.0 , scientific , serialise , servant - , strict-containers , tagged , template-haskell , text @@ -166,7 +156,8 @@ library , transformers , vector - ghc-options: -fprint-potential-instances + -- , quickcheck-contractmodel >=0.1.4.0 + ghc-options: -fprint-potential-instances if !(impl(ghcjs) || os(ghcjs)) build-depends: plutus-tx-plugin >=1.0.0 @@ -194,11 +185,11 @@ test-suite plutus-ledger-test -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} >=1.35 - , cardano-crypto-class >=2.0.0 + , cardano-api:{cardano-api, gen} ^>=8.2 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 + -- , cardano-crypto-class >=2.0.0 ------------------------ -- Non-IOG dependencies ------------------------ diff --git a/plutus-ledger/src/Ledger.hs b/plutus-ledger/src/Ledger.hs index 81e5b26b87..a939cd33ae 100644 --- a/plutus-ledger/src/Ledger.hs +++ b/plutus-ledger/src/Ledger.hs @@ -16,8 +16,8 @@ import Ledger.Scripts as Export import Ledger.Slot as Export import Ledger.Tx as Export import Ledger.Value.CardanoAPI as Export hiding (singleton) -import Plutus.V1.Ledger.Api (Credential, DCert) -import Plutus.V1.Ledger.Contexts as Export hiding (TxId (..), TxOut (..)) -import Plutus.V1.Ledger.Credential (StakingCredential) -import Plutus.V1.Ledger.Interval as Export -import Plutus.V1.Ledger.Time as Export +import PlutusLedgerApi.V1 (Credential, DCert) +import PlutusLedgerApi.V1.Contexts as Export hiding (TxId (..), TxOut (..)) +import PlutusLedgerApi.V1.Credential (StakingCredential) +import PlutusLedgerApi.V1.Interval as Export +import PlutusLedgerApi.V1.Time as Export diff --git a/plutus-ledger/src/Ledger/Address.hs b/plutus-ledger/src/Ledger/Address.hs index 98dd270250..73b65d450c 100644 --- a/plutus-ledger/src/Ledger/Address.hs +++ b/plutus-ledger/src/Ledger/Address.hs @@ -44,11 +44,9 @@ import GHC.Generics (Generic) import Ledger.Address.Orphans as Export () import Ledger.Crypto (PubKey (PubKey), PubKeyHash (PubKeyHash), pubKeyHash, toPublicKey) import Ledger.Orphans () -import Ledger.Scripts (Language (..), StakeValidatorHash (..), Validator, ValidatorHash (..), Versioned (..)) -import Plutus.Script.Utils.V1.Address qualified as PV1 -import Plutus.Script.Utils.V2.Address qualified as PV2 -import Plutus.V1.Ledger.Address as Export hiding (pubKeyHashAddress) -import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential), StakingCredential (StakingHash)) +import Ledger.Scripts (ScriptHash (..), StakeValidatorHash (..), ValidatorHash (..), mkValidatorCardanoAddress) +import PlutusLedgerApi.V1.Address as Export hiding (pubKeyHashAddress) +import PlutusLedgerApi.V1.Credential (Credential (PubKeyCredential, ScriptCredential), StakingCredential (StakingHash)) import PlutusTx qualified import PlutusTx.Lift (makeLift) import PlutusTx.Prelude qualified as PlutusTx @@ -73,7 +71,7 @@ cardanoAddressCredential (C.AddressInEra _ (C.ShelleyAddress _ paymentCredential $ PlutusTx.toBuiltin $ C.serialiseToRawBytes paymentKeyHash C.PaymentCredentialByScript scriptHash -> - ScriptCredential $ scriptToValidatorHash scriptHash + ScriptCredential $ scriptToScriptHash scriptHash cardanoStakingCredential :: C.AddressInEra era -> Maybe StakingCredential cardanoStakingCredential (C.AddressInEra C.ByronAddressInAnyEra _) = Nothing @@ -90,7 +88,7 @@ cardanoStakingCredential (C.AddressInEra _ (C.ShelleyAddress _ _ stakeAddressRef $ PubKeyHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes stakeKeyHash - fromCardanoStakeCredential (C.StakeCredentialByScript scriptHash) = ScriptCredential (scriptToValidatorHash scriptHash) + fromCardanoStakeCredential (C.StakeCredentialByScript scriptHash) = ScriptCredential (scriptToScriptHash scriptHash) cardanoPubKeyHash :: C.AddressInEra era -> Maybe PubKeyHash cardanoPubKeyHash addr = case cardanoAddressCredential addr of @@ -103,8 +101,8 @@ toPlutusAddress address = Address (cardanoAddressCredential address) (cardanoSta toPlutusPubKeyHash :: C.Hash C.PaymentKey -> PubKeyHash toPlutusPubKeyHash paymentKeyHash = PubKeyHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes paymentKeyHash -scriptToValidatorHash :: C.ScriptHash -> ValidatorHash -scriptToValidatorHash = ValidatorHash . PlutusTx.toBuiltin . C.serialiseToRawBytes +scriptToScriptHash :: C.ScriptHash -> ScriptHash +scriptToScriptHash = ScriptHash . PlutusTx.toBuiltin . C.serialiseToRawBytes newtype PaymentPrivateKey = PaymentPrivateKey { unPaymentPrivateKey :: Crypto.XPrv } @@ -171,7 +169,7 @@ pubKeyAddress (PaymentPubKey pk) = Address (PubKeyCredential (pubKeyHash pk)) -- | The address that should be used by a transaction output locked by the given validator script -- (with its staking credentials). scriptValidatorHashAddress :: ValidatorHash -> Maybe StakingCredential -> Address -scriptValidatorHashAddress vh = Address (ScriptCredential vh) +scriptValidatorHashAddress (ValidatorHash vh) = Address (ScriptCredential (ScriptHash vh)) {-# INLINABLE stakePubKeyHashCredential #-} -- | Construct a `StakingCredential` from a public key hash. @@ -181,9 +179,4 @@ stakePubKeyHashCredential = StakingHash . PubKeyCredential . unStakePubKeyHash {-# INLINEABLE stakeValidatorHashCredential #-} -- | Construct a `StakingCredential` from a validator script hash. stakeValidatorHashCredential :: StakeValidatorHash -> StakingCredential -stakeValidatorHashCredential (StakeValidatorHash h) = StakingHash . ScriptCredential . ValidatorHash $ h - --- | Cardano address of a versioned 'Validator' script. -mkValidatorCardanoAddress :: C.NetworkId -> Versioned Validator -> C.AddressInEra C.BabbageEra -mkValidatorCardanoAddress networkId (Versioned val PlutusV1) = PV1.mkValidatorCardanoAddress networkId val -mkValidatorCardanoAddress networkId (Versioned val PlutusV2) = PV2.mkValidatorCardanoAddress networkId val +stakeValidatorHashCredential (StakeValidatorHash h) = StakingHash . ScriptCredential . ScriptHash $ h diff --git a/plutus-ledger/src/Ledger/Address/Orphans.hs b/plutus-ledger/src/Ledger/Address/Orphans.hs index 4f7fac612d..17f224a023 100644 --- a/plutus-ledger/src/Ledger/Address/Orphans.hs +++ b/plutus-ledger/src/Ledger/Address/Orphans.hs @@ -8,7 +8,7 @@ import Data.Aeson (FromJSON, ToJSON) import Ledger.Credential.Orphans () import Ledger.Scripts.Orphans () -import Plutus.V1.Ledger.Address +import PlutusLedgerApi.V1.Address deriving anyclass instance ToJSON Address deriving anyclass instance FromJSON Address diff --git a/plutus-ledger/src/Ledger/Blockchain.hs b/plutus-ledger/src/Ledger/Blockchain.hs index 4a38b1d2db..f8682b9e3d 100644 --- a/plutus-ledger/src/Ledger/Blockchain.hs +++ b/plutus-ledger/src/Ledger/Blockchain.hs @@ -32,7 +32,7 @@ import Cardano.Api qualified as C import Ledger.Index.Internal (OnChainTx (..), eitherTx, unOnChain) import Ledger.Tx (TxOut, getCardanoTxCollateralInputs, getCardanoTxInputs, getCardanoTxProducedOutputs, getCardanoTxProducedReturnCollateral) -import Plutus.V1.Ledger.Scripts +import PlutusLedgerApi.V1.Scripts -- | Block identifier (usually a hash) newtype BlockId = BlockId { getBlockId :: BS.ByteString } diff --git a/plutus-ledger/src/Ledger/CardanoWallet.hs b/plutus-ledger/src/Ledger/CardanoWallet.hs index f29d59d00c..4613ba20a7 100644 --- a/plutus-ledger/src/Ledger/CardanoWallet.hs +++ b/plutus-ledger/src/Ledger/CardanoWallet.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {- Cardano wallet implementation for the emulator. -} @@ -39,6 +40,7 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Aeson.Extras (encodeByteString) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL +import Data.Coerce (coerce) import Data.Either (fromRight) import Data.Hashable (Hashable (..)) import Data.List (findIndex) @@ -55,8 +57,8 @@ import Ledger.Crypto (PubKey (..)) import Ledger.Crypto qualified as Crypto import Ledger.Test (testnet) import Ledger.Tx.CardanoAPI.Internal qualified as Tx -import Plutus.V1.Ledger.Api (Address (Address), Credential (PubKeyCredential), StakingCredential (StakingHash)) -import Plutus.V1.Ledger.Bytes (LedgerBytes (getLedgerBytes)) +import PlutusLedgerApi.V1 (Address (Address), Credential (PubKeyCredential), StakingCredential (StakingHash)) +import PlutusLedgerApi.V1.Bytes (LedgerBytes (getLedgerBytes)) import Servant.API (FromHttpApiData, ToHttpApiData) newtype MockPrivateKey = MockPrivateKey { unMockPrivateKey :: Crypto.XPrv } @@ -81,10 +83,15 @@ data MockWallet = -- | Wrapper for config files and APIs newtype WalletNumber = WalletNumber { getWallet :: Integer } - deriving (Show, Eq, Ord, Generic) - deriving newtype (ToHttpApiData, FromHttpApiData, Num, Enum, Real, Integral) + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (ToHttpApiData, FromHttpApiData, Num, Enum, Real) deriving anyclass (FromJSON, ToJSON) +-- Workaround for warning "Call of toInteger :: Integer -> Integer can probably be omitted" GHC issue #21679 +instance Integral WalletNumber where + quotRem = coerce @(Integer -> Integer -> (Integer, Integer)) @(WalletNumber -> WalletNumber -> (WalletNumber, WalletNumber)) quotRem + toInteger = coerce + fromWalletNumber :: WalletNumber -> MockWallet fromWalletNumber (WalletNumber i) = (fromSeed' (BSL.toStrict $ serialise i)) { mwPrintAs = Just (show i) } diff --git a/plutus-ledger/src/Ledger/Contexts/Orphans.hs b/plutus-ledger/src/Ledger/Contexts/Orphans.hs index 2deec015ca..57c3f63488 100644 --- a/plutus-ledger/src/Ledger/Contexts/Orphans.hs +++ b/plutus-ledger/src/Ledger/Contexts/Orphans.hs @@ -4,6 +4,6 @@ {-# LANGUAGE DerivingStrategies #-} module Ledger.Contexts.Orphans where -import Plutus.V1.Ledger.Contexts (ScriptPurpose (..)) +import PlutusLedgerApi.V1.Contexts (ScriptPurpose (..)) deriving stock instance Ord ScriptPurpose diff --git a/plutus-ledger/src/Ledger/Credential/Orphans.hs b/plutus-ledger/src/Ledger/Credential/Orphans.hs index 9fe866c6a1..d47f5a4720 100644 --- a/plutus-ledger/src/Ledger/Credential/Orphans.hs +++ b/plutus-ledger/src/Ledger/Credential/Orphans.hs @@ -10,7 +10,7 @@ import Codec.Serialise (Serialise) import Data.Aeson (FromJSON, ToJSON) import Data.Hashable (Hashable) -import Plutus.V1.Ledger.Credential +import PlutusLedgerApi.V1.Credential deriving anyclass instance ToJSON Credential deriving anyclass instance FromJSON Credential diff --git a/plutus-ledger/src/Ledger/Crypto.hs b/plutus-ledger/src/Ledger/Crypto.hs index ee3fd6cc00..8b623f205c 100644 --- a/plutus-ledger/src/Ledger/Crypto.hs +++ b/plutus-ledger/src/Ledger/Crypto.hs @@ -39,9 +39,9 @@ import Data.Hashable (Hashable) import Data.String import GHC.Generics (Generic) import Ledger.Tx.Orphans.V1 () -import Plutus.V1.Ledger.Api (LedgerBytes (LedgerBytes), TxId (TxId), fromBuiltin, toBuiltin) -import Plutus.V1.Ledger.Bytes qualified as KB -import Plutus.V1.Ledger.Crypto as Export +import PlutusLedgerApi.V1 (LedgerBytes (LedgerBytes), TxId (TxId), fromBuiltin, toBuiltin) +import PlutusLedgerApi.V1.Bytes qualified as KB +import PlutusLedgerApi.V1.Crypto as Export import PlutusTx qualified as PlutusTx import PlutusTx.Lift (makeLift) import PlutusTx.Prelude qualified as PlutusTx diff --git a/plutus-ledger/src/Ledger/Crypto/Orphans.hs b/plutus-ledger/src/Ledger/Crypto/Orphans.hs index 08dd8be5e2..5c1aceca26 100644 --- a/plutus-ledger/src/Ledger/Crypto/Orphans.hs +++ b/plutus-ledger/src/Ledger/Crypto/Orphans.hs @@ -10,7 +10,7 @@ import Control.Newtype.Generics (Newtype) import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) import Data.Hashable (Hashable) -import Plutus.V1.Ledger.Crypto +import PlutusLedgerApi.V1.Crypto deriving anyclass instance ToJSON PubKeyHash deriving anyclass instance FromJSON PubKeyHash diff --git a/plutus-ledger/src/Ledger/DCert/Orphans.hs b/plutus-ledger/src/Ledger/DCert/Orphans.hs index 9bf1c2cc9f..2a76946866 100644 --- a/plutus-ledger/src/Ledger/DCert/Orphans.hs +++ b/plutus-ledger/src/Ledger/DCert/Orphans.hs @@ -10,7 +10,7 @@ import Data.Aeson (FromJSON, ToJSON) import Ledger.Credential.Orphans () import Ledger.Crypto.Orphans () -import Plutus.V1.Ledger.DCert (DCert) +import PlutusLedgerApi.V1.DCert (DCert) deriving anyclass instance ToJSON DCert deriving anyclass instance FromJSON DCert diff --git a/plutus-ledger/src/Ledger/Index.hs b/plutus-ledger/src/Ledger/Index.hs index b53ff8f61e..9b6025b594 100644 --- a/plutus-ledger/src/Ledger/Index.hs +++ b/plutus-ledger/src/Ledger/Index.hs @@ -51,7 +51,7 @@ import Prelude hiding (lookup) import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C.Api import Cardano.Ledger.Babbage qualified as Babbage -import Cardano.Ledger.Babbage.PParams qualified as Babbage +import Cardano.Ledger.Core (PParams, getMinCoinTxOut) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Shelley.API qualified as C.Ledger import Control.Lens (alaf, (&), (.~), (<&>)) @@ -72,7 +72,7 @@ import Ledger.Tx.Internal qualified as Tx import Ledger.Value.CardanoAPI (Value, lovelaceToValue) import Plutus.Script.Utils.Ada (Ada) import Plutus.Script.Utils.Ada qualified as Ada -import Plutus.V1.Ledger.Api qualified as PV1 +import PlutusLedgerApi.V1 qualified as PV1 import PlutusTx.Lattice ((\/)) -- | Create an index of all UTxOs on the chain. @@ -114,7 +114,7 @@ getCollateral idx tx = case getCardanoTxTotalCollateral tx of -- | Adjust a single transaction output so it contains at least the minimum amount of Ada -- and return the adjustment (if any) and the updated TxOut. -adjustTxOut :: Babbage.PParams (Babbage.BabbageEra StandardCrypto) -> TxOut -> ([C.Lovelace], Tx.TxOut) +adjustTxOut :: PParams (Babbage.BabbageEra StandardCrypto) -> TxOut -> ([C.Lovelace], Tx.TxOut) adjustTxOut params txOut = do -- Increasing the ada amount can also increase the size in bytes, so start with a rough estimated amount of ada let withMinAdaValue = toCardanoTxOutValue $ txOutValue txOut \/ lovelaceToValue (minAdaTxOut params txOut) @@ -129,11 +129,11 @@ adjustTxOut params txOut = do -- | Exact computation of the mimimum Ada required for a given TxOut. -- TODO: Should be moved to cardano-api-extended once created -minAdaTxOut :: Babbage.PParams (Babbage.BabbageEra StandardCrypto) -> TxOut -> C.Lovelace +minAdaTxOut :: PParams (Babbage.BabbageEra StandardCrypto) -> TxOut -> C.Lovelace minAdaTxOut params txOut = let toLovelace = C.Lovelace . C.Ledger.unCoin initialValue = txOutValue txOut - firstEstimate = toLovelace . C.Ledger.evaluateMinLovelaceOutput params $ fromPlutusTxOut txOut + firstEstimate = toLovelace . getMinCoinTxOut params $ fromPlutusTxOut txOut in -- if the estimate is above the initialValue, we run minAdaAgain, just to be sure that the -- new amount didn't change the TxOut size and requires more ada. if firstEstimate > C.selectLovelace initialValue @@ -197,5 +197,5 @@ createGenesisTransaction vals = , C.txOuts = Map.toList vals <&> \(changeAddr, v) -> C.TxOut changeAddr (toCardanoTxOutValue v) C.TxOutDatumNone C.Api.ReferenceScriptNone } - txBody = either (error . ("createGenesisTransaction: Can't create TxBody: " <>) . show) id $ C.makeTransactionBody txBodyContent + txBody = either (error . ("createGenesisTransaction: Can't create TxBody: " <>) . show) id $ C.createAndValidateTransactionBody txBodyContent in CardanoEmulatorEraTx $ C.Tx txBody [] diff --git a/plutus-ledger/src/Ledger/Index/Internal.hs b/plutus-ledger/src/Ledger/Index/Internal.hs index 4edd49b5a6..6b852cc734 100644 --- a/plutus-ledger/src/Ledger/Index/Internal.hs +++ b/plutus-ledger/src/Ledger/Index/Internal.hs @@ -22,8 +22,8 @@ import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Cardano.Binary qualified as CBOR import Cardano.Ledger.Alonzo.Scripts (ExUnits) -import Cardano.Ledger.Alonzo.Tx (IsValid (IsValid), ValidatedTx (ValidatedTx)) -import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (AlonzoTx), IsValid (IsValid)) +import Cardano.Ledger.Alonzo.TxWits (RdmrPtr) import Cardano.Ledger.Babbage (BabbageEra) import Cardano.Ledger.Core (Tx) import Cardano.Ledger.Crypto (StandardCrypto) @@ -36,7 +36,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Ledger.Orphans () import Ledger.Tx.CardanoAPI.Internal (CardanoTx, pattern CardanoEmulatorEraTx) -import Plutus.V1.Ledger.Scripts qualified as Scripts +import PlutusLedgerApi.V1.Scripts qualified as Scripts import Prettyprinter (Pretty (..), hang, vsep, (<+>)) import Prettyprinter.Extras (PrettyShow (..)) import Prettyprinter.Util (reflow) @@ -51,7 +51,7 @@ instance Serialise OnChainTx where decode = fail "Not allowed to use `decode` on `OnChainTx`" -- Unused eitherTx :: (CardanoTx -> r) -> (CardanoTx -> r) -> OnChainTx -> r -eitherTx ifInvalid ifValid (extractTx . getOnChainTx -> tx@(ValidatedTx _ _ (IsValid isValid) _)) = +eitherTx ifInvalid ifValid (extractTx . getOnChainTx -> tx@(AlonzoTx _ _ (IsValid isValid) _)) = let ctx = CardanoEmulatorEraTx (C.ShelleyTx C.ShelleyBasedEraBabbage tx) in if isValid then ifValid ctx else ifInvalid ctx diff --git a/plutus-ledger/src/Ledger/Orphans.hs b/plutus-ledger/src/Ledger/Orphans.hs index cedfe97f50..b2052d3f91 100644 --- a/plutus-ledger/src/Ledger/Orphans.hs +++ b/plutus-ledger/src/Ledger/Orphans.hs @@ -22,14 +22,14 @@ import Data.Scientific (floatingOrInteger, scientific) import Data.Text qualified as Text import GHC.Generics (Generic) import Ledger.Crypto (PrivateKey (PrivateKey, getPrivateKey)) -import Plutus.V1.Ledger.Api (LedgerBytes, POSIXTime (POSIXTime), TxId (TxId), fromBytes) -import Plutus.V1.Ledger.Bytes (bytes) -import Plutus.V1.Ledger.Scripts (ScriptError) +import PlutusLedgerApi.V1 (LedgerBytes, POSIXTime (POSIXTime), TxId (TxId), fromBytes) +import PlutusLedgerApi.V1.Bytes (bytes) +import PlutusLedgerApi.V1.Scripts (ScriptError) import Web.HttpApiData (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece)) -- TODO: remove this dependency here once the instance of Ord for AddressInEra -- can be obtained from upstream and removed from quickcheck-contractmodel. -import Test.QuickCheck.ContractModel.Internal.Common () +-- import Test.QuickCheck.ContractModel.Internal.Common () instance ToHttpApiData PrivateKey where toUrlPiece = toUrlPiece . getPrivateKey @@ -55,7 +55,7 @@ instance Serialise (C.AddressInEra C.BabbageEra) where encode = encode . C.serialiseToRawBytes decode = do bs <- decode - maybe (fail "Can get back Address") + either (fail . show) pure $ C.deserialiseFromRawBytes (C.AsAddressInEra C.AsBabbageEra) bs diff --git a/plutus-ledger/src/Ledger/Scripts.hs b/plutus-ledger/src/Ledger/Scripts.hs index 67597ae1ef..30f57909aa 100644 --- a/plutus-ledger/src/Ledger/Scripts.hs +++ b/plutus-ledger/src/Ledger/Scripts.hs @@ -1,6 +1,8 @@ {-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-} module Ledger.Scripts ( module Export + , unitDatum + , unitRedeemer , examplePlutusScriptAlwaysSucceeds , examplePlutusScriptAlwaysFails , examplePlutusScriptAlwaysSucceedsHash @@ -12,7 +14,8 @@ import Cardano.Api (PlutusScriptVersion (PlutusScriptV1), Script (PlutusScript), examplePlutusScriptAlwaysFails, examplePlutusScriptAlwaysSucceeds, hashScript, serialiseToRawBytes) import Ledger.Scripts.Orphans () import Plutus.Script.Utils.Scripts as Export -import Plutus.V1.Ledger.Scripts as Export +import PlutusLedgerApi.V1.Scripts as Export +import PlutusTx (toBuiltinData) import PlutusTx.Builtins (BuiltinByteString, toBuiltin) @@ -21,3 +24,12 @@ examplePlutusScriptAlwaysSucceedsHash = toBuiltin . serialiseToRawBytes . hashSc examplePlutusScriptAlwaysFailsHash :: WitCtx ctx -> BuiltinByteString examplePlutusScriptAlwaysFailsHash = toBuiltin . serialiseToRawBytes . hashScript . PlutusScript PlutusScriptV1 . examplePlutusScriptAlwaysFails + +-- | @()@ as a datum. +unitDatum :: Datum +unitDatum = Datum $ toBuiltinData () + +-- | @()@ as a redeemer. +unitRedeemer :: Redeemer +unitRedeemer = Redeemer $ toBuiltinData () + diff --git a/plutus-ledger/src/Ledger/Scripts/Orphans.hs b/plutus-ledger/src/Ledger/Scripts/Orphans.hs index 8d93f10a4f..7b53ed470a 100644 --- a/plutus-ledger/src/Ledger/Scripts/Orphans.hs +++ b/plutus-ledger/src/Ledger/Scripts/Orphans.hs @@ -9,7 +9,8 @@ import Ledger.Builtins.Orphans () import Codec.CBOR.Extras (SerialiseViaFlat (..)) import Data.Aeson.Extras qualified as JSON -import Plutus.V1.Ledger.Scripts +import Plutus.Script.Utils.Scripts +import PlutusLedgerApi.V1.Scripts import Data.Aeson (FromJSON (parseJSON), FromJSONKey, ToJSON (toJSON), ToJSONKey) import Data.Aeson qualified as JSON @@ -91,8 +92,6 @@ deriving anyclass instance FromJSON Validator deriving anyclass instance ToJSON Redeemer deriving anyclass instance FromJSON Redeemer -deriving anyclass instance Serialise Redeemer deriving anyclass instance ToJSON Datum deriving anyclass instance FromJSON Datum -deriving anyclass instance Serialise Datum diff --git a/plutus-ledger/src/Ledger/Slot.hs b/plutus-ledger/src/Ledger/Slot.hs index 1836f6b433..ca25cbb94d 100644 --- a/plutus-ledger/src/Ledger/Slot.hs +++ b/plutus-ledger/src/Ledger/Slot.hs @@ -24,7 +24,6 @@ module Ledger.Slot( import Codec.Serialise.Class (Serialise) import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) -import Data.Hashable (Hashable) import GHC.Generics (Generic) import Prelude qualified as Haskell import Prettyprinter (Pretty (pretty), (<+>)) @@ -35,7 +34,7 @@ import PlutusTx.Lift (makeLift) import PlutusTx.Prelude import Data.Data (Data) -import Plutus.V1.Ledger.Interval +import PlutusLedgerApi.V1.Interval {- HLINT ignore "Redundant if" -} @@ -45,7 +44,7 @@ newtype Slot = Slot { getSlot :: Integer } deriving stock (Haskell.Eq, Haskell.Ord, Haskell.Show, Generic, Data) deriving anyclass (FromJSON, FromJSONKey, ToJSON, ToJSONKey) deriving newtype (AdditiveSemigroup, AdditiveMonoid, AdditiveGroup, Eq, Ord, Enum, PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) - deriving newtype (Haskell.Num, Haskell.Enum, Haskell.Real, Haskell.Integral, Serialise, Hashable) + deriving newtype (Haskell.Num, Haskell.Enum, Haskell.Real, Haskell.Integral, Serialise) makeLift ''Slot @@ -70,22 +69,18 @@ width (Interval (LowerBound (Finite (Slot s1)) in1) (UpperBound (Finite (Slot s2 width _ = Nothing -deriving anyclass instance (Hashable a) => Hashable (Interval a) deriving anyclass instance (Serialise a) => Serialise (Interval a) deriving anyclass instance (ToJSON a) => ToJSON (Interval a) deriving anyclass instance (FromJSON a) => FromJSON (Interval a) -deriving anyclass instance (Hashable a) => Hashable (LowerBound a) deriving anyclass instance (Serialise a) => Serialise (LowerBound a) deriving anyclass instance (ToJSON a) => ToJSON (LowerBound a) deriving anyclass instance (FromJSON a) => FromJSON (LowerBound a) -deriving anyclass instance (Hashable a) => Hashable (UpperBound a) deriving anyclass instance (Serialise a) => Serialise (UpperBound a) deriving anyclass instance (ToJSON a) => ToJSON (UpperBound a) deriving anyclass instance (FromJSON a) => FromJSON (UpperBound a) -deriving anyclass instance (Hashable a) => Hashable (Extended a) deriving anyclass instance (Serialise a) => Serialise (Extended a) deriving anyclass instance (ToJSON a) => ToJSON (Extended a) deriving anyclass instance (FromJSON a) => FromJSON (Extended a) diff --git a/plutus-ledger/src/Ledger/Test.hs b/plutus-ledger/src/Ledger/Test.hs index 1b892e10bf..e05de6b34a 100644 --- a/plutus-ledger/src/Ledger/Test.hs +++ b/plutus-ledger/src/Ledger/Test.hs @@ -15,18 +15,19 @@ import Plutus.Script.Utils.V1.Address qualified as PV1 import Plutus.Script.Utils.V1.Scripts qualified as PV1 import Plutus.Script.Utils.V2.Address qualified as PV2 import Plutus.Script.Utils.V2.Scripts qualified as PV2 -import Plutus.V1.Ledger.Api (Address, Validator) -import Plutus.V1.Ledger.Api qualified as PV1 -import Plutus.V1.Ledger.Value qualified as Value -import Plutus.V2.Ledger.Api qualified as PV2 +import Plutus.Script.Utils.Value (mpsSymbol) +import PlutusLedgerApi.V1 (Address) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 qualified as PV2 +import PlutusLedgerApi.V3 qualified as PV3 import PlutusTx qualified import Prelude hiding (not) someCode :: PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ()) someCode = $$(PlutusTx.compile [|| \_ _ _ -> () ||]) -someValidator :: Validator -someValidator = PV1.mkValidatorScript someCode +someValidator :: Scripts.Validator +someValidator = Ledger.mkValidatorScript someCode someTypedValidator :: Scripts.TypedValidator Any someTypedValidator = Scripts.unsafeMkTypedValidator (Versioned someValidator PlutusV1) @@ -40,8 +41,8 @@ someCardanoAddress = flip PV1.mkValidatorCardanoAddress someValidator someAddress :: Address someAddress = Ledger.scriptValidatorHashAddress someValidatorHash Nothing -someValidatorV2 :: Validator -someValidatorV2 = PV2.mkValidatorScript someCode +someValidatorV2 :: Scripts.Validator +someValidatorV2 = Ledger.mkValidatorScript someCode someTypedValidatorV2 :: Scripts.TypedValidator Any someTypedValidatorV2 = Scripts.unsafeMkTypedValidator (Versioned someValidator PlutusV2) @@ -63,10 +64,15 @@ mkPolicy _ _ = True mkPolicyV2 :: () -> PV2.ScriptContext -> Bool mkPolicyV2 _ _ = True +{-# INLINABLE mkPolicyV3 #-} +mkPolicyV3 :: () -> PV3.ScriptContext -> Bool +mkPolicyV3 _ _ = True + coinMintingPolicy :: Language -> Versioned Ledger.MintingPolicy coinMintingPolicy lang = case lang of PlutusV1 -> Versioned coinMintingPolicyV1 lang PlutusV2 -> Versioned coinMintingPolicyV2 lang + PlutusV3 -> Versioned coinMintingPolicyV3 lang coinMintingPolicyV1 :: Ledger.MintingPolicy coinMintingPolicyV1 = Ledger.mkMintingPolicyScript @@ -76,27 +82,15 @@ coinMintingPolicyV2 :: Ledger.MintingPolicy coinMintingPolicyV2 = Ledger.mkMintingPolicyScript $$(PlutusTx.compile [|| PSU.mkUntypedMintingPolicy mkPolicyV2 ||]) -coinMintingPolicyHash :: Language -> Ledger.MintingPolicyHash -coinMintingPolicyHash lang = case lang of - PlutusV1 -> coinMintingPolicyHashV1 - PlutusV2 -> coinMintingPolicyHashV2 - -coinMintingPolicyHashV1 :: Ledger.MintingPolicyHash -coinMintingPolicyHashV1 = PV1.mintingPolicyHash coinMintingPolicyV1 +coinMintingPolicyV3 :: Ledger.MintingPolicy +coinMintingPolicyV3 = Ledger.mkMintingPolicyScript + $$(PlutusTx.compile [|| PSU.mkUntypedMintingPolicy mkPolicyV3 ||]) -coinMintingPolicyHashV2 :: Ledger.MintingPolicyHash -coinMintingPolicyHashV2 = PV2.mintingPolicyHash coinMintingPolicyV2 +coinMintingPolicyHash :: Language -> Ledger.MintingPolicyHash +coinMintingPolicyHash = Ledger.mintingPolicyHash . coinMintingPolicy coinMintingPolicyCurrencySymbol :: Language -> Value.CurrencySymbol -coinMintingPolicyCurrencySymbol lang = case lang of - PlutusV1 -> coinMintingPolicyCurrencySymbolV1 - PlutusV2 -> coinMintingPolicyCurrencySymbolV2 - -coinMintingPolicyCurrencySymbolV1 :: Value.CurrencySymbol -coinMintingPolicyCurrencySymbolV1 = Value.mpsSymbol $ coinMintingPolicyHash PlutusV1 - -coinMintingPolicyCurrencySymbolV2 :: Value.CurrencySymbol -coinMintingPolicyCurrencySymbolV2 = Value.mpsSymbol $ coinMintingPolicyHash PlutusV2 +coinMintingPolicyCurrencySymbol = mpsSymbol . coinMintingPolicyHash someToken :: Language -> Value.Value someToken lang = Value.singleton (coinMintingPolicyCurrencySymbol lang) "someToken" 1 diff --git a/plutus-ledger/src/Ledger/Tx.hs b/plutus-ledger/src/Ledger/Tx.hs index d9789effc1..c521cc26b4 100644 --- a/plutus-ledger/src/Ledger/Tx.hs +++ b/plutus-ledger/src/Ledger/Tx.hs @@ -82,8 +82,8 @@ module Ledger.Tx import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C.Api import Cardano.Crypto.Wallet qualified as Crypto -import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..)) -import Cardano.Ledger.Alonzo.TxWitness (txwitsVKey) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..)) +import Cardano.Ledger.Alonzo.TxWits (txwitsVKey) import Codec.Serialise (Serialise) import Control.Lens (Getter, Lens', Traversal', lens, makeLenses, makePrisms, to, view, views, (^.), (^?)) @@ -102,18 +102,17 @@ import Ledger.Slot (SlotRange) import Ledger.Tx.CardanoAPI (CardanoTx (CardanoTx), ToCardanoError (..), pattern CardanoEmulatorEraTx) import Ledger.Tx.CardanoAPI qualified as CardanoAPI -import Plutus.Script.Utils.Scripts (scriptHash) -import Plutus.V1.Ledger.Api qualified as V1 -import Plutus.V2.Ledger.Api qualified as V2 -import Plutus.V2.Ledger.Tx qualified as V2.Tx hiding (TxId (..), TxIn (..), TxInType (..)) +import Plutus.Script.Utils.Scripts (Script, Validator, ValidatorHash (..), scriptHash) +import PlutusLedgerApi.V1 qualified as V1 +import PlutusLedgerApi.V2 qualified as V2 +import PlutusLedgerApi.V2.Tx qualified as V2.Tx hiding (TxId (..)) import Prettyprinter (Pretty (pretty), colon, hang, nest, viaShow, vsep, (<+>)) -- for re-export import Ledger.Index.Internal (UtxoIndex) import Ledger.Tx.Internal as Export -import Plutus.V1.Ledger.Tx as Export hiding (TxId (..), TxIn (..), TxInType (..), TxOut (..), inRef, inType, outAddress, - outValue, pubKeyTxIn, scriptTxIn, txOutDatum, txOutPubKey) -import Plutus.V1.Ledger.Value (Value) +import PlutusLedgerApi.V1.Tx as Export hiding (TxId (..), TxOut (..), outAddress, outValue, txOutDatum, txOutPubKey) +import PlutusLedgerApi.V1.Value (Value) -- | A datum in a transaction output that comes from a chain index query. @@ -142,11 +141,11 @@ data DecoratedTxOut = -- | Optional datum (inline datum or datum in transaction body) attached to the transaction output. _decoratedTxOutPubKeyDatum :: Maybe (V2.DatumHash, DatumFromQuery), -- | Value of the transaction output. - _decoratedTxOutReferenceScript :: Maybe (Versioned V1.Script) + _decoratedTxOutReferenceScript :: Maybe (Versioned Script) } | ScriptDecoratedTxOut { -- | The hash of the script that protects the transaction address - _decoratedTxOutValidatorHash :: V1.ValidatorHash, + _decoratedTxOutValidatorHash :: ValidatorHash, -- | The staking credential of the transaction address, if any _decoratedTxOutStakingCredential :: Maybe V1.StakingCredential, -- | Value of the transaction output. @@ -157,9 +156,9 @@ data DecoratedTxOut = _decoratedTxOutScriptDatum :: (V2.DatumHash, DatumFromQuery), -- The reference script is, in genereal, unrelated to the validator -- script althought it could also be the same. - _decoratedTxOutReferenceScript :: Maybe (Versioned V1.Script), + _decoratedTxOutReferenceScript :: Maybe (Versioned Script), -- | Full version of the validator protecting the transaction output - _decoratedTxOutValidator :: Maybe (Versioned V1.Validator) + _decoratedTxOutValidator :: Maybe (Versioned Validator) } deriving (Show, Eq, Serialise, Generic, ToJSON, FromJSON) @@ -168,16 +167,16 @@ makePrisms ''DecoratedTxOut mkDecoratedTxOut - :: CardanoAddress -> C.Value -> Maybe (V2.DatumHash, DatumFromQuery) -> Maybe (Versioned V1.Script) + :: CardanoAddress -> C.Value -> Maybe (V2.DatumHash, DatumFromQuery) -> Maybe (Versioned Script) -> Maybe DecoratedTxOut mkDecoratedTxOut a v md rs = let sc = cardanoStakingCredential a in case cardanoAddressCredential a of - (V2.PubKeyCredential c) -> Just (PublicKeyDecoratedTxOut c sc v md rs) - (V2.ScriptCredential c) -> (\dt -> ScriptDecoratedTxOut c sc v dt rs Nothing) <$> md + (V2.PubKeyCredential c) -> Just (PublicKeyDecoratedTxOut c sc v md rs) + (V2.ScriptCredential (V2.ScriptHash c)) -> (\dt -> ScriptDecoratedTxOut (ValidatorHash c) sc v dt rs Nothing) <$> md mkPubkeyDecoratedTxOut - :: CardanoAddress -> C.Value -> Maybe (V2.DatumHash, DatumFromQuery) -> Maybe (Versioned V1.Script) + :: CardanoAddress -> C.Value -> Maybe (V2.DatumHash, DatumFromQuery) -> Maybe (Versioned Script) -> Maybe DecoratedTxOut mkPubkeyDecoratedTxOut a v dat rs = let sc = cardanoStakingCredential a @@ -189,20 +188,20 @@ mkScriptDecoratedTxOut :: CardanoAddress -> C.Value -> (V2.DatumHash, DatumFromQuery) - -> Maybe (Versioned V1.Script) - -> Maybe (Versioned V1.Validator) + -> Maybe (Versioned Script) + -> Maybe (Versioned Validator) -> Maybe DecoratedTxOut mkScriptDecoratedTxOut a v dat rs val = let sc = cardanoStakingCredential a in case cardanoAddressCredential a of - (V2.ScriptCredential c) -> pure $ ScriptDecoratedTxOut c sc v dat rs val - _ -> Nothing + (V2.ScriptCredential (V2.ScriptHash c)) -> pure $ ScriptDecoratedTxOut (ValidatorHash c) sc v dat rs val + _ -> Nothing _decoratedTxOutAddress :: DecoratedTxOut -> Address _decoratedTxOutAddress PublicKeyDecoratedTxOut{_decoratedTxOutPubKeyHash, _decoratedTxOutStakingCredential} = V1.Address (V1.PubKeyCredential _decoratedTxOutPubKeyHash) _decoratedTxOutStakingCredential _decoratedTxOutAddress ScriptDecoratedTxOut{_decoratedTxOutValidatorHash, _decoratedTxOutStakingCredential} = - V1.Address (V1.ScriptCredential _decoratedTxOutValidatorHash) _decoratedTxOutStakingCredential + V1.Address (V1.ScriptCredential (V2.ScriptHash (getValidatorHash _decoratedTxOutValidatorHash))) _decoratedTxOutStakingCredential decoratedTxOutAddress :: Getter DecoratedTxOut Address decoratedTxOutAddress = to _decoratedTxOutAddress @@ -223,9 +222,9 @@ toDecoratedTxOut (TxOut (C.TxOut addr' val dt rs)) = toDecoratedDatum (C.TxOutDatumHash _ h) = Just (V2.DatumHash $ V2.toBuiltin (C.serialiseToRawBytes h), DatumUnknown) toDecoratedDatum (C.TxOutDatumInTx _ d) = - Just (V2.DatumHash $ V2.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d)), DatumInBody $ V2.Datum $ CardanoAPI.fromCardanoScriptData d) + Just (V2.DatumHash $ V2.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d)), DatumInBody $ V2.Datum $ CardanoAPI.fromCardanoScriptData d) toDecoratedDatum (C.TxOutDatumInline _ d) = - Just (V2.DatumHash $ V2.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d)), DatumInline $ V2.Datum $ CardanoAPI.fromCardanoScriptData d) + Just (V2.DatumHash $ V2.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d)), DatumInline $ V2.Datum $ CardanoAPI.fromCardanoScriptData d) toTxOut :: C.NetworkId -> DecoratedTxOut -> Either ToCardanoError TxOut toTxOut networkId p = @@ -233,7 +232,7 @@ toTxOut networkId p = <$> CardanoAPI.toCardanoAddressInEra networkId (p ^. decoratedTxOutAddress) <*> pure (CardanoAPI.toCardanoTxOutValue (p ^. decoratedTxOutValue)) <*> (toTxOutDatum $ p ^? decoratedTxOutDatum) - <*> CardanoAPI.toCardanoReferenceScript (p ^. decoratedTxOutReferenceScript)) + <*> pure (CardanoAPI.toCardanoReferenceScript (p ^. decoratedTxOutReferenceScript))) toTxOutDatum :: Maybe (V2.DatumHash, DatumFromQuery) -> Either ToCardanoError (C.TxOutDatum C.CtxTx C.BabbageEra) toTxOutDatum = CardanoAPI.toCardanoTxOutDatum . toPlutusOutputDatum @@ -293,7 +292,7 @@ instance Pretty CardanoTx where in nest 2 $ vsep ["Tx" <+> pretty (getCardanoTxId tx) <> colon, vsep lines'] instance Pretty CardanoAPI.CardanoBuildTx where - pretty txBodyContent = case C.makeSignedTransaction [] <$> CardanoAPI.makeTransactionBody Nothing mempty txBodyContent of + pretty txBodyContent = case C.makeSignedTransaction [] <$> CardanoAPI.makeTransactionBody txBodyContent of Right tx -> pretty $ CardanoEmulatorEraTx tx _ -> viaShow txBodyContent @@ -402,8 +401,8 @@ addCardanoTxSignature privKey = addSignatureCardano addSignatureCardano (CardanoEmulatorEraTx ctx) = CardanoEmulatorEraTx (addSignatureCardano' ctx) - addSignatureCardano' (C.Api.ShelleyTx shelleyBasedEra (ValidatedTx body wits isValid aux)) - = C.Api.ShelleyTx shelleyBasedEra (ValidatedTx body wits' isValid aux) + addSignatureCardano' (C.Api.ShelleyTx shelleyBasedEra (AlonzoTx body wits isValid aux)) + = C.Api.ShelleyTx shelleyBasedEra (AlonzoTx body wits' isValid aux) where wits' = wits <> mempty { txwitsVKey = newWits } newWits = case fromPaymentPrivateKey privKey body of diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs index 1366bae795..01498a0b32 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs @@ -1,13 +1,9 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} {-| @@ -38,9 +34,9 @@ module Ledger.Tx.CardanoAPI( import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C -import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..)) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..)) import Cardano.Ledger.Babbage qualified as Babbage -import Cardano.Ledger.Babbage.TxBody (TxBody (TxBody, reqSignerHashes)) +import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (BabbageTxBody, btbReqSignerHashes)) import Cardano.Ledger.BaseTypes (mkTxIxPartial) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Shelley.API qualified as C.Ledger @@ -49,7 +45,8 @@ import Ledger.Index.Internal qualified as P import Ledger.Scripts qualified as P import Ledger.Tx.CardanoAPI.Internal import Ledger.Tx.Internal qualified as P -import Plutus.V1.Ledger.Api qualified as PV1 +import Plutus.Script.Utils.Scripts qualified as PV1 +import PlutusLedgerApi.V1 qualified as PV1 toCardanoMintWitness :: PV1.Redeemer -> Maybe (P.Versioned PV1.TxOutRef) -> Maybe (P.Versioned PV1.MintingPolicy) -> Either ToCardanoError (C.ScriptWitness C.WitCtxMint C.BabbageEra) @@ -64,24 +61,12 @@ toCardanoScriptWitness :: PV1.ToData a => -> a -> Either (P.Versioned PV1.Script) (P.Versioned PV1.TxOutRef) -> Either ToCardanoError (C.ScriptWitness witctx C.BabbageEra) -toCardanoScriptWitness datum redeemer scriptOrRef = (case lang of - P.PlutusV1 -> - C.PlutusScriptWitness C.PlutusScriptV1InBabbage C.PlutusScriptV1 - <$> (case scriptOrRef of - Left (P.Versioned script _) -> fmap C.PScript (toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV1) script) - Right (P.Versioned ref _) -> flip C.PReferenceScript Nothing <$> toCardanoTxIn ref - ) - P.PlutusV2 -> - C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 - <$> (case scriptOrRef of - Left (P.Versioned script _) -> fmap C.PScript (toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script) - Right (P.Versioned ref _) -> flip C.PReferenceScript Nothing <$> toCardanoTxIn ref - ) +toCardanoScriptWitness datum redeemer scriptOrRef = (case scriptOrRef of + Left script -> pure $ toCardanoTxInScriptWitnessHeader script + Right ref -> toCardanoTxInReferenceWitnessHeader ref ) <*> pure datum - <*> pure (C.fromPlutusData $ PV1.toData redeemer) + <*> pure (C.unsafeHashableScriptData $ C.fromPlutusData $ PV1.toData redeemer) <*> pure zeroExecutionUnits - where - lang = either P.version P.version scriptOrRef fromCardanoTxInsCollateral :: C.TxInsCollateral era -> [C.TxIn] fromCardanoTxInsCollateral C.TxInsCollateralNone = [] @@ -90,9 +75,9 @@ fromCardanoTxInsCollateral (C.TxInsCollateral _ txIns) = txIns toCardanoDatumWitness :: Maybe PV1.Datum -> C.ScriptDatum C.WitCtxTxIn toCardanoDatumWitness = maybe C.InlineScriptDatum (C.ScriptDatumForTxIn . toCardanoScriptData . PV1.getDatum) -type WitnessHeader = C.ScriptDatum C.WitCtxTxIn -> C.ScriptRedeemer -> C.ExecutionUnits -> C.ScriptWitness C.WitCtxTxIn C.BabbageEra +type WitnessHeader witctx = C.ScriptDatum witctx -> C.ScriptRedeemer -> C.ExecutionUnits -> C.ScriptWitness witctx C.BabbageEra -toCardanoTxInReferenceWitnessHeader :: P.Versioned PV1.TxOutRef -> Either ToCardanoError WitnessHeader +toCardanoTxInReferenceWitnessHeader :: P.Versioned PV1.TxOutRef -> Either ToCardanoError (WitnessHeader witctx) toCardanoTxInReferenceWitnessHeader (P.Versioned ref lang) = do txIn <- toCardanoTxIn ref pure $ case lang of @@ -102,16 +87,14 @@ toCardanoTxInReferenceWitnessHeader (P.Versioned ref lang) = do P.PlutusV2 -> C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 $ C.PReferenceScript txIn Nothing + P.PlutusV3 -> error "toCardanoTxInReferenceWitnessHeader: Plutus V3 not supported in Babbage era" -toCardanoTxInScriptWitnessHeader :: P.Versioned PV1.Script -> Either ToCardanoError WitnessHeader -toCardanoTxInScriptWitnessHeader (P.Versioned script lang) = - case lang of - P.PlutusV1 -> - C.PlutusScriptWitness C.PlutusScriptV1InBabbage C.PlutusScriptV1 . C.PScript <$> - toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV1) script - P.PlutusV2 -> - C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 . C.PScript <$> - toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script +toCardanoTxInScriptWitnessHeader :: P.Versioned PV1.Script -> WitnessHeader witctx +toCardanoTxInScriptWitnessHeader script = + case toCardanoScriptInEra script of + C.ScriptInEra _ (C.SimpleScript _) -> error "toCardanoTxInScriptWitnessHeader: impossible simple script" + C.ScriptInEra era (C.PlutusScript v s) -> + C.PlutusScriptWitness era v (C.PScript s) fromCardanoTotalCollateral :: C.TxTotalCollateral C.BabbageEra -> Maybe C.Lovelace fromCardanoTotalCollateral C.TxTotalCollateralNone = Nothing @@ -136,7 +119,7 @@ toCardanoReturnCollateral returnCollateral = Nothing -> C.TxReturnCollateralNone getRequiredSigners :: C.Tx C.BabbageEra -> [P.PaymentPubKeyHash] -getRequiredSigners (C.ShelleyTx _ (ValidatedTx TxBody { reqSignerHashes = rsq } _ _ _)) = +getRequiredSigners (C.ShelleyTx _ (AlonzoTx BabbageTxBody { btbReqSignerHashes = rsq } _ _ _)) = foldMap (pure . P.PaymentPubKeyHash . P.toPlutusPubKeyHash . C.PaymentKeyHash . C.Ledger.coerceKeyRole) rsq fromPlutusIndex :: P.UtxoIndex -> C.Ledger.UTxO (Babbage.BabbageEra StandardCrypto) @@ -148,5 +131,5 @@ fromPlutusTxOutRef (P.TxOutRef txId i) = C.Ledger.TxIn <$> fromPlutusTxId txId < fromPlutusTxId :: PV1.TxId -> Either ToCardanoError (C.Ledger.TxId StandardCrypto) fromPlutusTxId = fmap C.toShelleyTxId . toCardanoTxId -fromPlutusTxOut :: P.TxOut -> Babbage.TxOut (Babbage.BabbageEra StandardCrypto) +fromPlutusTxOut :: P.TxOut -> Babbage.BabbageTxOut (Babbage.BabbageEra StandardCrypto) fromPlutusTxOut = C.toShelleyTxOut C.ShelleyBasedEraBabbage . P.toCtxUTxOTxOut diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs index aecdd78b0b..c5a7f723d0 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE LambdaCase #-} {-| @@ -79,7 +80,6 @@ module Ledger.Tx.CardanoAPI.Internal( , toCardanoScriptDataHash , toCardanoScriptHash , toCardanoStakeKeyHash - , toCardanoPlutusScript , toCardanoScriptInAnyLang , toCardanoReferenceScript , toCardanoTxId @@ -93,18 +93,15 @@ module Ledger.Tx.CardanoAPI.Internal( import Cardano.Api qualified as C import Cardano.Api.Byron qualified as C import Cardano.Api.Shelley qualified as C +import Cardano.Api.TxBody qualified as C import Cardano.BM.Data.Tracer (ToObject) import Cardano.Chain.Common (addrToBase58) -import Cardano.Ledger.Alonzo.Language qualified as Alonzo import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo -import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo +import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo -import Cardano.Ledger.Babbage qualified as Babbage -import Cardano.Ledger.Babbage.PParams qualified as Babbage -import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Core qualified as Ledger -import Codec.Serialise (Serialise, deserialiseOrFail) +import Codec.Serialise (Serialise) import Codec.Serialise qualified as Codec import Codec.Serialise.Decoding (Decoder, decodeBytes, decodeSimple) import Codec.Serialise.Encoding (Encoding (Encoding), Tokens (TkBytes, TkSimple)) @@ -116,8 +113,6 @@ import Data.Aeson.Types (Parser, parseFail, prependFailure, typeMismatch) import Data.Bifunctor (first) import Data.ByteString (ByteString) import Data.ByteString qualified as BS -import Data.ByteString.Lazy qualified as BSL -import Data.ByteString.Short qualified as SBS import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (mapMaybe) @@ -128,16 +123,14 @@ import GHC.Generics (Generic) import Ledger.Address qualified as P import Ledger.Scripts qualified as P import Ledger.Slot qualified as P -import Ledger.Tx.CardanoAPITemp (makeTransactionBody') import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Ada qualified as P -import Plutus.Script.Utils.V1.Scripts qualified as PV1 import Plutus.Script.Utils.V2.Scripts qualified as PV2 -import Plutus.V1.Ledger.Api qualified as PV1 -import Plutus.V1.Ledger.Credential qualified as Credential -import Plutus.V1.Ledger.Tx qualified as PV1 -import Plutus.V1.Ledger.Value qualified as Value -import Plutus.V2.Ledger.Api qualified as PV2 +import Plutus.Script.Utils.Value qualified as Value +import PlutusLedgerApi.V1 qualified as PV1 +import PlutusLedgerApi.V1.Credential qualified as Credential +import PlutusLedgerApi.V1.Tx qualified as PV1 +import PlutusLedgerApi.V2 qualified as PV2 import PlutusTx.Prelude qualified as PlutusTx import Prettyprinter (Pretty (pretty), colon, viaShow, (<+>)) @@ -220,10 +213,10 @@ instance FromJSON (C.ScriptDatum C.WitCtxMint) where instance FromJSON (C.ScriptDatum C.WitCtxStake) where parseJSON _ = pure C.NoScriptDatumForStake -instance ToJSON C.ScriptData where - toJSON = toJSON . C.toPlutusData -instance FromJSON C.ScriptData where - parseJSON = fmap C.fromPlutusData . parseJSON +instance ToJSON C.HashableScriptData where + toJSON = toJSON . C.toPlutusData . C.getScriptData +instance FromJSON C.HashableScriptData where + parseJSON = fmap (C.unsafeHashableScriptData . C.fromPlutusData) . parseJSON instance ToJSON (C.ScriptDatum ctx) => ToJSON (C.ScriptWitness ctx C.BabbageEra) where toJSON C.SimpleScriptWitness{} = error "ToJSON ScriptWitness: Simple scripts not supported" toJSON (C.PlutusScriptWitness _ version script datum red exUnits) = @@ -232,6 +225,7 @@ instance ToJSON (C.ScriptDatum ctx) => ToJSON (C.ScriptWitness ctx C.BabbageEra) , case version of C.PlutusScriptV1 -> "scriptOrReferenceInput" .= script C.PlutusScriptV2 -> "scriptOrReferenceInput" .= script + C.PlutusScriptV3 -> error "ScriptWitness: Plutus V3 not supported in Babbage era" , "datum" .= datum , "redeemer" .= red , "executionUnits" .= exUnits @@ -247,6 +241,7 @@ instance FromJSON (C.ScriptDatum ctx) => FromJSON (C.ScriptWitness ctx C.Babbage case version of C.PlutusScriptV1 -> C.PlutusScriptWitness C.PlutusScriptV1InBabbage C.PlutusScriptV1 <$> v .: "scriptOrReferenceInput" C.PlutusScriptV2 -> C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 <$> v .: "scriptOrReferenceInput" + C.PlutusScriptV3 -> error "ScriptWitness: Plutus V3 not supported in Babbage era" instance ToJSON (C.Witness C.WitCtxTxIn C.BabbageEra) where toJSON (C.KeyWitness C.KeyWitnessForSpending) = Aeson.Null @@ -331,12 +326,13 @@ instance FromJSON (C.TxMetadataInEra C.BabbageEra) where C.metadataFromJson C.TxMetadataJsonDetailedSchema v instance ToJSON (C.ScriptInEra C.BabbageEra) where - toJSON (C.ScriptInEra _ (C.SimpleScript _ _)) = error "ToJSON ScriptInEra: Simple scripts not supported" + toJSON (C.ScriptInEra _ (C.SimpleScript _)) = error "ToJSON ScriptInEra: Simple scripts not supported" toJSON (C.ScriptInEra _ (C.PlutusScript version script)) = Aeson.Object [ "version" .= C.AnyPlutusScriptVersion version , case version of C.PlutusScriptV1 -> "script" .= script C.PlutusScriptV2 -> "script" .= script + C.PlutusScriptV3 -> error "ScriptInEra: Plutus V3 not supported in Babbage era" ] instance FromJSON (C.ScriptInEra C.BabbageEra) where parseJSON = Aeson.withObject "ScriptInEra" $ \v -> do @@ -344,6 +340,7 @@ instance FromJSON (C.ScriptInEra C.BabbageEra) where case version of C.PlutusScriptV1 -> C.ScriptInEra C.PlutusScriptV1InBabbage . C.PlutusScript C.PlutusScriptV1 <$> v .: "script" C.PlutusScriptV2 -> C.ScriptInEra C.PlutusScriptV2InBabbage . C.PlutusScript C.PlutusScriptV2 <$> v .: "script" + C.PlutusScriptV3 -> error "ScriptInEra: Plutus V3 not supported in Babbage era" instance ToJSON (C.TxAuxScripts C.BabbageEra) where toJSON C.TxAuxScriptsNone = Aeson.Null @@ -411,6 +408,7 @@ instance Serialise CardanoTx where encodedMode C.MaryEraInCardanoMode = Encoding (TkSimple 5) encodedMode C.AlonzoEraInCardanoMode = Encoding (TkSimple 6) encodedMode C.BabbageEraInCardanoMode = Encoding (TkSimple 7) + encodedMode C.ConwayEraInCardanoMode = Encoding (TkSimple 8) decode = do w <- decodeSimple case w of @@ -420,6 +418,7 @@ instance Serialise CardanoTx where 5 -> decodeTx C.AsMaryEra C.MaryEraInCardanoMode 6 -> decodeTx C.AsAlonzoEra C.AlonzoEraInCardanoMode 7 -> decodeTx C.AsBabbageEra C.BabbageEraInCardanoMode + 8 -> decodeTx C.AsConwayEra C.ConwayEraInCardanoMode _ -> fail "Unexpected value while decoding Cardano.Api.EraInMode" where decodeTx :: C.IsCardanoEra era => C.AsType era -> C.EraInMode era C.CardanoMode -> Decoder s CardanoTx @@ -445,6 +444,7 @@ instance FromJSON CardanoTx where <|> parseMaryEraInCardanoModeTx v <|> parseAlonzoEraInCardanoModeTx v <|> parseBabbageEraInCardanoModeTx v + <|> parseConwayEraInCardanoModeTx v <|> parseEraInCardanoModeFail v -- | Run code that needs an `IsCardanoEra` constraint while you only have an `EraInMode` value. @@ -455,6 +455,7 @@ withIsCardanoEra C.AllegraEraInCardanoMode r = r withIsCardanoEra C.MaryEraInCardanoMode r = r withIsCardanoEra C.AlonzoEraInCardanoMode r = r withIsCardanoEra C.BabbageEraInCardanoMode r = r +withIsCardanoEra C.ConwayEraInCardanoMode r = r parseByronInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseByronInCardanoModeTx = @@ -481,21 +482,15 @@ parseAlonzoEraInCardanoModeTx = parseSomeCardanoTx "Failed to parse AlonzoEra 'tx' field from CardanoTx" (C.AsTx C.AsAlonzoEra) --- TODO Uncomment the implementation once Cardano.Api adds a FromJSON instance --- for 'EraInMode BabbageEra CardanoMode': --- https://github.com/input-output-hk/cardano-node/pull/3837 parseBabbageEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx -parseBabbageEraInCardanoModeTx (Aeson.Object v) = - CardanoTx - <$> (v .: "tx" >>= \envelope -> either (const $ parseFail "Failed to parse BabbageEra 'tx' field from CardanoTx") - pure - $ C.deserialiseFromTextEnvelope (C.AsTx C.AsBabbageEra) envelope) - <*> pure C.BabbageEraInCardanoMode -- This is a workaround that only works because we tried all other eras first -parseBabbageEraInCardanoModeTx invalid = - prependFailure "parsing CardanoTx failed, " - (typeMismatch "Object" invalid) - -- parseSomeCardanoTx "Failed to parse BabbageEra 'tx' field from CardanoTx" - -- (C.AsTx C.AsBabbageEra) +parseBabbageEraInCardanoModeTx = + parseSomeCardanoTx "Failed to parse BabbageEra 'tx' field from CardanoTx" + (C.AsTx C.AsBabbageEra) + +parseConwayEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx +parseConwayEraInCardanoModeTx = + parseSomeCardanoTx "Failed to parse ConwayEra 'tx' field from CardanoTx" + (C.AsTx C.AsConwayEra) parseEraInCardanoModeFail :: Aeson.Value -> Parser CardanoTx parseEraInCardanoModeFail _ = fail "Unable to parse 'eraInMode'" @@ -536,6 +531,8 @@ fromTxScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInAlonzoEra fromTxScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInAlonzoEra C.ScriptInvalid) = False fromTxScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInBabbageEra C.ScriptValid) = True fromTxScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInBabbageEra C.ScriptInvalid) = False +fromTxScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInConwayEra C.ScriptValid) = True +fromTxScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInConwayEra C.ScriptInvalid) = False fromTxScriptValidity C.TxScriptValidityNone = True toTxScriptValidity :: C.ShelleyBasedEra era -> Bool -> C.TxScriptValidity era @@ -543,8 +540,19 @@ toTxScriptValidity C.ShelleyBasedEraAlonzo True = C.TxScriptValidity C.TxScript toTxScriptValidity C.ShelleyBasedEraAlonzo False = C.TxScriptValidity C.TxScriptValiditySupportedInAlonzoEra C.ScriptInvalid toTxScriptValidity C.ShelleyBasedEraBabbage True = C.TxScriptValidity C.TxScriptValiditySupportedInBabbageEra C.ScriptValid toTxScriptValidity C.ShelleyBasedEraBabbage False = C.TxScriptValidity C.TxScriptValiditySupportedInBabbageEra C.ScriptInvalid +toTxScriptValidity C.ShelleyBasedEraConway True = C.TxScriptValidity C.TxScriptValiditySupportedInConwayEra C.ScriptValid +toTxScriptValidity C.ShelleyBasedEraConway False = C.TxScriptValidity C.TxScriptValiditySupportedInConwayEra C.ScriptInvalid toTxScriptValidity _ _ = C.TxScriptValidityNone +withShelleyBasedEraConstraintsForLedger :: C.ShelleyBasedEra era -> (Ledger.Era (C.ShelleyLedgerEra era) => r) -> r +withShelleyBasedEraConstraintsForLedger = \case + C.ShelleyBasedEraShelley -> id + C.ShelleyBasedEraAllegra -> id + C.ShelleyBasedEraMary -> id + C.ShelleyBasedEraAlonzo -> id + C.ShelleyBasedEraBabbage -> id + C.ShelleyBasedEraConway -> id + -- | Given a 'C.TxBody from a 'C.Tx era', return the datums and redeemers along -- with their hashes. scriptDataFromCardanoTxBody @@ -554,26 +562,27 @@ scriptDataFromCardanoTxBody C.ByronTxBody {} = (mempty, mempty) scriptDataFromCardanoTxBody (C.ShelleyTxBody _ _ _ C.TxBodyNoScriptData _ _) = (mempty, mempty) scriptDataFromCardanoTxBody - (C.ShelleyTxBody _ _ _ (C.TxBodyScriptData _ (Alonzo.TxDats' dats) (Alonzo.Redeemers' reds)) _ _) = - - let datums = Map.fromList - $ fmap ( (\d -> (P.datumHash d, d)) - . P.Datum - . fromCardanoScriptData - . C.fromAlonzoData - ) - $ Map.elems dats - redeemers = Map.fromList - $ map (\(ptr, rdmr) -> - ( redeemerPtrFromCardanoRdmrPtr ptr - , P.Redeemer - $ fromCardanoScriptData - $ C.fromAlonzoData - $ fst rdmr + (C.ShelleyTxBody shelleyBasedEra _ _ (C.TxBodyScriptData _ (Alonzo.TxDats' dats) reds') _ _) = + withShelleyBasedEraConstraintsForLedger shelleyBasedEra $ case reds' of + (Alonzo.Redeemers reds) -> + let datums = Map.fromList + $ fmap ( (\d -> (P.datumHash d, d)) + . P.Datum + . fromCardanoScriptData + . C.fromAlonzoData ) - ) - $ Map.toList reds - in (datums, redeemers) + $ Map.elems dats + redeemers = Map.fromList + $ map (\(ptr, rdmr) -> + ( redeemerPtrFromCardanoRdmrPtr ptr + , P.Redeemer + $ fromCardanoScriptData + $ C.fromAlonzoData + $ fst rdmr + ) + ) + $ Map.toList reds + in (datums, redeemers) redeemerPtrFromCardanoRdmrPtr :: Alonzo.RdmrPtr -> PV1.RedeemerPtr redeemerPtrFromCardanoRdmrPtr (Alonzo.RdmrPtr rdmrTag ptr) = PV1.RedeemerPtr t (toInteger ptr) @@ -590,7 +599,7 @@ redeemerPtrFromCardanoRdmrPtr (Alonzo.RdmrPtr rdmrTag ptr) = PV1.RedeemerPtr t ( plutusScriptsFromTxBody :: C.TxBody era -> Map P.ScriptHash (P.Versioned P.Script) plutusScriptsFromTxBody C.ByronTxBody {} = mempty plutusScriptsFromTxBody (C.ShelleyTxBody shelleyBasedEra _ scripts _ _ _) = - Map.fromList $ mapMaybe (fromLedgerScript shelleyBasedEra) scripts + Map.fromList $ mapMaybe (fmap (\s -> (P.scriptHash s, s)) . fromLedgerScript shelleyBasedEra) scripts -- -- | Convert a script from a Cardano api in shelley based era to a Plutus script along with it's hash. -- @@ -598,43 +607,14 @@ plutusScriptsFromTxBody (C.ShelleyTxBody shelleyBasedEra _ scripts _ _ _) = fromLedgerScript :: C.ShelleyBasedEra era -> Ledger.Script (C.ShelleyLedgerEra era) - -> Maybe (P.ScriptHash, P.Versioned P.Script) -fromLedgerScript C.ShelleyBasedEraShelley _ = Nothing -fromLedgerScript C.ShelleyBasedEraAllegra _ = Nothing -fromLedgerScript C.ShelleyBasedEraMary _ = Nothing -fromLedgerScript C.ShelleyBasedEraAlonzo script = fromLedgerPlutusScript script -fromLedgerScript C.ShelleyBasedEraBabbage script = fromLedgerPlutusScript script - --- | Convert a `cardano-ledger` Plutus script from the Alonzo era and onwards to --- a 'Script' along with it's hash. -fromLedgerPlutusScript :: Alonzo.Script a -> Maybe (P.ScriptHash, P.Versioned P.Script) -fromLedgerPlutusScript Alonzo.TimelockScript {} = Nothing -fromLedgerPlutusScript (Alonzo.PlutusScript Alonzo.PlutusV1 bs) = - let hash = PV1.fromCardanoHash - $ C.hashScript - $ C.PlutusScript C.PlutusScriptV1 $ C.PlutusScriptSerialised bs - script = fmap (\s -> (hash, P.Versioned s P.PlutusV1)) - $ deserialiseOrFail - $ BSL.fromStrict - $ SBS.fromShort bs - in either (const Nothing) Just script -fromLedgerPlutusScript (Alonzo.PlutusScript Alonzo.PlutusV2 bs) = - let hash = PV1.fromCardanoHash - $ C.hashScript - $ C.PlutusScript C.PlutusScriptV2 $ C.PlutusScriptSerialised bs - script = fmap (\s -> (hash, P.Versioned s P.PlutusV2)) - $ deserialiseOrFail - $ BSL.fromStrict - $ SBS.fromShort bs - in either (const Nothing) Just script + -> Maybe (P.Versioned P.Script) +fromLedgerScript e s = fromCardanoScriptInEra $ C.fromShelleyBasedScript e s makeTransactionBody - :: Maybe (Babbage.PParams (Babbage.BabbageEra StandardCrypto)) - -> Map Alonzo.RdmrPtr Alonzo.ExUnits - -> CardanoBuildTx + :: CardanoBuildTx -> Either ToCardanoError (C.TxBody C.BabbageEra) -makeTransactionBody pparams exUnits (CardanoBuildTx txBodyContent) = - first (TxBodyError . C.displayError) $ makeTransactionBody' pparams exUnits txBodyContent +makeTransactionBody (CardanoBuildTx txBodyContent) = + first (TxBodyError . C.displayError) $ C.createTransactionBody C.ShelleyBasedEraBabbage txBodyContent fromCardanoTxIn :: C.TxIn -> PV1.TxOutRef fromCardanoTxIn (C.TxIn txId (C.TxIx txIx)) = PV1.TxOutRef (fromCardanoTxId txId) (toInteger txIx) @@ -683,7 +663,7 @@ fromCardanoTxOutToPV2TxInfoTxOut' (C.TxOut addr value datum refScript) = refScriptToScriptHash :: C.ReferenceScript era -> Maybe PV2.ScriptHash refScriptToScriptHash C.ReferenceScriptNone = Nothing refScriptToScriptHash (C.ReferenceScript _ (C.ScriptInAnyLang _ s)) = - let (PV2.ValidatorHash h) = fromCardanoScriptHash $ C.hashScript s + let (P.ScriptHash h) = fromCardanoScriptHash $ C.hashScript s in Just $ PV2.ScriptHash h toCardanoTxOut @@ -742,11 +722,11 @@ toCardanoPaymentKeyHash (P.PaymentPubKeyHash (PV1.PubKeyHash bs)) = in tag tg $ deserialiseFromRawBytes (C.AsHash C.AsPaymentKey) bsx {-# DEPRECATED fromCardanoScriptHash "Shouldn't be used as we use Cardano address internally now" #-} -fromCardanoScriptHash :: C.ScriptHash -> P.ValidatorHash -fromCardanoScriptHash scriptHash = P.ValidatorHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes scriptHash +fromCardanoScriptHash :: C.ScriptHash -> P.ScriptHash +fromCardanoScriptHash scriptHash = P.ScriptHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes scriptHash -toCardanoScriptHash :: P.ValidatorHash -> Either ToCardanoError C.ScriptHash -toCardanoScriptHash (P.ValidatorHash bs) = tag "toCardanoScriptHash" $ deserialiseFromRawBytes C.AsScriptHash $ PlutusTx.fromBuiltin bs +toCardanoScriptHash :: P.ScriptHash -> Either ToCardanoError C.ScriptHash +toCardanoScriptHash (P.ScriptHash bs) = tag "toCardanoScriptHash" $ deserialiseFromRawBytes C.AsScriptHash $ PlutusTx.fromBuiltin bs {-# DEPRECATED fromCardanoStakeAddressReference "Shouldn't be used as we use Cardano address internally now" #-} fromCardanoStakeAddressReference :: C.StakeAddressReference -> Maybe Credential.StakingCredential @@ -789,16 +769,16 @@ fromCardanoTxOutDatumHash C.TxOutDatumNone = Nothing fromCardanoTxOutDatumHash (C.TxOutDatumHash _ h) = Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes h) fromCardanoTxOutDatumHash (C.TxOutDatumInTx _ d) = - Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d)) + Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d)) fromCardanoTxOutDatumHash (C.TxOutDatumInline _ d) = - Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d)) + Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d)) fromCardanoTxOutDatumHash' :: C.TxOutDatum C.CtxUTxO era -> Maybe P.DatumHash fromCardanoTxOutDatumHash' C.TxOutDatumNone = Nothing fromCardanoTxOutDatumHash' (C.TxOutDatumHash _ h) = Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes h) fromCardanoTxOutDatumHash' (C.TxOutDatumInline _ d) = - Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d)) + Just $ P.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d)) fromCardanoTxOutDatum :: C.TxOutDatum C.CtxTx era -> PV2.OutputDatum fromCardanoTxOutDatum C.TxOutDatumNone = @@ -806,7 +786,7 @@ fromCardanoTxOutDatum C.TxOutDatumNone = fromCardanoTxOutDatum (C.TxOutDatumHash _ h) = PV2.OutputDatumHash $ PV2.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes h) fromCardanoTxOutDatum (C.TxOutDatumInTx _ d) = - PV2.OutputDatumHash $ PV2.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptData d)) + PV2.OutputDatumHash $ PV2.DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes (C.hashScriptDataBytes d)) fromCardanoTxOutDatum (C.TxOutDatumInline _ d) = PV2.OutputDatum $ PV2.Datum $ fromCardanoScriptData d @@ -823,17 +803,18 @@ toCardanoTxOutNoDatum = C.TxOutDatumNone toCardanoTxOutDatumInTx :: PV2.Datum -> C.TxOutDatum C.CtxTx C.BabbageEra toCardanoTxOutDatumInTx = - C.TxOutDatumInTx C.ScriptDataInBabbageEra . C.fromPlutusData . PV2.builtinDataToData . PV2.getDatum + C.TxOutDatumInTx C.ScriptDataInBabbageEra . C.unsafeHashableScriptData . C.fromPlutusData . PV2.builtinDataToData . PV2.getDatum toCardanoTxOutDatumInline :: PV2.Datum -> C.TxOutDatum C.CtxTx C.BabbageEra toCardanoTxOutDatumInline = C.TxOutDatumInline C.ReferenceTxInsScriptsInlineDatumsInBabbageEra - . C.fromPlutusData . PV2.builtinDataToData . PV2.getDatum + . C.unsafeHashableScriptData . C.fromPlutusData . PV2.builtinDataToData . PV2.getDatum toCardanoTxOutDatumHashFromDatum :: PV2.Datum -> C.TxOutDatum ctx C.BabbageEra toCardanoTxOutDatumHashFromDatum = C.TxOutDatumHash C.ScriptDataInBabbageEra - . C.hashScriptData + . C.hashScriptDataBytes + . C.unsafeHashableScriptData . C.fromPlutusData . PV2.builtinDataToData . PV2.getDatum @@ -959,11 +940,11 @@ fromCardanoSlotNo (C.SlotNo w64) = P.Slot (toInteger w64) toCardanoSlotNo :: P.Slot -> C.SlotNo toCardanoSlotNo (P.Slot i) = C.SlotNo (fromInteger i) -fromCardanoScriptData :: C.ScriptData -> PV1.BuiltinData -fromCardanoScriptData = PV1.dataToBuiltinData . C.toPlutusData +fromCardanoScriptData :: C.HashableScriptData -> PV1.BuiltinData +fromCardanoScriptData = PV1.dataToBuiltinData . C.toPlutusData . C.getScriptData -toCardanoScriptData :: PV1.BuiltinData -> C.ScriptData -toCardanoScriptData = C.fromPlutusData . PV1.builtinDataToData +toCardanoScriptData :: PV1.BuiltinData -> C.HashableScriptData +toCardanoScriptData = C.unsafeHashableScriptData . C.fromPlutusData . PV1.builtinDataToData fromCardanoScriptInEra :: C.ScriptInEra era -> Maybe (P.Versioned P.Script) fromCardanoScriptInEra (C.ScriptInEra C.PlutusScriptV1InAlonzo (C.PlutusScript C.PlutusScriptV1 script)) = @@ -972,48 +953,50 @@ fromCardanoScriptInEra (C.ScriptInEra C.PlutusScriptV1InBabbage (C.PlutusScript Just (P.Versioned (fromCardanoPlutusScript script) P.PlutusV1) fromCardanoScriptInEra (C.ScriptInEra C.PlutusScriptV2InBabbage (C.PlutusScript C.PlutusScriptV2 script)) = Just (P.Versioned (fromCardanoPlutusScript script) P.PlutusV2) +fromCardanoScriptInEra (C.ScriptInEra C.PlutusScriptV1InConway (C.PlutusScript C.PlutusScriptV1 script)) = + Just (P.Versioned (fromCardanoPlutusScript script) P.PlutusV1) +fromCardanoScriptInEra (C.ScriptInEra C.PlutusScriptV2InConway (C.PlutusScript C.PlutusScriptV2 script)) = + Just (P.Versioned (fromCardanoPlutusScript script) P.PlutusV2) +fromCardanoScriptInEra (C.ScriptInEra C.PlutusScriptV3InConway (C.PlutusScript C.PlutusScriptV3 script)) = + Just (P.Versioned (fromCardanoPlutusScript script) P.PlutusV3) fromCardanoScriptInEra (C.ScriptInEra _ C.SimpleScript{}) = Nothing -toCardanoScriptInEra :: P.Versioned P.Script -> Either ToCardanoError (C.ScriptInEra C.BabbageEra) -toCardanoScriptInEra (P.Versioned script P.PlutusV1) = C.ScriptInEra C.PlutusScriptV1InBabbage . C.PlutusScript C.PlutusScriptV1 <$> toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV1) script -toCardanoScriptInEra (P.Versioned script P.PlutusV2) = C.ScriptInEra C.PlutusScriptV2InBabbage . C.PlutusScript C.PlutusScriptV2 <$> toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script - -fromCardanoPlutusScript :: C.HasTypeProxy lang => C.PlutusScript lang -> P.Script -fromCardanoPlutusScript = Codec.deserialise . BSL.fromStrict . C.serialiseToRawBytes +toCardanoScriptInEra :: P.Versioned P.Script -> C.ScriptInEra C.BabbageEra +toCardanoScriptInEra (P.Versioned (P.Script s) P.PlutusV1) = C.ScriptInEra C.PlutusScriptV1InBabbage . C.PlutusScript C.PlutusScriptV1 $ C.PlutusScriptSerialised s +toCardanoScriptInEra (P.Versioned (P.Script s) P.PlutusV2) = C.ScriptInEra C.PlutusScriptV2InBabbage . C.PlutusScript C.PlutusScriptV2 $ C.PlutusScriptSerialised s +toCardanoScriptInEra (P.Versioned _ P.PlutusV3) = error "toCardanoScriptInEra: Plutus V3 not supported in Babbage era" -toCardanoPlutusScript - :: C.SerialiseAsRawBytes plutusScript - => C.AsType plutusScript - -> P.Script - -> Either ToCardanoError plutusScript -toCardanoPlutusScript asPlutusScriptType = - tag "toCardanoPlutusScript" - . deserialiseFromRawBytes asPlutusScriptType . BSL.toStrict . Codec.serialise +fromCardanoPlutusScript :: C.PlutusScript lang -> P.Script +fromCardanoPlutusScript (C.PlutusScriptSerialised s) = P.Script s fromCardanoScriptInAnyLang :: C.ScriptInAnyLang -> Maybe (P.Versioned P.Script) -fromCardanoScriptInAnyLang (C.ScriptInAnyLang _sl (C.SimpleScript _ssv _ss)) = Nothing +fromCardanoScriptInAnyLang (C.ScriptInAnyLang _sl (C.SimpleScript _)) = Nothing fromCardanoScriptInAnyLang (C.ScriptInAnyLang _sl (C.PlutusScript psv ps)) = Just $ case psv of C.PlutusScriptV1 -> P.Versioned (fromCardanoPlutusScript ps) P.PlutusV1 C.PlutusScriptV2 -> P.Versioned (fromCardanoPlutusScript ps) P.PlutusV2 + C.PlutusScriptV3 -> P.Versioned (fromCardanoPlutusScript ps) P.PlutusV3 -toCardanoScriptInAnyLang :: P.Versioned P.Script -> Either ToCardanoError C.ScriptInAnyLang -toCardanoScriptInAnyLang (P.Versioned script P.PlutusV1) = +toCardanoScriptInAnyLang :: P.Versioned P.Script -> C.ScriptInAnyLang +toCardanoScriptInAnyLang (P.Versioned (P.Script s) P.PlutusV1) = C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV1) . C.PlutusScript C.PlutusScriptV1 - <$> toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV1) script -toCardanoScriptInAnyLang (P.Versioned script P.PlutusV2) = + $ C.PlutusScriptSerialised s +toCardanoScriptInAnyLang (P.Versioned (P.Script s) P.PlutusV2) = C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV2) . C.PlutusScript C.PlutusScriptV2 - <$> toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script + $ C.PlutusScriptSerialised s +toCardanoScriptInAnyLang (P.Versioned (P.Script s) P.PlutusV3) = + C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV3) . C.PlutusScript C.PlutusScriptV3 + $ C.PlutusScriptSerialised s fromCardanoReferenceScript :: C.ReferenceScript C.BabbageEra -> Maybe (P.Versioned P.Script) fromCardanoReferenceScript C.ReferenceScriptNone = Nothing fromCardanoReferenceScript (C.ReferenceScript _ script) = fromCardanoScriptInAnyLang script -toCardanoReferenceScript :: Maybe (P.Versioned P.Script) -> Either ToCardanoError (C.ReferenceScript C.BabbageEra) -toCardanoReferenceScript (Just script) = C.ReferenceScript C.ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> toCardanoScriptInAnyLang script -toCardanoReferenceScript Nothing = pure C.ReferenceScriptNone +toCardanoReferenceScript :: Maybe (P.Versioned P.Script) -> C.ReferenceScript C.BabbageEra +toCardanoReferenceScript (Just script) = C.ReferenceScript C.ReferenceTxInsScriptsInlineDatumsInBabbageEra $ toCardanoScriptInAnyLang script +toCardanoReferenceScript Nothing = C.ReferenceScriptNone deserialiseFromRawBytes :: C.SerialiseAsRawBytes t => C.AsType t -> ByteString -> Either ToCardanoError t -deserialiseFromRawBytes asType = maybe (Left DeserialisationError) Right . C.deserialiseFromRawBytes asType +deserialiseFromRawBytes asType = either (const (Left DeserialisationError)) Right . C.deserialiseFromRawBytes asType tag :: String -> Either ToCardanoError t -> Either ToCardanoError t tag s = first (Tag s) diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPITemp.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPITemp.hs deleted file mode 100644 index bfe53c4cfc..0000000000 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPITemp.hs +++ /dev/null @@ -1,280 +0,0 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE EmptyCase #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} --- Code temporarily copied over from cardano-api, --- until https://github.com/input-output-hk/cardano-node/pull/2936 or something similar gets merged. -module Ledger.Tx.CardanoAPITemp (makeTransactionBody', toShelleyTxOut) where - -import Data.List qualified as List -import Data.Map.Strict qualified as Map -import Data.Maybe qualified as Maybe -import Data.Sequence.Strict qualified as Seq -import Data.Set qualified as Set -import Data.Word (Word64) - -import Cardano.Api -import Cardano.Api.Shelley hiding (toShelleyTxOut) -import Cardano.Ledger.AuxiliaryData qualified as Ledger (hashAuxiliaryData) -import Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe) -import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Serialization qualified as CBOR (mkSized) -import Ouroboros.Consensus.Shelley.Eras (StandardBabbage) - -import Cardano.Ledger.Core qualified as Ledger -import Cardano.Ledger.Era qualified as Ledger - -import Cardano.Ledger.Alonzo.Data qualified as Alonzo -import Cardano.Ledger.Alonzo.Language qualified as Alonzo -import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo -import Cardano.Ledger.Alonzo.Tx qualified as Alonzo -import Cardano.Ledger.Alonzo.TxBody qualified as Alonzo -import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo - -import Cardano.Ledger.Babbage qualified as Babbage -import Cardano.Ledger.Babbage.PParams qualified as Babbage -import Cardano.Ledger.Babbage.Tx qualified as Babbage -import Cardano.Ledger.Babbage.TxBody qualified as Babbage - -import Cardano.Ledger.ShelleyMA.TxBody qualified as Allegra - -import Cardano.Ledger.Keys qualified as Shelley -import Cardano.Ledger.Shelley.Tx qualified as Shelley -import Cardano.Ledger.Shelley.TxBody qualified as Shelley - -makeTransactionBody' - :: Maybe (Babbage.PParams (Babbage.BabbageEra StandardCrypto)) - -> Map.Map Alonzo.RdmrPtr Alonzo.ExUnits - -> TxBodyContent BuildTx BabbageEra - -> Either TxBodyError (TxBody BabbageEra) -makeTransactionBody' - mpparams - exUnits - txbodycontent@TxBodyContent { - txIns, - txInsCollateral, - txInsReference, - txOuts, - txReturnCollateral, - txTotalCollateral, - txFee, - txValidityRange = (lowerBound, upperBound), - txExtraKeyWits, - txWithdrawals, - txCertificates, - txMintValue, - txScriptValidity, - txMetadata, - txAuxScripts - } = - return $ - ShelleyTxBody era - (Babbage.TxBody - { Babbage.inputs = Set.fromList (map (toShelleyTxIn . fst) txIns) - , Babbage.collateral = - case txInsCollateral of - TxInsCollateralNone -> Set.empty - TxInsCollateral _ txins -> Set.fromList (map toShelleyTxIn txins) - , Babbage.referenceInputs = - case txInsReference of - TxInsReferenceNone -> Set.empty - TxInsReference _ txins -> Set.fromList (map toShelleyTxIn txins) - , Babbage.outputs = Seq.fromList (map (CBOR.mkSized . toShelleyTxOut era) txOuts) - , Babbage.collateralReturn = - case txReturnCollateral of - TxReturnCollateralNone -> SNothing - TxReturnCollateral _ colTxOut -> SJust $ CBOR.mkSized $ toShelleyTxOut era colTxOut - , Babbage.totalCollateral = - case txTotalCollateral of - TxTotalCollateralNone -> SNothing - TxTotalCollateral _ lv -> SJust $ toShelleyLovelace lv - , Babbage.txcerts = - case txCertificates of - TxCertificatesNone -> Seq.empty - TxCertificates _ cs _ -> Seq.fromList (map toShelleyCertificate cs) - , Babbage.txwdrls = - case txWithdrawals of - TxWithdrawalsNone -> Shelley.Wdrl Map.empty - TxWithdrawals _ ws -> toShelleyWithdrawal ws - , Babbage.txfee = - case txFee of - TxFeeImplicit era' -> case era' of {} - TxFeeExplicit _ fee -> toShelleyLovelace fee - , Babbage.txvldt = - Allegra.ValidityInterval { - invalidBefore = case lowerBound of - TxValidityNoLowerBound -> SNothing - TxValidityLowerBound _ s -> SJust s, - invalidHereafter = case upperBound of - TxValidityNoUpperBound _ -> SNothing - TxValidityUpperBound _ s -> SJust s - } - , Babbage.txUpdates = SNothing -- ignoring txUpdateProposal in CardanoAPITemp - , Babbage.reqSignerHashes = - case txExtraKeyWits of - TxExtraKeyWitnessesNone -> Set.empty - TxExtraKeyWitnesses _ khs -> Set.fromList - [ Shelley.coerceKeyRole kh - | PaymentKeyHash kh <- khs ] - , Babbage.mint = - case txMintValue of - TxMintNone -> mempty - TxMintValue _ v _ -> toMaryValue v - , Babbage.scriptIntegrityHash = - case mpparams of - Nothing -> SNothing - Just pparams -> - Alonzo.hashScriptIntegrity - (Set.map - (Alonzo.getLanguageView pparams) - languages - ) - redeemers - datums - , Babbage.adHash = - maybeToStrictMaybe (Ledger.hashAuxiliaryData <$> txAuxData) - , Babbage.txnetworkid = SNothing - }) - scripts - (TxBodyScriptData ScriptDataInBabbageEra datums redeemers) - txAuxData - txScriptValidity - -- TODO alonzo: support the supplementary script data - where - era = ShelleyBasedEraBabbage - - witnesses :: [(ScriptWitnessIndex, AnyScriptWitness BabbageEra)] - witnesses = collectTxBodyScriptWitnesses txbodycontent - - scripts :: [Ledger.Script StandardBabbage] - scripts = Maybe.catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness - | (_, AnyScriptWitness scriptwitness) <- witnesses - ] - - datums :: Alonzo.TxDats StandardBabbage - datums = - Alonzo.TxDats $ - Map.fromList - [ (Alonzo.hashData d', d') - | d <- scriptdata - , let d' = toAlonzoData d - ] - - scriptdata :: [ScriptData] - scriptdata = List.nub $ - [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ] - ++ [ d | (_, AnyScriptWitness - (PlutusScriptWitness - _ _ _ (ScriptDatumForTxIn d) _ _)) <- witnesses - ] - - redeemers :: Alonzo.Redeemers StandardBabbage - redeemers = - Alonzo.Redeemers $ - Map.fromList - [ let ptr = toAlonzoRdmrPtr idx in (ptr, (toAlonzoData d, Maybe.fromMaybe (toAlonzoExUnits e) $ Map.lookup ptr exUnits)) - | (idx, AnyScriptWitness - (PlutusScriptWitness _ _ _ _ d e)) <- witnesses - ] - - languages :: Set.Set Alonzo.Language - languages = - Set.fromList $ Maybe.catMaybes - [ getScriptLanguage sw - | (_, AnyScriptWitness sw) <- witnesses - ] - - getScriptLanguage :: ScriptWitness witctx era -> Maybe Alonzo.Language - getScriptLanguage (PlutusScriptWitness _ v _ _ _ _) = - Just $ toAlonzoLanguage (AnyPlutusScriptVersion v) - getScriptLanguage SimpleScriptWitness{} = Nothing - - txAuxData :: Maybe (Ledger.AuxiliaryData StandardBabbage) - txAuxData - | Map.null ms - , null ss = Nothing - | otherwise = Just (toAlonzoAuxiliaryData ms ss) - where - ms = case txMetadata of - TxMetadataNone -> Map.empty - TxMetadataInEra _ (TxMetadata ms') -> ms' - ss = case txAuxScripts of - TxAuxScriptsNone -> [] - TxAuxScripts _ ss' -> ss' - - -toShelleyWithdrawal :: [(StakeAddress, Lovelace, a)] -> Shelley.Wdrl StandardCrypto -toShelleyWithdrawal withdrawals = - Shelley.Wdrl $ - Map.fromList - [ (toShelleyStakeAddr stakeAddr, toShelleyLovelace value) - | (stakeAddr, value, _) <- withdrawals ] - -toShelleyTxOut :: forall era ledgerera. - (ShelleyLedgerEra era ~ ledgerera, IsShelleyBasedEra era) - => ShelleyBasedEra era -> TxOut CtxTx era -> Ledger.TxOut ledgerera -toShelleyTxOut _ (TxOut _ (TxOutAdaOnly AdaOnlyInByronEra _) _ _) = - case shelleyBasedEra :: ShelleyBasedEra era of {} - -toShelleyTxOut _ (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value) _ _) = - Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value) - -toShelleyTxOut _ (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value) _ _) = - Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value) - -toShelleyTxOut _ (TxOut addr (TxOutValue MultiAssetInMaryEra value) _ _) = - Shelley.TxOut (toShelleyAddr addr) (toMaryValue value) - --- | Copied from Cardano API to handle all TxOut contexts, we can --- propose a PR to cardano-node to propagate this version and remove the code duplication -toShelleyTxOut _ (TxOut addr (TxOutValue MultiAssetInAlonzoEra value) txoutdata _) = - Alonzo.TxOut (toShelleyAddr addr) (toMaryValue value) - (toAlonzoTxOutDataHash txoutdata) - -toShelleyTxOut era (TxOut addr (TxOutValue MultiAssetInBabbageEra value) txoutdata refScript) = - let cEra = shelleyBasedToCardanoEra era - in Babbage.TxOut (toShelleyAddr addr) (toMaryValue value) - (toBabbageTxOutDatum txoutdata) - (refScriptToShelleyScript cEra refScript) - - -toAlonzoTxOutDataHash :: TxOutDatum CtxTx era - -> StrictMaybe (Alonzo.DataHash StandardCrypto) -toAlonzoTxOutDataHash TxOutDatumNone = SNothing -toAlonzoTxOutDataHash (TxOutDatumHash _ (ScriptDataHash dh)) = SJust dh -toAlonzoTxOutDataHash (TxOutDatumInTx _ d) = let ScriptDataHash dh = hashScriptData d in SJust dh -toAlonzoTxOutDataHash (TxOutDatumInline _ d) = let ScriptDataHash dh = hashScriptData d in SJust dh - -toBabbageTxOutDatum - :: Ledger.Crypto (ShelleyLedgerEra era) ~ StandardCrypto - => TxOutDatum CtxTx era -> Babbage.Datum (ShelleyLedgerEra era) -toBabbageTxOutDatum TxOutDatumNone = Babbage.NoDatum -toBabbageTxOutDatum (TxOutDatumHash _ (ScriptDataHash dh)) = Babbage.DatumHash dh -toBabbageTxOutDatum (TxOutDatumInTx _ d) = let ScriptDataHash dh = hashScriptData d in Babbage.DatumHash dh -toBabbageTxOutDatum (TxOutDatumInline _ sd) = scriptDataToInlineDatum sd - -scriptDataToInlineDatum :: ScriptData -> Babbage.Datum ledgerera -scriptDataToInlineDatum = Babbage.Datum . Alonzo.dataToBinaryData . toAlonzoData - -toAlonzoLanguage :: AnyPlutusScriptVersion -> Alonzo.Language -toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Alonzo.PlutusV1 -toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV2) = Alonzo.PlutusV2 - --- | In the Alonzo and later eras the auxiliary data consists of the tx metadata --- and the axiliary scripts, and the axiliary script data. --- -toAlonzoAuxiliaryData :: forall era ledgerera. - ShelleyLedgerEra era ~ ledgerera - => Ledger.AuxiliaryData ledgerera ~ Alonzo.AuxiliaryData ledgerera - => Ledger.Script ledgerera ~ Alonzo.Script ledgerera - => Ledger.Era ledgerera - => Map.Map Word64 TxMetadataValue - -> [ScriptInEra era] - -> Ledger.AuxiliaryData ledgerera -toAlonzoAuxiliaryData m ss = - Alonzo.AuxiliaryData - (toShelleyMetadata m) - (Seq.fromList (map toShelleyScript ss)) diff --git a/plutus-ledger/src/Ledger/Tx/Internal.hs b/plutus-ledger/src/Ledger/Tx/Internal.hs index ea96bf8103..48921bb6fe 100644 --- a/plutus-ledger/src/Ledger/Tx/Internal.hs +++ b/plutus-ledger/src/Ledger/Tx/Internal.hs @@ -20,15 +20,11 @@ module Ledger.Tx.Internal ) where import Cardano.Api qualified as C -import Cardano.Api.Shelley qualified as C hiding (toShelleyTxOut) +import Cardano.Api.Shelley qualified as C import Cardano.Binary qualified as C import Cardano.Ledger.Alonzo.Genesis () import Codec.Serialise (Serialise, decode, encode) -import Cardano.Ledger.Core qualified as Ledger (TxOut) -import Cardano.Ledger.Serialization qualified as Ledger (Sized, mkSized) -import Ouroboros.Consensus.Shelley.Eras qualified as Ledger - import Control.Lens qualified as L import Data.Aeson (FromJSON, ToJSON) import Data.Default (def) @@ -40,15 +36,14 @@ import Ledger.Address (CardanoAddress, cardanoPubKeyHash) import Ledger.Contexts.Orphans () import Ledger.Crypto import Ledger.DCert.Orphans () -import Ledger.Tx.CardanoAPITemp qualified as C import Ledger.Tx.Orphans () import Ledger.Tx.Orphans.V2 () import Plutus.Script.Utils.Scripts -import Plutus.V1.Ledger.Api (Credential, DCert, dataToBuiltinData) -import Plutus.V1.Ledger.Scripts -import Plutus.V1.Ledger.Tx hiding (TxIn (..), TxInType (..), TxOut (..), inRef, inType, pubKeyTxIn, scriptTxIn) -import PlutusTx (FromData (..)) +import PlutusLedgerApi.V1 (Credential, DCert, dataToBuiltinData) +import PlutusLedgerApi.V1.Scripts +import PlutusLedgerApi.V1.Tx hiding (TxOut (..)) +import PlutusTx (FromData (..), fromData) import PlutusTx.Prelude qualified as PlutusTx import Prettyprinter (Pretty (..), viaShow) @@ -98,7 +93,7 @@ newtype TxOut = TxOut {getTxOut :: C.TxOut C.CtxTx C.BabbageEra} deriving newtype (Pretty) instance C.ToCBOR TxOut where - toCBOR (TxOut txout) = C.toCBOR $ C.toShelleyTxOut C.ShelleyBasedEraBabbage txout + toCBOR = C.toCBOR . C.toShelleyTxOut C.ShelleyBasedEraBabbage . toCtxUTxOTxOut instance C.FromCBOR TxOut where fromCBOR = do @@ -109,9 +104,6 @@ instance Serialise TxOut where encode = C.toCBOR decode = C.fromCBOR -toSizedTxOut :: TxOut -> Ledger.Sized (Ledger.TxOut Ledger.StandardBabbage) -toSizedTxOut = Ledger.mkSized . C.toShelleyTxOut C.ShelleyBasedEraBabbage . getTxOut - toCtxUTxOTxOut :: TxOut -> C.TxOut C.CtxUTxO C.BabbageEra toCtxUTxOTxOut = C.toCtxUTxOTxOut . getTxOut @@ -128,9 +120,9 @@ txOutDatumHash (TxOut (C.TxOut _aie _tov tod _rs)) = C.TxOutDatumHash _era scriptDataHash -> Just $ DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes scriptDataHash) C.TxOutDatumInline _era scriptData -> - Just $ datumHash $ Datum $ dataToBuiltinData $ C.toPlutusData scriptData + Just $ datumHash $ Datum $ dataToBuiltinData $ C.toPlutusData $ C.getScriptData scriptData C.TxOutDatumInTx _era scriptData -> - Just $ datumHash $ Datum $ dataToBuiltinData $ C.toPlutusData scriptData + Just $ datumHash $ Datum $ dataToBuiltinData $ C.toPlutusData $ C.getScriptData scriptData txOutDatum :: forall d . FromData d => TxOut -> Maybe d txOutDatum (TxOut (C.TxOut _aie _tov tod _rs)) = @@ -140,9 +132,9 @@ txOutDatum (TxOut (C.TxOut _aie _tov tod _rs)) = C.TxOutDatumHash _era _scriptDataHash -> Nothing C.TxOutDatumInline _era scriptData -> - fromBuiltinData @d $ dataToBuiltinData $ C.toPlutusData scriptData + fromData @d $ C.toPlutusData $ C.getScriptData scriptData C.TxOutDatumInTx _era scriptData -> - fromBuiltinData @d $ dataToBuiltinData $ C.toPlutusData scriptData + fromData @d $ C.toPlutusData $ C.getScriptData scriptData cardanoTxOutDatumHash :: C.TxOutDatum C.CtxUTxO C.BabbageEra -> Maybe (C.Hash C.ScriptData) @@ -151,7 +143,7 @@ cardanoTxOutDatumHash = \case Nothing C.TxOutDatumHash _era scriptDataHash -> Just scriptDataHash - C.TxOutDatumInline _era scriptData -> Just $ C.hashScriptData scriptData + C.TxOutDatumInline _era scriptData -> Just $ C.hashScriptDataBytes scriptData txOutPubKey :: TxOut -> Maybe PubKeyHash diff --git a/plutus-ledger/src/Ledger/Tx/Orphans.hs b/plutus-ledger/src/Ledger/Tx/Orphans.hs index 5b91915b9d..bca744307b 100644 --- a/plutus-ledger/src/Ledger/Tx/Orphans.hs +++ b/plutus-ledger/src/Ledger/Tx/Orphans.hs @@ -76,7 +76,7 @@ instance Serialise C.TxId where encode = encode . C.serialiseToRawBytes decode = do bs <- decode - maybe (fail "Can get back Tx ID") + either (fail . show) pure $ C.deserialiseFromRawBytes C.AsTxId bs diff --git a/plutus-ledger/src/Ledger/Tx/Orphans/V1.hs b/plutus-ledger/src/Ledger/Tx/Orphans/V1.hs index 843121fe99..f31e1a84b0 100644 --- a/plutus-ledger/src/Ledger/Tx/Orphans/V1.hs +++ b/plutus-ledger/src/Ledger/Tx/Orphans/V1.hs @@ -25,9 +25,9 @@ import Ledger.Address.Orphans () import Ledger.Builtins.Orphans () import Ledger.Value.Orphans () -import Plutus.V1.Ledger.Api -import Plutus.V1.Ledger.Bytes qualified as Bytes -import Plutus.V1.Ledger.Tx +import PlutusLedgerApi.V1 +import PlutusLedgerApi.V1.Bytes qualified as Bytes +import PlutusLedgerApi.V1.Tx deriving newtype instance Serialise LedgerBytes deriving anyclass instance FromJSONKey LedgerBytes diff --git a/plutus-ledger/src/Ledger/Tx/Orphans/V2.hs b/plutus-ledger/src/Ledger/Tx/Orphans/V2.hs index b15be81b5e..3e31efa4bd 100644 --- a/plutus-ledger/src/Ledger/Tx/Orphans/V2.hs +++ b/plutus-ledger/src/Ledger/Tx/Orphans/V2.hs @@ -19,7 +19,7 @@ import Ledger.Address.Orphans () import Ledger.Builtins.Orphans () import Ledger.Value.Orphans () -import Plutus.V2.Ledger.Api +import PlutusLedgerApi.V2 deriving anyclass instance ToJSON OutputDatum deriving anyclass instance FromJSON OutputDatum diff --git a/plutus-ledger/src/Ledger/Typed/Scripts.hs b/plutus-ledger/src/Ledger/Typed/Scripts.hs index c59737f8ba..6dac502b3b 100644 --- a/plutus-ledger/src/Ledger/Typed/Scripts.hs +++ b/plutus-ledger/src/Ledger/Typed/Scripts.hs @@ -18,15 +18,16 @@ module Ledger.Typed.Scripts ) where import Ledger.Typed.Scripts.Orphans as Export () +import Plutus.Script.Utils.Scripts (MintingPolicy, Validator) import Plutus.Script.Utils.Scripts qualified as Untyped import Plutus.Script.Utils.Typed as Export import Plutus.Script.Utils.V1.Typed.Scripts qualified as PV1 import Plutus.Script.Utils.V2.Typed.Scripts qualified as PV2 -import Plutus.V1.Ledger.Api (MintingPolicy, Validator) mkForwardingMintingPolicy :: Versioned Validator -> Versioned MintingPolicy mkForwardingMintingPolicy vl@(Versioned _ PlutusV1) = Versioned (PV1.mkForwardingMintingPolicy (Untyped.validatorHash vl)) PlutusV1 mkForwardingMintingPolicy vl@(Versioned _ PlutusV2) = Versioned (PV2.mkForwardingMintingPolicy (Untyped.validatorHash vl)) PlutusV2 +mkForwardingMintingPolicy (Versioned _ PlutusV3) = error "mkForwardingMintingPolicy: Plutus V3 not supported in Babbage era" -- | Make a 'TypedValidator' (with no type constraints) from an untyped 'Validator' script. unsafeMkTypedValidator :: Versioned Validator -> TypedValidator Any diff --git a/plutus-ledger/src/Ledger/Value/CardanoAPI.hs b/plutus-ledger/src/Ledger/Value/CardanoAPI.hs index b120308e9e..f96d363543 100644 --- a/plutus-ledger/src/Ledger/Value/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Value/CardanoAPI.hs @@ -40,11 +40,9 @@ import Data.List (partition) import Data.Maybe (isJust) import Data.Monoid (All (All, getAll)) import Data.Ratio (denominator, numerator) -import Ledger.Scripts (Language (..), MintingPolicy (MintingPolicy), Versioned (..)) +import Ledger.Scripts (MintingPolicy (..), Versioned (..), withCardanoApiScript) import Ledger.Tx.CardanoAPI.Internal (adaToCardanoValue, fromCardanoAssetId, fromCardanoValue, toCardanoAssetId, toCardanoValue) -import Plutus.Script.Utils.V1.Scripts qualified as PV1 -import Plutus.Script.Utils.V2.Scripts qualified as PV2 import PlutusTx.Lattice (JoinSemiLattice (..)) lovelaceToValue :: C.Lovelace -> C.Value @@ -83,8 +81,7 @@ split :: C.Value -> (C.Value, C.Value) split = bimap (C.negateValue . C.valueFromList) C.valueFromList . partition ((< 0) . snd) . C.valueToList policyId :: Versioned MintingPolicy -> C.PolicyId -policyId (Versioned (MintingPolicy mp) PlutusV1) = C.scriptPolicyId (PV1.toCardanoApiScript mp) -policyId (Versioned (MintingPolicy mp) PlutusV2) = C.scriptPolicyId (PV2.toCardanoApiScript mp) +policyId = withCardanoApiScript C.scriptPolicyId . fmap getMintingPolicy combine :: Monoid m => (C.AssetId -> C.Quantity -> C.Quantity -> m) -> C.Value -> C.Value -> m combine f v1 v2 = merge (C.valueToList v1) (C.valueToList v2) diff --git a/plutus-ledger/src/Ledger/Value/Orphans.hs b/plutus-ledger/src/Ledger/Value/Orphans.hs index 8bf1ae5580..fd0ad88026 100644 --- a/plutus-ledger/src/Ledger/Value/Orphans.hs +++ b/plutus-ledger/src/Ledger/Value/Orphans.hs @@ -16,8 +16,8 @@ import Data.String (IsString (fromString)) import Data.Text qualified as Text import Data.Text.Encoding qualified as E import GHC.Generics (Generic) -import Plutus.V1.Ledger.Bytes qualified as Bytes -import Plutus.V1.Ledger.Value +import PlutusLedgerApi.V1.Bytes qualified as Bytes +import PlutusLedgerApi.V1.Value import PlutusTx.AssocMap qualified as Map import PlutusTx.Prelude qualified as PlutusTx import Prettyprinter (Pretty (pretty), (<+>)) @@ -63,7 +63,7 @@ instance ToJSON TokenName where (\bs -> Text.cons '\NUL' (asBase16 bs)) (\t -> case Text.take 1 t of "\NUL" -> Text.concat ["\NUL\NUL", t]; _ -> t) where - -- copied from 'Plutus.V1.Ledger.Value' because not exported + -- copied from 'PlutusLedgerApi.V1.Value' because not exported asBase16 :: BS.ByteString -> Text.Text asBase16 bs = Text.concat ["0x", Bytes.encodeByteString bs] @@ -125,7 +125,7 @@ instance Serialise C.PolicyId where encode = encode . C.serialiseToRawBytes decode = do bs <- decode - maybe (fail "Can get back policy ID") + either (fail . show) pure $ C.deserialiseFromRawBytes C.AsPolicyId bs @@ -133,6 +133,6 @@ instance Serialise C.AssetName where encode = encode . C.serialiseToRawBytes decode = do bs <- decode - maybe (fail "Can get back asset name") + either (fail . show) pure $ C.deserialiseFromRawBytes C.AsAssetName bs diff --git a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs index fa7ad0ef89..4c4bddd5b1 100644 --- a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs +++ b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs @@ -9,8 +9,6 @@ import Cardano.Api (AsType (AsPaymentKey, AsStakeKey), Key (verificationKeyHash) StakeAddressReference (NoStakeAddress, StakeAddressByValue), StakeCredential, makeShelleyAddress, shelleyAddressInEra) import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey)) -import Gen.Cardano.Api.Typed (genAssetName, genTxId, genValueDefault) -import Gen.Cardano.Api.Typed qualified as Gen import Hedgehog (Gen, Property, forAll, property, tripping, (===)) import Hedgehog qualified import Hedgehog.Gen qualified as Gen @@ -20,6 +18,8 @@ import Ledger.Tx.CardanoAPI (fromCardanoAssetName, fromCardanoTxId, fromCardanoV toCardanoAssetName, toCardanoTxId, toCardanoValue) import Ledger.Value.CardanoAPI (combine, valueFromList, valueGeq) import PlutusTx.Lattice ((\/)) +import Test.Gen.Cardano.Api.Typed (genAssetName, genTxId, genValueDefault) +import Test.Gen.Cardano.Api.Typed qualified as Gen import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) diff --git a/plutus-ledger/test/Spec.hs b/plutus-ledger/test/Spec.hs index 33fc95b63e..804eba42d5 100644 --- a/plutus-ledger/test/Spec.hs +++ b/plutus-ledger/test/Spec.hs @@ -5,28 +5,27 @@ module Main(main) where import Cardano.Api qualified as C -import Cardano.Crypto.Hash qualified as Crypto import Data.Aeson qualified as JSON import Data.Aeson.Extras qualified as JSON -import Data.Aeson.Internal qualified as Aeson +import Data.Aeson.Types qualified as Aeson import Data.ByteString.Lazy qualified as BSL import Data.List (sort) -import Gen.Cardano.Api.Typed qualified as Gen import Hedgehog (Property, forAll, fromGenT, property) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Ledger (Slot (Slot)) -import Ledger.Interval qualified as Interval import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), CardanoTx (CardanoTx)) import Ledger.Tx.CardanoAPI qualified as CardanoAPI import Ledger.Tx.CardanoAPISpec qualified import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value qualified as Value hiding (scale) +import PlutusLedgerApi.V1.Interval qualified as Interval +import Test.Gen.Cardano.Api.Typed qualified as Gen import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.Hedgehog (testPropertyNamed) import Test.Tasty.HUnit (testCase) import Test.Tasty.HUnit qualified as HUnit -import Test.Tasty.Hedgehog (testPropertyNamed) main :: IO () main = defaultMain tests @@ -119,17 +118,11 @@ byteStringJson jsonString value = -- | Check that Ord instances of cardano-api's 'TxIn' and plutus-ledger-api's 'TxIn' match. txInOrdInstanceEquivalenceTest :: Property txInOrdInstanceEquivalenceTest = property $ do - txIns <- sort <$> forAll (Gen.list (Range.singleton 10) genTxIn) + txIns <- sort <$> forAll (Gen.list (Range.singleton 10) Gen.genTxIn) let toPlutus = map CardanoAPI.fromCardanoTxIn let plutusTxIns = sort $ toPlutus txIns Hedgehog.assert $ toPlutus txIns == plutusTxIns -genTxIn :: Hedgehog.MonadGen m => m C.TxIn -genTxIn = do - txId <- (\t -> C.TxId $ Crypto.castHash $ Crypto.hashWith (const t) ()) <$> Gen.utf8 (Range.singleton 5) Gen.unicode - txIx <- C.TxIx <$> Gen.integral (Range.linear 0 maxBound) - return $ C.TxIn txId txIx - genCardanoBuildTx :: Hedgehog.Gen CardanoBuildTx genCardanoBuildTx = do tx <- Gen.genTxBodyContent C.BabbageEra diff --git a/plutus-pab-executables/plutus-pab-executables.cabal b/plutus-pab-executables/plutus-pab-executables.cabal index 1b2f63a0a5..7838e4d7ad 100644 --- a/plutus-pab-executables/plutus-pab-executables.cabal +++ b/plutus-pab-executables/plutus-pab-executables.cabal @@ -369,7 +369,7 @@ executable tx-inject -------------------------- -- Other IOG dependencies -------------------------- - build-depends: cardano-api >=1.35 + build-depends: cardano-api >=8.0 ------------------------ -- Non-IOG dependencies @@ -410,7 +410,7 @@ executable sync-client -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , cardano-slotting ------------------------ @@ -449,9 +449,8 @@ executable pab-cli -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api >=8.0 , cardano-ledger-shelley - , ouroboros-consensus-shelley ------------------------ -- Non-IOG dependencies diff --git a/plutus-pab/plutus-pab.cabal b/plutus-pab/plutus-pab.cabal index 507c570b46..21956a8cf6 100644 --- a/plutus-pab/plutus-pab.cabal +++ b/plutus-pab/plutus-pab.cabal @@ -74,6 +74,8 @@ library Control.Concurrent.Availability Control.Concurrent.STM.Extras Control.Concurrent.STM.Extras.Stream + Marconi.Core.Index.VSplit + Marconi.Core.Index.VSqlite Plutus.PAB.App Plutus.PAB.Arbitrary Plutus.PAB.Core @@ -122,7 +124,6 @@ library , cardano-node-emulator >=1.2.0 , cardano-node-socket-emulator >=1.2.0 , freer-extras >=1.2.0 - , marconi-core >=1.2.0 , pab-blockfrost >=1.2.0 , plutus-chain-index >=1.2.0 , plutus-chain-index-core >=1.2.0 @@ -136,31 +137,31 @@ library -------------------------- build-depends: , cardano-addresses - , cardano-api >=1.35 + , cardano-api >=8.0 , cardano-crypto , cardano-crypto-class , cardano-ledger-alonzo , cardano-ledger-core , cardano-slotting , cardano-wallet - , cardano-wallet-cli - , cardano-wallet-core - , cardano-wallet-core-integration , cardano-wallet-launcher , iohk-monitoring , lobemo-backend-ekg , ouroboros-network , ouroboros-network-framework - , plutus-ledger-api >=1.0.0 - , plutus-tx >=1.0.0 - , plutus-tx-plugin >=1.0.0 + , plutus-ledger-api >=1.0.0 + , plutus-tx >=1.0.0 + , plutus-tx-plugin >=1.0.0 , Win32-network + -- , cardano-wallet-cli + -- , cardano-wallet-core + -- , cardano-wallet-core-integration ------------------------ -- Non-IOG dependencies ------------------------ build-depends: - , aeson <2.0.3.0 + , aeson , aeson-pretty , async , base >=4.7 && <5 @@ -247,7 +248,7 @@ test-suite plutus-pab-test-light -- Other IOG dependencies -------------------------- build-depends: - , cardano-api:{cardano-api, gen} >=1.35 + , cardano-api:{cardano-api, gen} >=8.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 diff --git a/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs b/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs index bf7b12644a..4e8b437603 100644 --- a/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs +++ b/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs @@ -42,8 +42,8 @@ import Ledger qualified as P import Ledger.Tx (CardanoTx, TxOutRef) import Ledger.Tx.CardanoAPI (fromPlutusIndex) import Ledger.Tx.Constraints (UnbalancedTx (UnbalancedCardanoTx)) -import Plutus.V1.Ledger.Api qualified as Plutus -import Plutus.V1.Ledger.Scripts (MintingPolicyHash) +import PlutusLedgerApi.V1 qualified as Plutus +import PlutusLedgerApi.V1.Scripts (MintingPolicyHash) import PlutusTx qualified import Wallet.API qualified as WAPI import Wallet.Effects (WalletEffect, balanceTx, yieldUnbalancedTx) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/API.hs b/plutus-pab/src/Cardano/Wallet/Mock/API.hs index 953557752b..d523f0a195 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/API.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/API.hs @@ -10,7 +10,7 @@ import Data.List.NonEmpty (NonEmpty) import Ledger (CardanoAddress, PaymentPubKeyHash) import Ledger.Tx (CardanoTx) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) -import Plutus.V1.Ledger.Api (Value) +import PlutusLedgerApi.V1 (Value) import Servant.API (Capture, Get, JSON, NoContent, Post, QueryParam, ReqBody, (:<|>), (:>)) import Wallet.Emulator.Error (WalletAPIError) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs index b10304be5b..7d3b0aebab 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs @@ -21,7 +21,7 @@ import Data.Proxy (Proxy (Proxy)) import Ledger (CardanoAddress, PaymentPubKeyHash) import Ledger.Tx (CardanoTx) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) -import Plutus.V1.Ledger.Api (Value) +import PlutusLedgerApi.V1 (Value) import Servant ((:<|>) ((:<|>))) import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM) import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) diff --git a/plutus-pab/src/Marconi/Core/Index/VSplit.hs b/plutus-pab/src/Marconi/Core/Index/VSplit.hs new file mode 100644 index 0000000000..8aaf758044 --- /dev/null +++ b/plutus-pab/src/Marconi/Core/Index/VSplit.hs @@ -0,0 +1,245 @@ +module Marconi.Core.Index.VSplit + ( SplitIndex(..) + , new + , newBoxed + , newUnboxed + , insert + , insertL + , size + , rewind + -- * Accessors + , handle + , storage + , notifications + , store + , query + , onInsert + -- * Storage + , Storage(..) + , getBuffer + , getEvents + , k + ) where + +import Control.Lens ((%~), (&), (.~), (^.)) +import Control.Lens.TH qualified as Lens +import Control.Monad.Primitive (PrimMonad, PrimState) +import Data.Foldable (foldlM) +import Data.Vector qualified as V +import Data.Vector.Generic qualified as VG +import Data.Vector.Generic.Mutable qualified as VGM +import Data.Vector.Unboxed qualified as VU + +data Storage v m e = Storage + { _events :: (VG.Mutable v) (PrimState m) e + , _cursor :: Int + , _eSize :: Int + , _bSize :: Int + , _k :: Int + } +$(Lens.makeLenses ''Storage) + +maxSize + :: VGM.MVector (VG.Mutable v) e + => Storage v m e + -> Int +maxSize store = store ^. events & VGM.length + +isStorageFull + :: VGM.MVector (VG.Mutable v) e + => Storage v m e + -> Bool +isStorageFull store = maxSize store == store ^. eSize + store ^. bSize + +getBuffer + :: forall v m e. + VGM.MVector (VG.Mutable v) e + => PrimMonad m + => Show e + => Storage v m e + -> m [e] +getBuffer store = + let bufferEnd = store ^. cursor - store ^. eSize + bufferStart = bufferEnd - store ^. bSize + in reverse <$> getInterval bufferStart (store ^. bSize) store + +getEvents + :: forall v m e. + VGM.MVector (VG.Mutable v) e + => PrimMonad m + => Show e + => Storage v m e + -> m [e] +getEvents store = + let c = store ^. cursor + esz = store ^. eSize + in reverse <$> getInterval (c - esz) esz store + +getInterval + :: forall v m e. + VGM.MVector (VG.Mutable v) e + => PrimMonad m + => Show e + => Int + -> Int + -> Storage v m e + -> m [e] +getInterval start size' store + | size' == 0 = pure [] + -- k underflows to the begining + | start < 0 = do + getInterval (maxSize store + start) size' store + -- buffer overflows to the start + | start + size' > maxSize store = + let endSize = (start + size') `rem` maxSize store + startSize = size' - endSize + in (++) <$> getInterval start startSize store + <*> getInterval 0 endSize store + -- normal case + | otherwise = do + VGM.foldr' (:) [] $ VGM.slice start size' (store ^. events) + +data SplitIndex m h v e n q r = SplitIndex + { _handle :: h + , _storage :: Storage v m e + , _notifications :: [n] + , _store :: SplitIndex m h v e n q r -> m () + , _query :: SplitIndex m h v e n q r -> q -> [e] -> m r + , _onInsert :: SplitIndex m h v e n q r -> e -> m [n] + } +$(Lens.makeLenses ''SplitIndex) + +new + :: Monad m + => VGM.MVector (VG.Mutable v) e + => (SplitIndex m h v e n q r -> q -> [e] -> m r) + -> (SplitIndex m h v e n q r -> m ()) + -> (SplitIndex m h v e n q r -> e -> m [n]) + -> Int + -> h + -> (VG.Mutable v) (PrimState m) e + -> m (Maybe (SplitIndex m h v e n q r)) +new query' store' onInsert' k' handle' vector + | k' < 0 = pure Nothing + -- The vector has to accomodate at least k + 1 elements. + | k' >= VGM.length vector = pure Nothing + | otherwise = pure . Just $ SplitIndex + { _handle = handle' + , _storage = Storage { _events = vector + , _cursor = 0 + , _eSize = 0 + , _bSize = 0 + , _k = k' + } + , _notifications = [] + , _store = store' + , _query = query' + , _onInsert = onInsert' + } + +type BoxedIndex m h e n q r = + SplitIndex m h V.Vector e n q r + +newBoxed + :: Monad m + => PrimMonad m + => (BoxedIndex m h e n q r -> q -> [e] -> m r) + -> (BoxedIndex m h e n q r -> m ()) + -> (BoxedIndex m h e n q r -> e -> m [n]) + -> Int + -> Int + -> h + -> m (Maybe (BoxedIndex m h e n q r)) +newBoxed query' store' onInsert' k' size' handle' + | k' < 0 || size' <= 0 = pure Nothing + | otherwise = do + v <- VGM.new (k' + size') + new query' store' onInsert' k' handle' v + +type UnboxedIndex m h e n q r = + SplitIndex m h VU.Vector e n q r + +newUnboxed + :: Monad m + => PrimMonad m + => VGM.MVector VU.MVector e + => (UnboxedIndex m h e n q r -> q -> [e] -> m r) + -> (UnboxedIndex m h e n q r -> m ()) + -> (UnboxedIndex m h e n q r -> e -> m [n]) + -> Int + -> Int + -> h + -> m (Maybe (UnboxedIndex m h e n q r)) +newUnboxed query' store' onInsert' k' size' handle' + | k' < 0 || size' <= 0 = pure Nothing + | otherwise = do + v <- VGM.new (k' + size') + new query' store' onInsert' k' handle' v + +insert + :: forall m h v e n q r. + Monad m + => PrimMonad m + => VGM.MVector (VG.Mutable v) e + => e + -> SplitIndex m h v e n q r + -> m (SplitIndex m h v e n q r) +insert e ix = do + let es = ix ^. storage . events + c = ix ^. storage . cursor + vs = VGM.length es + VGM.unsafeWrite es c e + ns <- (ix ^. onInsert) ix e + let ix' = storage %~ updateSizes $ + (storage . cursor) %~ (\c' -> (c' + 1) `rem` vs) $ + notifications %~ (ns++) $ ix + if isStorageFull (ix' ^. storage) + then storeEvents ix' + else pure ix' + + where + updateSizes :: Storage v m e -> Storage v m e + updateSizes st = + -- Event sizes increase by one upto K + eSize %~ (\sz -> min (sz + 1) (st ^. k)) $ + -- The buffer only grows when the event buffer is full + bSize %~ (\sz -> if st ^. eSize == st ^. k then sz + 1 else sz) $ st + +storeEvents + :: Monad m + => SplitIndex m h v e n q r + -> m (SplitIndex m h v e n q r) +storeEvents ix = do + -- TODO: Change store to store :: h -> [e] -> m () (?) + ix & ix ^. store + pure $ + (storage . bSize) .~ 0 $ ix + +insertL + :: PrimMonad m + => VGM.MVector (VG.Mutable v) e + => [e] + -> SplitIndex m h v e n q r + -> m (SplitIndex m h v e n q r) +insertL es ix = foldlM (flip insert) ix es + +size + :: SplitIndex m h v e n q r + -> Int +size ix = 1 + (ix ^. storage . eSize) + +rewind + :: VGM.MVector (VG.Mutable v) e + => Int + -> SplitIndex m h v e n q r + -> Maybe (SplitIndex m h v e n q r) +rewind n ix + | ix ^. storage . eSize >= n = Just $ + (storage . cursor) %~ (\c -> adjust (c - n)) $ + (storage . eSize ) %~ (\sz -> sz - n) $ ix + | otherwise = Nothing + where + adjust :: Int -> Int + adjust p + | p < 0 = maxSize (ix ^. storage) + p + | otherwise = p diff --git a/plutus-pab/src/Marconi/Core/Index/VSqlite.hs b/plutus-pab/src/Marconi/Core/Index/VSqlite.hs new file mode 100644 index 0000000000..d675ba9f8d --- /dev/null +++ b/plutus-pab/src/Marconi/Core/Index/VSqlite.hs @@ -0,0 +1,69 @@ +module Marconi.Core.Index.VSqlite + ( -- * API + SqliteIndex + , new + , newBoxed + , S.insert + , S.insertL + , S.size + , S.rewind + , S.getEvents + , S.getBuffer + , S.handle + , S.storage + ) where + +import Control.Monad.Primitive (PrimState) +import Data.Vector qualified as V +import Data.Vector.Generic qualified as VG +import Data.Vector.Generic.Mutable qualified as VGM +import Database.SQLite.Simple (Connection, execute_, open) + +import Marconi.Core.Index.VSplit (SplitIndex (SplitIndex), Storage (Storage)) +import Marconi.Core.Index.VSplit qualified as S + +type SqliteIndex e n q r = SplitIndex IO Connection V.Vector e n q r + +new + :: (SqliteIndex e n q r -> q -> [e] -> IO r) + -> (SqliteIndex e n q r -> IO ()) + -> (SqliteIndex e n q r -> e -> IO [n]) + -> Int + -> FilePath + -> (VG.Mutable V.Vector) (PrimState IO) e + -> IO (Maybe (SqliteIndex e n q r)) +new fquery fstore foninsert k' db vector + | k' < 0 = pure Nothing + | otherwise = do + connection <- open db + execute_ connection "PRAGMA journal_mode=WAL" + + pure . Just $ SplitIndex + { S._handle = connection + , S._storage = Storage { S._events = vector + , S._cursor = 0 + , S._eSize = 0 + , S._bSize = 0 + , S._k = k' + } + , S._notifications = [] + , S._store = fstore + , S._query = fquery + , S._onInsert = foninsert + } + +type BoxedIndex e n q r = SqliteIndex e n q r + +newBoxed + :: (BoxedIndex e n q r -> q -> [e] -> IO r) + -> (BoxedIndex e n q r -> IO ()) + -> (BoxedIndex e n q r -> e -> IO [n]) + -> Int + -> Int + -> FilePath + -> IO (Maybe (BoxedIndex e n q r)) +newBoxed query' store' onInsert' k' size' dbPath + | k' < 0 || size' <= 0 = pure Nothing + | otherwise = do + v <- VGM.new (k' + size') + new query' store' onInsert' k' dbPath v diff --git a/plutus-pab/src/Plutus/PAB/Arbitrary.hs b/plutus-pab/src/Plutus/PAB/Arbitrary.hs index 5df26d5852..55e63f7863 100644 --- a/plutus-pab/src/Plutus/PAB/Arbitrary.hs +++ b/plutus-pab/src/Plutus/PAB/Arbitrary.hs @@ -24,7 +24,6 @@ import Ledger (TxOut (TxOut)) import Ledger qualified import Ledger.Address (PaymentPubKey, PaymentPubKeyHash, StakePubKey, StakePubKeyHash) import Ledger.Crypto (PubKey, Signature) -import Ledger.Interval (Extended, Interval, LowerBound, UpperBound) import Ledger.Scripts (Language (..), Versioned (..)) import Ledger.Slot (Slot) import Ledger.Tx (Certificate, RedeemerPtr, ScriptTag, TxOutRef, Withdrawal) @@ -37,9 +36,10 @@ import Plutus.Script.Utils.Ada qualified as Plutus import Plutus.Script.Utils.V1.Address (mkValidatorAddress) import Plutus.Script.Utils.V1.Typed.Scripts (ConnectionError, WrongOutTypeError) import Plutus.Script.Utils.Value qualified as Plutus -import Plutus.V1.Ledger.Api (Address (..), LedgerBytes, PubKeyHash, ValidatorHash (ValidatorHash)) -import Plutus.V1.Ledger.Bytes qualified as LedgerBytes -import Plutus.V2.Ledger.Api qualified as PV2 +import PlutusLedgerApi.V1 (Address (..), LedgerBytes, PubKeyHash, ValidatorHash (ValidatorHash)) +import PlutusLedgerApi.V1.Bytes qualified as LedgerBytes +import PlutusLedgerApi.V1.Interval (Extended, Interval, LowerBound, UpperBound) +import PlutusLedgerApi.V2 qualified as PV2 import PlutusTx qualified import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Prelude qualified as PlutusTx diff --git a/plutus-pab/src/Plutus/PAB/Core.hs b/plutus-pab/src/Plutus/PAB/Core.hs index 621c2781b9..f0b891a75a 100644 --- a/plutus-pab/src/Plutus/PAB/Core.hs +++ b/plutus-pab/src/Plutus/PAB/Core.hs @@ -134,7 +134,7 @@ import Plutus.PAB.Timeout qualified as Timeout import Plutus.PAB.Types (PABError (ContractInstanceNotFound, InstanceAlreadyStopped, OtherError, WalletError)) import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet)) import Plutus.Script.Utils.Value (Value) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) import Wallet.API (Slot) import Wallet.API qualified as WAPI import Wallet.Effects (NodeClientEffect, WalletEffect) diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs index ddb1b4ca1e..def6f5b7fb 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs @@ -80,7 +80,7 @@ import Plutus.PAB.Effects.UUID (UUIDEffect, uuidNextRandom) import Plutus.PAB.Events.Contract (ContractInstanceId (ContractInstanceId)) import Plutus.PAB.Types (PABError) import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet)) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Emulator.LogMessages (TxBalanceMsg) import Wallet.Emulator.Wallet qualified as Wallet diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance/BlockchainEnv.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance/BlockchainEnv.hs index e1e22429cc..dcccfea25c 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance/BlockchainEnv.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance/BlockchainEnv.hs @@ -56,7 +56,7 @@ import Plutus.PAB.Types (Config (Config, dbConfig), DbConfig (..), WebserverConfig (WebserverConfig, enableMarconi), developmentOptions, nodeServerConfig, pabWebserverConfig) import Plutus.Trace.Emulator.ContractInstance (IndexedBlock (..), indexBlock) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) import System.Random -- | Connect to the node and write node updates to the blockchain diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance/STM.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance/STM.hs index 9c0d9ce9c0..d0b23f951c 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance/STM.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance/STM.hs @@ -67,7 +67,6 @@ import Data.Map (Map) import Data.Map qualified as Map import Data.Set (Set) import Ledger (CardanoAddress, Slot, TxOutRef) -import Ledger.Time (POSIXTime) import Plutus.ChainIndex (BlockNumber (BlockNumber), ChainIndexTx, TxIdState, TxOutBalance, TxOutStatus, TxStatus, transactionStatus) import Plutus.ChainIndex.TxOutBalance (transactionOutputStatus) @@ -75,7 +74,8 @@ import Plutus.ChainIndex.UtxoState (UtxoIndex, UtxoState (_usTxUtxoData), utxoSt import Plutus.Contract.Effects (ActiveEndpoint (ActiveEndpoint, aeDescription)) import Plutus.Contract.Resumable (IterationID, Request (Request, itID, rqID, rqRequest), RequestID) import Plutus.PAB.Core.Indexer.TxConfirmationStatus (TCSIndex) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) +import PlutusLedgerApi.V1.Time (POSIXTime) import Wallet.Types (ContractInstanceId, EndpointDescription, EndpointValue (EndpointValue), NotificationError (EndpointNotAvailable, InstanceDoesNotExist, MoreThanOneEndpointAvailable)) import Wallet.Types qualified as Wallet (ContractActivityStatus (Active, Done, Stopped)) diff --git a/plutus-pab/src/Plutus/PAB/Core/Indexer/TxConfirmationStatus.hs b/plutus-pab/src/Plutus/PAB/Core/Indexer/TxConfirmationStatus.hs index 5a1970a2b0..7fc32fed30 100644 --- a/plutus-pab/src/Plutus/PAB/Core/Indexer/TxConfirmationStatus.hs +++ b/plutus-pab/src/Plutus/PAB/Core/Indexer/TxConfirmationStatus.hs @@ -32,7 +32,7 @@ import GHC.Generics (Generic) import Plutus.ChainIndex.Types (BlockNumber (BlockNumber), TxConfirmedState (TxConfirmedState, blockAdded, timesConfirmed, validity), TxValidity (TxValid)) -import Plutus.V1.Ledger.Api (TxId) +import PlutusLedgerApi.V1 (TxId) import Marconi.Core.Index.VSqlite (SqliteIndex) import Marconi.Core.Index.VSqlite qualified as Ix diff --git a/plutus-pab/src/Plutus/PAB/LocalCluster/Run.hs b/plutus-pab/src/Plutus/PAB/LocalCluster/Run.hs index 0ac829c4b3..bbc007e15a 100644 --- a/plutus-pab/src/Plutus/PAB/LocalCluster/Run.hs +++ b/plutus-pab/src/Plutus/PAB/LocalCluster/Run.hs @@ -17,9 +17,9 @@ import Cardano.BM.Data.Severity (Severity (Notice)) import Cardano.BM.Data.Tracer (HasPrivacyAnnotation, HasSeverityAnnotation) import Cardano.BM.Plugin (loadPlugin) import Cardano.BM.Tracing (HasSeverityAnnotation (getSeverityAnnotation), Severity (Debug, Info)) +import Cardano.ChainIndex.Types qualified as PAB.CI import Cardano.CLI (LogOutput (LogToFile, LogToStdStreams), Port, ekgEnabled, getEKGURL, getPrometheusURL, withLoggingNamed) -import Cardano.ChainIndex.Types qualified as PAB.CI import Cardano.Launcher.Node (nodeSocketFile) import Cardano.Mnemonic (SomeMnemonic (SomeMnemonic)) import Cardano.Node.Emulator.Internal.Node (SlotConfig (SlotConfig)) diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index 33607c36c7..b68984a833 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -128,7 +128,7 @@ import Plutus.PAB.Webserver.Types (ContractActivationArgs) import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Value (Value, flattenValue) import Plutus.Trace.Emulator.System (appendNewTipBlock) -import Plutus.V1.Ledger.Tx (TxId, TxOutRef) +import PlutusLedgerApi.V1.Tx (TxId, TxOutRef) import Prettyprinter (Pretty (pretty), defaultLayoutOptions, layoutPretty) import Prettyprinter.Render.Text qualified as Render import Wallet.API qualified as WAPI diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Types.hs b/plutus-pab/src/Plutus/PAB/Webserver/Types.hs index d2985691d9..e1ed528497 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Types.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Types.hs @@ -39,7 +39,7 @@ import Ledger.Tx.CardanoAPI (CardanoBuildTx) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) import Plutus.Contract.Effects (ActiveEndpoint, ChainIndexQuery, PABReq) import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse) -import Plutus.V1.Ledger.Api (DCert, LedgerBytes (LedgerBytes)) +import PlutusLedgerApi.V1 (DCert, LedgerBytes (LedgerBytes)) import Prettyprinter (Pretty, pretty, (<+>)) import Wallet.Emulator.Wallet (Wallet, WalletId (WalletId)) import Wallet.Rollup.Types (AnnotatedTx, BeneficialOwner, DereferencedInput, SequenceId) diff --git a/plutus-pab/test/light/Cardano/Wallet/LocalClient/ExportTxSpec.hs b/plutus-pab/test/light/Cardano/Wallet/LocalClient/ExportTxSpec.hs index d771ee8a78..4c2e69e171 100644 --- a/plutus-pab/test/light/Cardano/Wallet/LocalClient/ExportTxSpec.hs +++ b/plutus-pab/test/light/Cardano/Wallet/LocalClient/ExportTxSpec.hs @@ -22,7 +22,7 @@ import Hedgehog.Range qualified as Range import Ledger (TxOutRef (TxOutRef)) import Ledger.Scripts qualified as Script import Ledger.Tx.CardanoAPI (fromCardanoPolicyId, fromCardanoTxId) -import Plutus.V1.Ledger.Scripts (MintingPolicyHash) +import PlutusLedgerApi.V1.Scripts (MintingPolicyHash) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) diff --git a/plutus-script-utils/plutus-script-utils.cabal b/plutus-script-utils/plutus-script-utils.cabal index a5746e7952..7f95525231 100644 --- a/plutus-script-utils/plutus-script-utils.cabal +++ b/plutus-script-utils/plutus-script-utils.cabal @@ -79,12 +79,13 @@ library Plutus.Script.Utils.V2.Typed.Scripts.StakeValidators Plutus.Script.Utils.V2.Typed.Scripts.Validators Plutus.Script.Utils.Value + Prettyprinter.Extras -------------------------- -- Other IOG dependencies -------------------------- build-depends: - , cardano-api >=1.35 + , cardano-api ^>=8.2 , cardano-ledger-alonzo , plutus-core >=1.0.0 , plutus-ledger-api >=1.0.0 diff --git a/plutus-script-utils/src/Plutus/Script/Utils/Ada.hs b/plutus-script-utils/src/Plutus/Script/Utils/Ada.hs index 7066767f5d..622eb7a803 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/Ada.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/Ada.hs @@ -34,8 +34,8 @@ import Codec.Serialise.Class (Serialise) import Data.Aeson (FromJSON, ToJSON) import Data.Tagged (Tagged (Tagged)) import GHC.Generics (Generic) -import Plutus.V1.Ledger.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName), Value) -import Plutus.V1.Ledger.Value qualified as TH +import PlutusLedgerApi.V1.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName), Value) +import PlutusLedgerApi.V1.Value qualified as TH import PlutusTx qualified import PlutusTx.Lift (makeLift) import PlutusTx.Prelude (AdditiveGroup, AdditiveMonoid, AdditiveSemigroup ((+)), Bool, Eq ((==)), Integer, Monoid, diff --git a/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs b/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs index 32d7471b74..a99fc9135f 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} - +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE RankNTypes #-} {-| This module contains functions related to versioning scripts and BuiltinData, or more specifially, @@ -13,13 +14,28 @@ module Plutus.Script.Utils.Scripts ( -- * Plutus language versioning Language (..) , Versioned (..) + , Script (..) + , Validator (..) + , mkValidatorScript + , unValidatorScript + , MintingPolicy (..) + , mkMintingPolicyScript + , unMintingPolicyScript + , StakeValidator (..) + , mkStakeValidatorScript + , unStakeValidatorScript -- * Script hashing + , PV1.ScriptHash (..) + , ValidatorHash (..) + , MintingPolicyHash (..) + , StakeValidatorHash (..) , scriptHash , validatorHash , mintingPolicyHash , stakeValidatorHash -- * Script utilities , scriptCurrencySymbol + , withCardanoApiScript -- * Script data hashes , PV1.Datum , PV1.DatumHash @@ -28,26 +44,35 @@ module Plutus.Script.Utils.Scripts , datumHash , redeemerHash , dataHash + -- * Address utilities + , toScriptAddress + , fromCardanoHash + , mkValidatorCardanoAddress ) where import Cardano.Api qualified as C.Api import Cardano.Api.Shelley qualified as C.Api -import Cardano.Ledger.Alonzo.Language (Language (PlutusV1, PlutusV2)) -import Codec.Serialise (Serialise, serialise) +import Cardano.Ledger.Alonzo.Language (Language (PlutusV1, PlutusV2, PlutusV3)) +import Codec.Serialise (Serialise) import Data.Aeson (FromJSON, ToJSON) -import Data.ByteString.Lazy qualified as BSL -import Data.ByteString.Short qualified as SBS +import Data.String (IsString) import GHC.Generics (Generic) -import Plutus.V1.Ledger.Api qualified as PV1 -import Plutus.V1.Ledger.Scripts qualified as PV1 +import PlutusLedgerApi.Common (serialiseCompiledCode) +import PlutusLedgerApi.V1 qualified as PV1 +import PlutusLedgerApi.V1.Bytes (LedgerBytes (LedgerBytes)) +import PlutusTx (CompiledCode, makeLift) +import PlutusTx qualified +import PlutusTx.Builtins (BuiltinData) import PlutusTx.Builtins qualified as Builtins import Prettyprinter (Pretty (pretty)) +import Prettyprinter.Extras (PrettyShow (PrettyShow)) deriving instance Serialise Language instance Pretty Language where pretty PlutusV1 = "Plutus V1" pretty PlutusV2 = "Plutus V2" + pretty PlutusV3 = "Plutus V3" -- | A script of some kind with its Plutus language version data Versioned script = Versioned { unversioned :: script, version :: Language } @@ -58,49 +83,54 @@ instance Pretty script => Pretty (Versioned script) where pretty Versioned{unversioned,version} = pretty unversioned <> " (" <> pretty version <> ")" -- | Hash a 'Versioned' 'Script' -scriptHash :: Versioned PV1.Script -> PV1.ScriptHash -scriptHash (Versioned script lang) = +scriptHash :: Versioned Script -> PV1.ScriptHash +scriptHash = fromCardanoHash . cardanoScriptHash + +-- | Transform a Cardano Script hash in a Plutus Script hash +fromCardanoHash :: C.Api.ScriptHash -> PV1.ScriptHash +fromCardanoHash = PV1.ScriptHash . Builtins.toBuiltin . C.Api.serialiseToRawBytes - . hashInner lang - . SBS.toShort - . BSL.toStrict - . serialise - $ script - where - hashInner PlutusV1 = C.Api.hashScript . C.Api.PlutusScript C.Api.PlutusScriptV1 . C.Api.PlutusScriptSerialised - hashInner PlutusV2 = C.Api.hashScript . C.Api.PlutusScript C.Api.PlutusScriptV2 . C.Api.PlutusScriptSerialised - --- | Hash a 'Versioned' 'PV1.Validator' script. -validatorHash :: Versioned PV1.Validator -> PV1.ValidatorHash + +withCardanoApiScript :: (forall lang. C.Api.Script lang -> r) -> Versioned Script -> r +withCardanoApiScript f (Versioned (Script script) lang) = case lang of + PlutusV1 -> f . C.Api.PlutusScript C.Api.PlutusScriptV1 $ C.Api.PlutusScriptSerialised script + PlutusV2 -> f . C.Api.PlutusScript C.Api.PlutusScriptV2 $ C.Api.PlutusScriptSerialised script + PlutusV3 -> f . C.Api.PlutusScript C.Api.PlutusScriptV3 $ C.Api.PlutusScriptSerialised script + +cardanoScriptHash :: Versioned Script -> C.Api.ScriptHash +cardanoScriptHash = withCardanoApiScript C.Api.hashScript + +-- | Hash a 'Versioned' 'Validator' script. +validatorHash :: Versioned Validator -> ValidatorHash validatorHash = - PV1.ValidatorHash + ValidatorHash . PV1.getScriptHash . scriptHash - . fmap PV1.getValidator + . fmap getValidator --- | Hash a 'Versioned' 'PV1.MintingPolicy' script. -mintingPolicyHash :: Versioned PV1.MintingPolicy -> PV1.MintingPolicyHash +-- | Hash a 'Versioned' 'MintingPolicy' script. +mintingPolicyHash :: Versioned MintingPolicy -> MintingPolicyHash mintingPolicyHash = - PV1.MintingPolicyHash + MintingPolicyHash . PV1.getScriptHash . scriptHash - . fmap PV1.getMintingPolicy + . fmap getMintingPolicy --- | Hash a 'Versioned' 'PV1.StakeValidator' script. -stakeValidatorHash :: Versioned PV1.StakeValidator -> PV1.StakeValidatorHash +-- | Hash a 'Versioned' 'StakeValidator' script. +stakeValidatorHash :: Versioned StakeValidator -> StakeValidatorHash stakeValidatorHash = - PV1.StakeValidatorHash + StakeValidatorHash . PV1.getScriptHash . scriptHash - . fmap PV1.getStakeValidator + . fmap getStakeValidator {-# INLINABLE scriptCurrencySymbol #-} -- | The 'CurrencySymbol' of a 'MintingPolicy'. -scriptCurrencySymbol :: Versioned PV1.MintingPolicy -> PV1.CurrencySymbol +scriptCurrencySymbol :: Versioned MintingPolicy -> PV1.CurrencySymbol scriptCurrencySymbol scrpt = - let (PV1.MintingPolicyHash hsh) = mintingPolicyHash scrpt in PV1.CurrencySymbol hsh + let (MintingPolicyHash hsh) = mintingPolicyHash scrpt in PV1.CurrencySymbol hsh -- | Hash a 'PV1.Datum builtin data. datumHash :: PV1.Datum -> PV1.DatumHash @@ -115,7 +145,7 @@ dataHash :: Builtins.BuiltinData -> Builtins.BuiltinByteString dataHash = Builtins.toBuiltin . C.Api.serialiseToRawBytes - . C.Api.hashScriptData + . C.Api.hashScriptDataBytes . toCardanoAPIData -- | Convert a 'Builtins.BuiltinsData' value to a 'cardano-api' script @@ -123,8 +153,8 @@ dataHash = -- -- For why we depend on `cardano-api`, -- see note [Hash computation of datums, redeemers and scripts] -toCardanoAPIData :: Builtins.BuiltinData -> C.Api.ScriptData -toCardanoAPIData = C.Api.fromPlutusData . Builtins.builtinDataToData +toCardanoAPIData :: Builtins.BuiltinData -> C.Api.HashableScriptData +toCardanoAPIData = C.Api.unsafeHashableScriptData . C.Api.fromPlutusData . Builtins.builtinDataToData {- Note [Hash computation of datums, redeemers and scripts] @@ -151,3 +181,91 @@ also probably depend on `cardano-api`, so the dependency on `cardano-api` should If this becomes an issue, we'll change the implementation. -} +-- | 'Validator' is a wrapper around 'Script's which are used as validators in transaction outputs. +newtype Validator = Validator { getValidator :: Script } + deriving stock (Generic) + deriving newtype (Eq, Ord, Serialise) + deriving Pretty via (PrettyShow Validator) + +instance Show Validator where + show = const "Validator {