diff --git a/cabal.project b/cabal.project index 1799982..80ee92f 100644 --- a/cabal.project +++ b/cabal.project @@ -1,11 +1,196 @@ +repository cardano-haskell-packages + url: https://input-output-hk.github.io/cardano-haskell-packages + secure: True + root-keys: + 3e0cce471cf09815f930210f7827266fd09045445d65923e6d0238a6cd15126f + 443abb7fb497a134c343faf52f0b659bd7999bc06b7f63fa76dc99d631f9bea1 + a86a1f6ce86c449c46666bda44268677abf29b5b2d2eb5ec7af903ec2f117a82 + bcec67e8e99cabfa7764d75ad9b158d72bfacf70ca1d0ec8bc6b4406d1bf8413 + c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56 + d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee + +-- repeating the index-state for hackage to work around hackage.nix parsing limitation +index-state: 2023-06-06T00:00:00Z + +index-state: + , hackage.haskell.org 2023-06-06T00:00:00Z + , cardano-haskell-packages 2023-06-05T06:39:32Z + packages: ./psm ./cardano-simple +-- TODO: Default value should be @direct@ in upcoming 3.10 version of cabal, omit this line then. +test-show-details: direct + +-- Using 0.7.1.0, which is already on hackage; but bumping the index state will break everything. +source-repository-package + type: git + location: https://github.com/blockfrost/blockfrost-haskell + tag: v0.7.1.0 + --sha256: sha256-hCT0yp3dnNTm7PRDXqrW9zYyUtALMqQNMxS7IZsNoe4= + subdir: + blockfrost-api + blockfrost-client + blockfrost-client-core + +allow-newer: + , cardano-wallet:blockfrost-api + , cardano-wallet:blockfrost-client + , cardano-wallet:blockfrost-client-core + +-- TODO: This is fixed for in their later version, omit this when we update to it. +package strict-containers + ghc-options: -Wwarn=noncanonical-monad-instances + +source-repository-package + type: git + location: https://github.com/maestro-org/haskell-sdk + tag: deb1e133cd7de989e9e85c2b44e9361f52e93776 + --sha256: sha256-k4OoAAUFdYkKDSTDeM2dwC/DrJrPotiz0EIeU0xccXY= + +-- Unfortunately, cardano-node 8.1.2 is constrained with plutus-ledger-api 1.5.0.0 and we would like at least 1.6.0.0. +-- This is done in accordance with changes in https://github.com/input-output-hk/cardano-ledger/pull/3430/files. +constraints: + plutus-ledger-api == 1.6.0.0 + , plutus-core == 1.6.0.0 + +allow-newer: + , cardano-ledger-alonzo:plutus-ledger-api + , cardano-ledger-alonzo:plutus-core + , cardano-ledger-alonzo-test:plutus-ledger-api + , cardano-ledger-alonzo-test:plutus-ledger-api-testlib + , cardano-ledger-babbage:plutus-ledger-api + , cardano-ledger-conway:plutus-ledger-api + , cardano-ledger-binary:plutus-ledger-api + , cardano-api:plutus-ledger-api + , cardano-api:plutus-ledger-api-testlib + , cardano-api:prettyprinter-configurable + + +-- Everything below is essentially copied from cardano-wallet's cabal.project. +-------- Begin contents from @cardano-wallet@'s @cabal.project@ file. -------- + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-wallet + tag: v2023-07-18 + --sha256: sha256-ijflgIw+1FpLoxM4Rksf4MJvNqnEPAv3gNWE8zMuefU= + subdir: + lib/balance-tx/ + lib/coin-selection/ + lib/delta-store/ + lib/delta-table + lib/delta-types/ + lib/launcher/ + lib/numeric/ + lib/primitive/ + lib/test-utils/ + lib/text-class/ + lib/wai-middleware-logging/ + lib/wallet/ + lib/wallet-benchmarks/ + +-- Using RDRAND instead of /dev/urandom as an entropy source for key +-- generation is dubious. Set the flag so we use /dev/urandom by default. +package cryptonite + flags: -support_rdrand + +-- Using a fork until our patches can be merged upstream + +-- TODO: ADP-1713 +source-repository-package + type: git + location: https://github.com/biocad/servant-openapi3 + tag: 4165b837d3a71debd1059c3735460075840000b5 + --sha256: 1dngrr353kjhmwhn0b289jzqz5rf32llwcv79zcyq15ldpqpbib9 + +-- TODO: ADP-1713 +source-repository-package + type: git + location: https://github.com/paolino/openapi3 + tag: c30d0de6875d75edd64d1aac2272886528bc492d + --sha256: 0b0fzj5vrnfrc8qikabxhsnp4p8lrjpssblbh2rb7aji5hzzfli9 + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-addresses + tag: 6b55f96d57a181f898eb2a50531d3ae4280c549c + --sha256: 0yygam995i3mawk6hfgxb6v918phvqzyipzhjflff0l6zfrldy7f + subdir: command-line + core + +package cardano-addresses + ghc-options: -Wno-incomplete-uni-patterns + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-sl-x509 + tag: a91add165152fa36f08e95fafe7da24f1dba4690 + --sha256: 1ia8vlqghis92cla8qmqa6kh8f3jn29b01fshyk5hmgy5373s684 + +source-repository-package + type: git + location: https://github.com/input-output-hk/bech32.git + tag: e341e7f83d7b73f10baa87e946818b2c493cc5f5 + --sha256: 1d891bpc1q1m1gqj02b4iv3kr4g9w7knlkq43hwbl9dn5k78aydc + subdir: bech32 + +-- ------------------------------------------------------------------------- +-- Constraints tweaking + +-- cardano-addresses unit tests bring in some version constraint conflicts. +-- +-- 1. hjsonschema and hjsonpointer deps have overly strict bounds. +-- 2. it has strict aeson < 1.5 dep - this will be fixed in the next release. allow-newer: - *:aeson + hjsonschema:* + , hjsonpointer:* + , *:aeson + , *:hashable + , async-timer:unliftio-core + , ekg:* + , ntp-client:* + , libsystemd-journal:base , size-based:template-haskell constraints: - aeson >= 2 - , hedgehog >= 1.1 + bimap >= 0.4.0 + , openapi3 >= 3.2.0 + , libsystemd-journal >= 1.4.4 + , systemd >= 2.3.0 + -- dependency of systemd-2.3.0 + , network >= 3.1.1.1 + -- choose versions that work with base >= 4.12 + , hjsonpointer >= 1.5.0 + , hjsonschema >= 1.10.0 + , Cabal >= 3.4.0.0 + , async-timer >= 0.2.0.0 + , unliftio-core >= 0.2.0.1 + , generic-arbitrary >= 0.2.2 + , iohk-monitoring >= 0.1.11 + + -- lower versions of katip won't build with the Win32-2.12.0.1 + -- which is shipped with the ghc-9.2.8 + , katip >= 0.8.7.4 + + -- Cardano Node dependencies: + , cardano-api ^>=8.2 + , cardano-slotting >= 0.1 + , ouroboros-network ^>= 0.8.1.0 + + -- TH Name shadowing warnings need to be addressed when bumping to 2.13.3.5 + , persistent == 2.13.3.3 + + -- Haddock is broken in this release. Waiting for the next release + +-- ---------------------------------------------------------------- +-- Flags for dependencies + +package cardano-config + flags: -systemd +package cardano-node + flags: -systemd + +-- ------------------------------------------------------------------------- +-------- End contents from @cardano-wallet@'s @cabal.project@ file. -------- diff --git a/cardano-simple/cardano-simple.cabal b/cardano-simple/cardano-simple.cabal index ea8b977..523e033 100644 --- a/cardano-simple/cardano-simple.cabal +++ b/cardano-simple/cardano-simple.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.0 +cabal-version: 3.8 name: cardano-simple version: 0.0.1 synopsis: Lightweight wrapper layer of some Cardano functions @@ -12,11 +12,7 @@ maintainer: copyright: TODO category: TODO build-type: Simple -tested-with: GHC ==9.2.4 -extra-source-files: - data/alonzo-params.json - data/protocol-params.json - README.md +tested-with: GHC ==9.2.8 common lang default-language: GHC2021 @@ -62,7 +58,14 @@ common lang -Wall -Wcompat -Wredundant-constraints -Wmissing-export-lists -Werror -Wincomplete-record-updates -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas - -fobject-code -fno-specialise + -fno-specialise -Wno-partial-type-signatures + + -- expose all unfoldings, so plutustx compiler can do its job + ghc-options: + -fexpose-all-unfoldings -fobject-code + -fplugin-opt PlutusTx.Plugin:defer-errors + -- set target plutus-core version + ghc-options: -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 common deps build-depends: @@ -75,9 +78,14 @@ common deps , cardano-binary , cardano-crypto , cardano-crypto-class + , cardano-ledger-api + , cardano-ledger-allegra + , cardano-ledger-binary + , cardano-ledger-mary , cardano-ledger-alonzo , cardano-ledger-babbage , cardano-ledger-core + , cardano-ledger-core:testlib , cardano-ledger-shelley , cardano-ledger-shelley-ma , cardano-slotting @@ -90,10 +98,11 @@ common deps , flat , hashable , http-api-data + , lens , memory , mtl - , plutarch , plutus-core + , plutus-core:plutus-ir , plutus-ledger-api , plutus-tx , prettyprinter diff --git a/cardano-simple/src/Cardano/Simple/Cardano/Alonzo.hs b/cardano-simple/src/Cardano/Simple/Cardano/Alonzo.hs index e6d73ef..326635b 100644 --- a/cardano-simple/src/Cardano/Simple/Cardano/Alonzo.hs +++ b/cardano-simple/src/Cardano/Simple/Cardano/Alonzo.hs @@ -9,16 +9,17 @@ module Cardano.Simple.Cardano.Alonzo ( import Prelude +import Control.Lens ((^.)) import Cardano.Ledger.Alonzo (AlonzoEra) -import Cardano.Ledger.Alonzo.PParams qualified as C import Cardano.Ledger.Alonzo.Tx qualified as C import Cardano.Ledger.Alonzo.TxBody qualified as C -import Cardano.Ledger.Alonzo.TxWitness qualified as C +import Cardano.Ledger.Alonzo.TxWits qualified as C import Cardano.Ledger.BaseTypes -import Cardano.Ledger.CompactAddress qualified as C +import Cardano.Ledger.Address qualified as C import Cardano.Ledger.Compactible qualified as C +import Cardano.Ledger.Core qualified as C import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Hashes qualified as C +import qualified Cardano.Ledger.Mary.Value as C import Cardano.Ledger.SafeHash import Cardano.Ledger.SafeHash qualified as C (hashAnnotated) import Cardano.Ledger.Shelley.API.Types qualified as C ( @@ -102,7 +103,7 @@ instance IsCardanoTx Era where Just cval -> Right cval Nothing -> Left "Fail to create compact value" -toAlonzoTx :: Network -> C.AlonzoPParams Era -> P.Extra -> Plutus.Tx -> Either ToCardanoError (C.AlonzoTx Era) +toAlonzoTx :: Network -> C.PParams Era -> P.Extra -> Plutus.Tx -> Either ToCardanoError (C.AlonzoTx Era) toAlonzoTx network params extra tx = do body <- toBody wits <- toWits (C.hashAnnotated body) extra tx @@ -117,15 +118,15 @@ toAlonzoTx network params extra tx = do txcerts <- getDCerts network - (C._poolDeposit params) - (C._minPoolCost params) + (params ^. C.ppPoolDepositL) + (params ^. C.ppMinPoolCostL) extra txwdrls <- getWdrl network extra let txfee = getFee tx txvldt = getInterval tx txUpdates = C.SNothing reqSignerHashes = getSignatories tx - mint <- getMint tx + (C.MaryValue _ mint) <- getMint tx let scriptIntegrityHash = C.SNothing adHash = C.SNothing txnetworkid = C.SJust network @@ -154,14 +155,14 @@ toWits :: SafeHash StandardCrypto C.EraIndependentTxBody -> P.Extra -> Plutus.Tx -> - Either ToCardanoError (C.TxWitness Era) + Either ToCardanoError (C.AlonzoTxWits Era) toWits txBodyHash extra tx = do let bootstrapWits = mempty datumWits <- toDatumWitness tx let redeemerWits = toRedeemerWitness extra tx scriptWits <- toScriptWitness extra tx pure $ - C.TxWitness + C.AlonzoTxWits (toKeyWitness txBodyHash tx) bootstrapWits scriptWits diff --git a/cardano-simple/src/Cardano/Simple/Cardano/Babbage.hs b/cardano-simple/src/Cardano/Simple/Cardano/Babbage.hs index ec89e6b..b6d176c 100644 --- a/cardano-simple/src/Cardano/Simple/Cardano/Babbage.hs +++ b/cardano-simple/src/Cardano/Simple/Cardano/Babbage.hs @@ -6,24 +6,24 @@ module Cardano.Simple.Cardano.Babbage ( toBabbageTx, ) where +import Control.Lens ((^.)) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Sequence.Strict qualified as Seq import Prelude -import Cardano.Ledger.Alonzo.Data qualified as C -import Cardano.Ledger.Alonzo.TxWitness qualified as C -import Cardano.Ledger.Babbage (BabbageEra) -import Cardano.Ledger.Babbage.PParams qualified as C +import Cardano.Ledger.Alonzo.Scripts.Data qualified as C +import Cardano.Ledger.Alonzo.TxWits qualified as C +import Cardano.Ledger.Babbage (BabbageEra, Babbage) import Cardano.Ledger.Babbage.Tx qualified as C import Cardano.Ledger.Babbage.TxBody qualified as C +import Cardano.Ledger.Core qualified as C import Cardano.Ledger.BaseTypes -import Cardano.Ledger.CompactAddress qualified as C +import Cardano.Ledger.Address qualified as C import Cardano.Ledger.Compactible qualified as C import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Hashes qualified as C import Cardano.Ledger.SafeHash -import Cardano.Ledger.Serialization qualified as C +import Cardano.Ledger.Binary qualified as C import Cardano.Ledger.Shelley.API.Types qualified as C ( StrictMaybe (..), ) @@ -52,6 +52,7 @@ import Cardano.Simple.Ledger.Tx qualified as Plutus import Cardano.Simple.PlutusLedgerApi.V1.Scripts qualified as P import Cardano.Simple.TxExtra qualified as P import PlutusLedgerApi.V2 qualified as P +import qualified Cardano.Ledger.Mary.Value as C type Era = BabbageEra StandardCrypto @@ -62,7 +63,7 @@ instance IsCardanoTx Era where toBabbageTx :: Network -> - C.BabbagePParams Era -> + C.PParams Era -> P.Extra -> Plutus.Tx -> Either ToCardanoError (C.AlonzoTx Era) @@ -84,15 +85,15 @@ toBabbageTx network params extra tx = do txcerts <- getDCerts network - (C._poolDeposit params) - (C._minPoolCost params) + (params ^. C.ppPoolDepositL) + (params ^. C.ppMinPoolCostL) extra txwdrls <- getWdrl network extra let txfee = getFee tx txvldt = getInterval tx txUpdates = C.SNothing reqSignerHashes = getSignatories tx - mint <- getMint tx + (C.MaryValue _ mint) <- getMint tx let scriptIntegrityHash = C.SNothing adHash = C.SNothing txNetworkId = C.SJust network @@ -134,7 +135,7 @@ toSizedTxOut :: Network -> P.TxOut -> Either ToCardanoError (C.Sized (C.BabbageTxOut Era)) -toSizedTxOut scriptMap network tout = C.mkSized <$> toTxOut scriptMap network tout +toSizedTxOut scriptMap network tout = C.mkSized (C.eraProtVerHigh @Babbage) <$> toTxOut scriptMap network tout toBabbageTxOut :: Map P.ScriptHash (C.Versioned P.Script) -> Network -> P.TxOut -> Either ToCardanoError (C.BabbageTxOut Era) toBabbageTxOut scriptMap network (P.TxOut addr value mdh mScriptHash) = do @@ -209,14 +210,14 @@ toWits :: SafeHash StandardCrypto C.EraIndependentTxBody -> P.Extra -> Plutus.Tx -> - Either ToCardanoError (C.TxWitness Era) + Either ToCardanoError (C.AlonzoTxWits Era) toWits txBodyHash extra tx = do let bootstrapWits = mempty datumWits <- toDatumWitness tx let redeemerWits = toRedeemerWitness extra tx scriptWits <- toScriptWitness extra tx pure $ - C.TxWitness + C.AlonzoTxWits (toKeyWitness txBodyHash tx) bootstrapWits scriptWits diff --git a/cardano-simple/src/Cardano/Simple/Cardano/Class.hs b/cardano-simple/src/Cardano/Simple/Cardano/Class.hs index b01648a..4f69889 100644 --- a/cardano-simple/src/Cardano/Simple/Cardano/Class.hs +++ b/cardano-simple/src/Cardano/Simple/Cardano/Class.hs @@ -19,7 +19,7 @@ import Data.Map (Map) import Data.Map qualified as Map import PlutusLedgerApi.V2 qualified as P -class (C.Crypto era ~ StandardCrypto) => IsCardanoTx era where +class (C.EraCrypto era ~ StandardCrypto) => IsCardanoTx era where toCardanoTx :: Network -> C.PParams era -> diff --git a/cardano-simple/src/Cardano/Simple/Cardano/Common.hs b/cardano-simple/src/Cardano/Simple/Cardano/Common.hs index d886d34..7fddc28 100644 --- a/cardano-simple/src/Cardano/Simple/Cardano/Common.hs +++ b/cardano-simple/src/Cardano/Simple/Cardano/Common.hs @@ -46,16 +46,17 @@ import Data.Set qualified as Set import Cardano.Crypto.Hash.Class qualified as C import Cardano.Crypto.Hash.Class qualified as Crypto -import Cardano.Ledger.Alonzo.Data qualified as C +import Cardano.Ledger.Alonzo.Scripts.Data qualified as C import Cardano.Ledger.Alonzo.Scripts qualified as C import Cardano.Ledger.Alonzo.TxInfo qualified as C -import Cardano.Ledger.Alonzo.TxWitness qualified as C +import Cardano.Ledger.Alonzo.TxWits qualified as C import Cardano.Ledger.BaseTypes import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Era qualified as C import Cardano.Ledger.Hashes qualified as C import Cardano.Ledger.Keys qualified as C import Cardano.Ledger.Keys.WitVKey +import qualified Test.Cardano.Ledger.Core.KeyPair as TC import Cardano.Ledger.Mary.Value qualified as C import Cardano.Ledger.SafeHash import Cardano.Ledger.Shelley.API.Types qualified as C ( @@ -67,12 +68,11 @@ import Cardano.Ledger.Shelley.API.Types qualified as C ( RewardAcnt (..), StakeReference (..), StrictMaybe (..), - Wdrl (..), + Withdrawals (..), ) import Cardano.Ledger.Shelley.API.Types qualified as Shelley (Hash) import Cardano.Ledger.Shelley.Delegation.Certificates qualified as C -import Cardano.Ledger.Shelley.UTxO qualified as C -import Cardano.Ledger.ShelleyMA.Timelocks qualified as C +import Cardano.Ledger.Allegra.Scripts qualified as C import Cardano.Ledger.Slot qualified as C import Cardano.Ledger.TxIn qualified as C import Cardano.Simple.Ledger.Scripts qualified as C @@ -121,7 +121,7 @@ getDCerts network poolDeposit minPoolCost = . mapM (toDCert network poolDeposit minPoolCost . P.certificate'dcert) . P.extra'certificates -getWdrl :: Network -> P.Extra -> Either ToCardanoError (C.Wdrl StandardCrypto) +getWdrl :: Network -> P.Extra -> Either ToCardanoError (C.Withdrawals StandardCrypto) getWdrl network = toWdrl network . P.extra'withdraws @@ -129,7 +129,7 @@ getWdrl network = getSignatories :: Plutus.Tx -> Set.Set (C.KeyHash 'C.Witness StandardCrypto) getSignatories = Set.fromList - . fmap (C.hashKey . C.vKey) + . fmap (C.hashKey . TC.vKey) . Map.elems . Plutus.txSignatures @@ -232,8 +232,8 @@ toCredential = \case P.PubKeyCredential pubKeyHash -> C.KeyHashObj <$> toPubKeyHash pubKeyHash P.ScriptCredential validatorHash -> C.ScriptHashObj <$> toScriptHash validatorHash -toWdrl :: Network -> [P.Withdraw] -> Either ToCardanoError (C.Wdrl StandardCrypto) -toWdrl network ws = C.Wdrl . Map.fromList <$> mapM to ws +toWdrl :: Network -> [P.Withdraw] -> Either ToCardanoError (C.Withdrawals StandardCrypto) +toWdrl network ws = C.Withdrawals . Map.fromList <$> mapM to ws where to (P.Withdraw scred amount _) = case scred of @@ -284,11 +284,11 @@ toKeyWitness :: Set (WitVKey 'C.Witness StandardCrypto) toKeyWitness txBodyHash tx = Set.fromList $ - fmap (C.makeWitnessVKey txBodyHash) $ + fmap (TC.mkWitnessVKey txBodyHash) $ Map.elems $ Plutus.txSignatures tx -toDatumWitness :: (C.Era era, C.Crypto era ~ StandardCrypto) => Plutus.Tx -> Either ToCardanoError (C.TxDats era) +toDatumWitness :: (C.Era era, C.EraCrypto era ~ StandardCrypto) => Plutus.Tx -> Either ToCardanoError (C.TxDats era) toDatumWitness tx = do datumWits1 <- Map.fromList <$> mapM (\d -> (,toDatum d) <$> toDataHash (C.datumHash d)) validatorDatums1 datumWits2 <- Map.fromList <$> mapM (\(dh, d) -> (,toDatum d) <$> toDataHash dh) validatorDatums2 @@ -340,7 +340,7 @@ toRedeemerWitness extra tx = certRedeemers = redeemersBy C.Cert (fmap P.certificate'script . P.extra'certificates) withdrawRedeemers = redeemersBy C.Rewrd (fmap P.withdraw'script . P.extra'withdraws) - redeemersBy :: C.Tag -> (P.Extra -> [Maybe (P.Redeemer, a)]) -> Map.Map C.RdmrPtr (C.Data era, C.ExUnits) + redeemersBy :: C.Era era => C.Tag -> (P.Extra -> [Maybe (P.Redeemer, a)]) -> Map.Map C.RdmrPtr (C.Data era, C.ExUnits) redeemersBy scriptTag extract = Map.fromList $ mapMaybe toWithdraw $ @@ -354,10 +354,10 @@ toRedeemerWitness extra tx = addDefaultExUnits rdm = (rdm, C.ExUnits 1 1) toScriptWitness :: - (C.Crypto era ~ StandardCrypto) => + (C.EraCrypto era ~ StandardCrypto) => P.Extra -> Plutus.Tx -> - Either ToCardanoError (Map (C.ScriptHash (C.Crypto era)) (C.AlonzoScript era)) + Either ToCardanoError (Map (C.ScriptHash (C.EraCrypto era)) (C.AlonzoScript era)) toScriptWitness extra tx = Map.fromList <$> mapM (\s -> (,C.toScript s) <$> toScriptHash (C.validatorHash (fmap P.Validator s))) allScripts where @@ -382,8 +382,8 @@ toScriptWitness extra tx = (fromInType <=< Plutus.txInType) (Set.toList $ Plutus.txInputs tx) -toDatum :: P.Datum -> C.Data era +toDatum :: C.Era era => P.Datum -> C.Data era toDatum (P.Datum (P.BuiltinData d)) = C.Data d -toRedeemer :: P.Redeemer -> C.Data era +toRedeemer :: C.Era era => P.Redeemer -> C.Data era toRedeemer (P.Redeemer (P.BuiltinData d)) = C.Data d diff --git a/cardano-simple/src/Cardano/Simple/Eval.hs b/cardano-simple/src/Cardano/Simple/Eval.hs index 75dad19..bdb1f71 100644 --- a/cardano-simple/src/Cardano/Simple/Eval.hs +++ b/cardano-simple/src/Cardano/Simple/Eval.hs @@ -3,20 +3,18 @@ module Cardano.Simple.Eval ( utxoForTransaction, txBalance, evaluateScriptsInTx, - toAlonzoCostModels, ) where import Prelude -import Data.Array qualified as Array import Data.Either (lefts, rights) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import GHC.Records (HasField (getField)) +import GHC.Records (HasField) -import Cardano.Ledger.Alonzo.Data qualified as Ledger +import Cardano.Ledger.Alonzo.Scripts.Data qualified as Ledger import Cardano.Ledger.Alonzo.Tx qualified as Ledger import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Core qualified as Ledger @@ -27,13 +25,13 @@ import Cardano.Ledger.Slot (EpochSize (..)) import Cardano.Slotting.EpochInfo.Impl (fixedEpochInfo) import Cardano.Slotting.Time (SystemStart (..), slotLengthFromMillisec) -import Cardano.Ledger.Alonzo.Tools (evaluateTransactionExecutionUnits) +import Cardano.Ledger.Api.Tx (evalTxExUnits) import Cardano.Ledger.Alonzo.TxInfo (ExtendedUTxO, TranslationError) -import Cardano.Ledger.Shelley.API (CLI, evaluateTransactionBalance) +import Cardano.Ledger.Api.Tx.Body (evalBalanceTxBody) import Cardano.Ledger.Shelley.TxBody (ShelleyEraTxBody) -import Cardano.Ledger.Alonzo.Language qualified as Alonzo import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo +import Cardano.Ledger.Alonzo.UTxO qualified as Alonzo import Cardano.Simple.Cardano.Class ( IsCardanoTx, @@ -73,6 +71,7 @@ evalScript lang pparams cm script args = where toPlutusLang Ledger.PlutusV1 = Plutus.PlutusV1 toPlutusLang Ledger.PlutusV2 = Plutus.PlutusV2 + toPlutusLang Ledger.PlutusV3 = Plutus.PlutusV3 utxoForTransaction :: forall era. @@ -101,8 +100,8 @@ utxoForTransaction utxos network tx = txBalance :: forall era. ( IsCardanoTx era - , CLI era , ShelleyEraTxBody era + , Ledger.EraUTxO era ) => Map TxOutRef TxOut -> Ledger.PParams era -> @@ -114,24 +113,27 @@ txBalance utxos pparams network tx extra = do utxo <- utxoForTransaction @era utxos network tx ltx <- toCardanoTx @era network pparams extra tx pure $ - evaluateTransactionBalance @era + evalBalanceTxBody @era pparams - utxo - (const True) + (const Nothing) + -- TODO this is sort of wrong + -- if psm starts supporting staking + -- this would need to be fixed + (const False) -- TODO this is sort of wrong -- if psm starts supporting staking -- this would need to be fixed + utxo (getTxBody @era ltx) evaluateScriptsInTx :: forall era. - ( HasField "_protocolVersion" (Ledger.PParams era) Ledger.ProtVer - , HasField "_maxTxExUnits" (Ledger.PParams era) Alonzo.ExUnits - , HasField "_costmdls" (Ledger.PParams era) Alonzo.CostModels - , Ledger.AlonzoEraTx era + ( Ledger.AlonzoEraTx era , Ledger.Script era ~ Alonzo.AlonzoScript era + , Ledger.ScriptsNeeded era ~ Alonzo.AlonzoScriptsNeeded era , ExtendedUTxO era , IsCardanoTx era + , Ledger.EraUTxO era ) => Map TxOutRef TxOut -> Ledger.PParams era -> @@ -140,14 +142,14 @@ evaluateScriptsInTx :: Extra -> SlotConfig -> Either - (Either ToCardanoError (TranslationError (Ledger.Crypto era))) + (Either ToCardanoError (TranslationError (Ledger.EraCrypto era))) Alonzo.ExUnits evaluateScriptsInTx utxos pparams network tx extra slotCfg = do ltx <- leftMap Left $ toCardanoTx @era network pparams extra tx utxo <- leftMap Left $ utxoForTransaction @era utxos network tx res <- leftMap Right $ - evaluateTransactionExecutionUnits @era + evalTxExUnits @era pparams ltx utxo @@ -162,7 +164,6 @@ evaluateScriptsInTx utxos pparams network tx extra slotCfg = do getPOSIXTime $ scSlotZeroTime slotCfg ) - (toAlonzoCostModels $ getField @"_costmdls" pparams) let res' = (\(k, v) -> fmap (k,) v) <$> Map.toList res errs = lefts res' cost = foldMap snd . rights $ res' @@ -170,11 +171,5 @@ evaluateScriptsInTx utxos pparams network tx extra slotCfg = do then pure cost else Left . Left $ show errs -toAlonzoCostModels :: - Alonzo.CostModels -> - Array.Array Alonzo.Language Alonzo.CostModel -toAlonzoCostModels (Alonzo.CostModels costmodels) = - Array.array (minBound, maxBound) $ Map.toList costmodels - leftMap :: (a -> b) -> Either a c -> Either b c leftMap f = either (Left . f) Right diff --git a/cardano-simple/src/Cardano/Simple/Ledger/Scripts.hs b/cardano-simple/src/Cardano/Simple/Ledger/Scripts.hs index 9457aab..ad975c1 100644 --- a/cardano-simple/src/Cardano/Simple/Ledger/Scripts.hs +++ b/cardano-simple/src/Cardano/Simple/Ledger/Scripts.hs @@ -20,14 +20,11 @@ import Data.Coerce import GHC.Generics import Prelude -import Codec.Serialise (serialise) -import Data.ByteString.Lazy qualified as BSL -import Data.ByteString.Short qualified as SBS import Cardano.Crypto.Hash.Class qualified as C import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo qualified as C -import Cardano.Ledger.Alonzo.Data qualified as C +import Cardano.Ledger.Alonzo.Scripts.Data qualified as C import Cardano.Ledger.Alonzo.Language qualified as C import Cardano.Ledger.Alonzo.Scripts qualified as C import Cardano.Ledger.Alonzo.TxInfo qualified as C @@ -106,4 +103,4 @@ scriptCurrencySymbol policy = toScript :: Versioned P.Script -> C.AlonzoScript era toScript (Versioned lang script) = - C.PlutusScript lang $ SBS.toShort $ BSL.toStrict $ serialise script + C.PlutusScript lang $ coerce $ script diff --git a/cardano-simple/src/Cardano/Simple/Ledger/Slot.hs b/cardano-simple/src/Cardano/Simple/Ledger/Slot.hs index 3e11b95..d069f35 100644 --- a/cardano-simple/src/Cardano/Simple/Ledger/Slot.hs +++ b/cardano-simple/src/Cardano/Simple/Ledger/Slot.hs @@ -71,22 +71,22 @@ width (Interval (LowerBound (Finite (Slot s1)) in1) (UpperBound (Finite (Slot s2 -- Infinity is involved! width _ = Nothing -deriving anyclass instance (Hashable a) => Hashable (Interval a) +deriving anyclass instance (Hashable a, Enum a, Ord 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 (Hashable a, Enum a, Ord 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 (Hashable a, Enum a, Ord 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 (Hashable a, Enum a, Ord 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/cardano-simple/src/Cardano/Simple/Ledger/Tx.hs b/cardano-simple/src/Cardano/Simple/Ledger/Tx.hs index ae03e9c..ffbd754 100644 --- a/cardano-simple/src/Cardano/Simple/Ledger/Tx.hs +++ b/cardano-simple/src/Cardano/Simple/Ledger/Tx.hs @@ -21,6 +21,7 @@ import GHC.Generics (Generic) import Cardano.Crypto.Hash (SHA256, digest) import Cardano.Ledger.Crypto qualified as C (StandardCrypto) import Cardano.Ledger.Keys qualified as C +import qualified Test.Cardano.Ledger.Core.KeyPair as TC import Codec.CBOR.Write qualified as Write import Codec.Serialise import PlutusLedgerApi.V2 @@ -54,7 +55,7 @@ data Tx = Tx -- ^ The 'SlotRange' during which this transaction may be validated. , txMintScripts :: Set.Set (Versioned MintingPolicy) -- ^ The scripts that must be run to check minting conditions. - , txSignatures :: Map.Map PubKeyHash (C.KeyPair 'C.Witness C.StandardCrypto) + , txSignatures :: Map.Map PubKeyHash (TC.KeyPair 'C.Witness C.StandardCrypto) -- ^ Signatures of this transaction. , txRedeemers :: Redeemers -- ^ Redeemers of the minting scripts. diff --git a/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs b/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs index c0c8eb3..2ff1dc2 100644 --- a/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs +++ b/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs @@ -3,9 +3,6 @@ module Cardano.Simple.PlutusLedgerApi.V1.Scripts ( mkValidatorScript, mkMintingPolicyScript, mkStakeValidatorScript, - mkValidatorScriptPlutarch, - mkMintingPolicyScriptPlutarch, - mkStakeValidatorScriptPlutarch, Script (..), Validator (..), MintingPolicy (..), @@ -15,47 +12,29 @@ module Cardano.Simple.PlutusLedgerApi.V1.Scripts ( MintingPolicyHash (..), ) where -import Prelude qualified as Haskell - -import Codec.CBOR.Decoding as CBOR -import Codec.Serialise (Serialise (..), serialise) -import Control.DeepSeq (NFData) -import Data.ByteString.Lazy qualified as BSL -import Data.Text (Text) -import Flat qualified -import Flat.Decoder qualified as Flat -import GHC.Generics (Generic) -import Plutarch (ClosedTerm, Config, compile) -import Plutarch.Script qualified as Plutarch -import PlutusCore qualified as PLC -import PlutusPrelude (over) -import PlutusTx (CompiledCode, getPlc) -import PlutusTx.Builtins as Builtins -import PlutusTx.Prelude -import UntypedPlutusCore qualified as UPLC +import Codec.Serialise (Serialise (..)) +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) +import PlutusLedgerApi.Common (SerialisedScript, + serialiseCompiledCode) +import PlutusTx.Builtins as Builtins +import PlutusTx.Code + +-- We do not use qualified import because the whole module contains off-chain code +import Prelude as Haskell -- | A script on the chain. This is an opaque type as far as the chain is concerned. -newtype Script = Script {unScript :: UPLC.Program UPLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ()} +newtype Script = Script {unScript :: SerialisedScript} deriving stock (Generic) + deriving newtype (Haskell.Eq, Haskell.Ord) deriving anyclass (NFData) - deriving (Serialise) via (SerialiseViaFlat (UPLC.Program UPLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ())) - -instance Haskell.Eq Script where - a == b = Builtins.toBuiltin (BSL.toStrict (serialise a)) == Builtins.toBuiltin (BSL.toStrict (serialise b)) -instance Haskell.Ord Script where - a `compare` b = Builtins.toBuiltin (BSL.toStrict (serialise a)) `compare` Builtins.toBuiltin (BSL.toStrict (serialise b)) instance Haskell.Show Script where showsPrec _ _ = Haskell.showString "