diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 7bfb70cb8f6..a12a4423d05 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -27,7 +27,7 @@ common project-config if os(windows) buildable: False - if impl(ghc < 9) + if impl(ghc < 9.6) buildable: False diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCallTypes.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCallTypes.hs index 601ee01491f..a2c33988391 100644 --- a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCallTypes.hs +++ b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCallTypes.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} module Cardano.Benchmarking.PlutusScripts.CustomCallTypes where diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs index cfd21e6b4d9..3f445fc4f16 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs @@ -27,7 +27,7 @@ import Cardano.CLI.Read (readFileScriptInAnyLang) import Cardano.Api import Cardano.Api.Shelley (PlutusScript (..), ProtocolParameters (..), fromAlonzoExUnits, protocolParamCostModels, toPlutusData) -import Cardano.Ledger.Alonzo.Plutus.TxInfo (exBudgetToExUnits) +import Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits) import qualified PlutusLedgerApi.V1 as PlutusV1 import qualified PlutusLedgerApi.V2 as PlutusV2 @@ -252,7 +252,7 @@ preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (scri dummyTxInfo = PlutusV3.TxInfo { PlutusV3.txInfoInputs = [] , PlutusV3.txInfoOutputs = [] - , PlutusV3.txInfoFee = mempty + , PlutusV3.txInfoFee = 0 , PlutusV3.txInfoMint = mempty , PlutusV3.txInfoTxCerts = [] , PlutusV3.txInfoWdrl = PlutusV3.fromList [] diff --git a/cabal.project b/cabal.project index 4852dc7bf88..9b2dc32ef85 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2023-11-20T23:52:53Z - , cardano-haskell-packages 2023-12-15T14:50:31Z + , hackage.haskell.org 2023-12-20T12:41:18Z + , cardano-haskell-packages 2023-12-24T05:55:00Z packages: cardano-git-rev @@ -60,3 +60,65 @@ package plutus-scripts-bench -- temporary! Please read the section in CONTRIBUTING about updating dependencies. -- `smtp-mail` should depend on `crypton-connection` rather than `connection`! + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-ledger.git + tag: 8e281ac3372f996eff4a19e241526eebbf96a0eb + subdir: + eras/allegra/impl + eras/alonzo/impl + eras/alonzo/test-suite + eras/babbage/impl + eras/babbage/test-suite + eras/byron/ledger/impl + eras/conway/impl + eras/conway/test-suite + eras/mary/impl + eras/shelley/impl + eras/shelley/test-suite + eras/shelley-ma/test-suite + libs/cardano-data + libs/cardano-ledger-api + libs/cardano-ledger-binary + libs/cardano-ledger-core + libs/cardano-ledger-pretty + libs/small-steps + libs/small-steps-test + libs/vector-map + --sha256: 0dxy0rcf36k7vmxqi0i35jrvh9gfz2hf7ksjxx4azlm5s5fa4v06 + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus.git + tag: 2ec1925bf2cb05e8b761b7db1cd75e5e9cb2bcfd + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-protocol + ouroboros-consensus-diffusion + sop-extras + strict-sop-core + --sha256: 1301wr951688k2dcav33391x9c0pgn1w32q8yhjm6j7m8zjczh93 + +-- Remove once QSM 0.9 is released, see +-- https://github.com/stevana/quickcheck-state-machine/pull/31 +source-repository-package + type: git + location: https://github.com/stevana/quickcheck-state-machine + tag: 8e2bfb2214c7af1dae728180f2092effea6fbeb7 + --sha256: 1x3wxx57qwn5j7qr5wgakpigawaaidg172n00s33yjrlmg42w5s9 + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-api.git + tag: 610e78b0419350ad2051bd7505ab6ab6242de78a + subdir: cardano-api + --sha256: 1sga07sfhlwhmj2pj5hxv830kyzb8a3b5nvmv13wcmw3plw3x2rj + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-cli.git + tag: 97849de4e6cb4a4b9853cbf5be17cb5377a59a96 + subdir: cardano-cli + --sha256: 02dgj99d113d8h9aam82lggwlf1vp4rdfq8km8sqcwmrfgbp1igy diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 2b3638e88c1..575a323c10b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -25,7 +25,7 @@ import qualified Cardano.Crypto.VRF.Class as Crypto import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure) import qualified Cardano.Ledger.Allegra.Rules as Allegra import qualified Cardano.Ledger.Allegra.Scripts as Allegra -import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo +import qualified Cardano.Ledger.Alonzo.Plutus.Evaluate as Alonzo import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure, AlonzoUtxoPredFailure, AlonzoUtxosPredFailure, AlonzoUtxowPredFailure (..)) import qualified Cardano.Ledger.Alonzo.Rules as Alonzo @@ -1135,14 +1135,20 @@ instance mconcat [ "kind" .= String "ExpirationEpochTooSmall" , "credentialsToEpoch" .= credsToEpoch ] - forMachine _ (Conway.InvalidPrevGovActionIdsInProposals proposals) = - mconcat [ "kind" .= String "InvalidPrevGovActionIdsInProposals" - , "proposals" .= proposals + forMachine _ (Conway.InvalidPrevGovActionId proposalProcedure) = + mconcat [ "kind" .= String "InvalidPrevGovActionId" + , "proposalProcedure" .= proposalProcedure ] forMachine _ (Conway.VotingOnExpiredGovAction actions) = mconcat [ "kind" .= String "VotingOnExpiredGovAction" , "action" .= actions ] + forMachine _ (Conway.ProposalCantFollow prevGovActionId protVer prevProtVer) = + mconcat [ "kind" .= String "ProposalCantFollow" + , "prevGovActionId" .= prevGovActionId + , "protVer" .= protVer + , "prevProtVer" .= prevProtVer + ] instance ( Consensus.ShelleyBasedEra era diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index e31fc51422b..a6a309ed8c2 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs @@ -29,6 +29,7 @@ import qualified Data.Text as Text import Text.Printf (printf) import Ouroboros.Consensus.Block (Header) +import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar, readTVar) import Ouroboros.Consensus.Util.Orphans () import Ouroboros.Network.ConnectionId (remoteAddress) @@ -105,9 +106,9 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd tuple3pop (a, b, _) = (a, b) getCandidates - :: STM.StrictTVar IO (Map peer (STM.StrictTVar IO (Net.AnchoredFragment (Header blk)))) + :: StrictTVar IO (Map peer (StrictTVar IO (Net.AnchoredFragment (Header blk)))) -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk))) - getCandidates var = STM.readTVar var >>= traverse STM.readTVar + getCandidates var = readTVar var >>= traverse readTVar extractPeers :: NodeKernel IO RemoteAddress LocalConnectionId blk -> IO [PeerT blk] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 7a2ef35bb68..5c490d9c8b1 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -28,20 +28,25 @@ import qualified Cardano.Crypto.VRF.Class as Crypto import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure) import qualified Cardano.Ledger.Allegra.Rules as Allegra import qualified Cardano.Ledger.Allegra.Scripts as Allegra +import qualified Cardano.Ledger.Alonzo as Alonzo +import qualified Cardano.Ledger.Alonzo.Plutus.Evaluate as Alonzo import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Alonzo -import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..), AlonzoUtxoPredFailure, AlonzoUtxosPredFailure, AlonzoUtxowPredFailure (..)) import qualified Cardano.Ledger.Alonzo.Rules as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Api as Ledger +import qualified Cardano.Ledger.Babbage as Babbage import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure) import qualified Cardano.Ledger.Babbage.Rules as Babbage +import qualified Cardano.Ledger.Babbage.TxInfo as Babbage import Cardano.Ledger.BaseTypes (activeSlotLog, strictMaybeToMaybe) import Cardano.Ledger.Chain import Cardano.Ledger.Conway.Governance (govActionIdToText) +import qualified Cardano.Ledger.Conway as Conway import Cardano.Ledger.Conway.Rules () import qualified Cardano.Ledger.Conway.Rules as Conway +import qualified Cardano.Ledger.Conway.TxInfo as Conway import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Core as Ledger import Cardano.Ledger.Crypto (StandardCrypto) @@ -376,14 +381,20 @@ instance Ledger.EraPParams era => ToObject (Conway.ConwayGovPredFailure era) whe mconcat [ "kind" .= String "ExpirationEpochTooSmall" , "credentialsToEpoch" .= credsToEpoch ] - toObject _ (Conway.InvalidPrevGovActionIdsInProposals proposals) = - mconcat [ "kind" .= String "InvalidPrevGovActionIdsInProposals" - , "proposals" .= proposals + toObject _ (Conway.InvalidPrevGovActionId proposalProcedure) = + mconcat [ "kind" .= String "InvalidPrevGovActionId" + , "proposalProcedure" .= proposalProcedure ] toObject _ (Conway.VotingOnExpiredGovAction actions) = mconcat [ "kind" .= String "VotingOnExpiredGovAction" , "action" .= actions ] + toObject _ (Conway.ProposalCantFollow prevGovActionId protVer prevProtVer) = + mconcat [ "kind" .= String "ProposalCantFollow" + , "prevGovActionId" .= prevGovActionId + , "protVer" .= protVer + , "prevProtVer" .= prevProtVer + ] instance ( Core.Crypto (Consensus.EraCrypto era) @@ -1133,10 +1144,7 @@ instance deriving newtype instance ToJSON Alonzo.IsValid -instance - ( Core.Crypto (Ledger.EraCrypto ledgerera) - , Ledger.EraCrypto ledgerera ~ StandardCrypto - ) => ToJSON (Alonzo.CollectError ledgerera) where +instance ToJSON (Alonzo.CollectError (Alonzo.AlonzoEra StandardCrypto)) where toJSON cError = case cError of Alonzo.NoRedeemer sPurpose -> @@ -1161,28 +1169,86 @@ instance object [ "kind" .= String "PlutusTranslationError" , "error" .= case err of - Alonzo.ByronTxOutInContext txOutSource -> + Alonzo.TranslationLogicMissingInput txin -> + String $ "Transaction input does not exist in the UTxO: " <> textShow txin + Alonzo.TimeTranslationPastHorizon msg -> + String $ "Time translation requested past the horizon: " <> textShow msg + ] + +instance ToJSON (Alonzo.CollectError (Babbage.BabbageEra StandardCrypto)) where + toJSON cError = + case cError of + Alonzo.NoRedeemer sPurpose -> + object + [ "kind" .= String "CollectError" + , "error" .= String "NoRedeemer" + , "scriptpurpose" .= renderScriptPurpose sPurpose + ] + Alonzo.NoWitness sHash -> + object + [ "kind" .= String "CollectError" + , "error" .= String "NoWitness" + , "scripthash" .= renderScriptHash sHash + ] + Alonzo.NoCostModel lang -> + object + [ "kind" .= String "CollectError" + , "error" .= String "NoCostModel" + , "language" .= toJSON lang + ] + Alonzo.BadTranslation err -> + object + [ "kind" .= String "PlutusTranslationError" + , "error" .= case err of + Babbage.AlonzoContextError _alonzoCtxErr -> + String "???" + Babbage.ByronTxOutInContext txOutSource -> String $ "Cannot construct a Plutus ScriptContext from this transaction " <> "due to a Byron UTxO being created or spent: " <> textShow txOutSource - Alonzo.TranslationLogicMissingInput txin -> - String $ "Transaction input does not exist in the UTxO: " <> textShow txin - Alonzo.RdmrPtrPointsToNothing ptr -> + Babbage.RdmrPtrPointsToNothing ptr -> object [ "kind" .= String "RedeemerPointerPointsToNothing" , "ptr" .= Api.fromAlonzoRdmrPtr ptr ] - Alonzo.LanguageNotSupported lang -> - String $ "Language not supported: " <> textShow lang - Alonzo.InlineDatumsNotSupported txOutSource -> + Babbage.InlineDatumsNotSupported txOutSource -> String $ "Inline datums not supported, output source: " <> textShow txOutSource - Alonzo.ReferenceScriptsNotSupported txOutSource -> + Babbage.ReferenceScriptsNotSupported txOutSource -> String $ "Reference scripts not supported, output source: " <> textShow txOutSource - Alonzo.ReferenceInputsNotSupported txins -> + Babbage.ReferenceInputsNotSupported txins -> String $ "Reference inputs not supported: " <> textShow txins - Alonzo.TimeTranslationPastHorizon msg -> - String $ "Time translation requested past the horizon: " <> textShow msg + ] + +instance ToJSON (Alonzo.CollectError (Conway.ConwayEra StandardCrypto)) where + toJSON cError = + case cError of + Alonzo.NoRedeemer sPurpose -> + object + [ "kind" .= String "CollectError" + , "error" .= String "NoRedeemer" + , "scriptpurpose" .= renderScriptPurpose sPurpose + ] + Alonzo.NoWitness sHash -> + object + [ "kind" .= String "CollectError" + , "error" .= String "NoWitness" + , "scripthash" .= renderScriptHash sHash + ] + Alonzo.NoCostModel lang -> + object + [ "kind" .= String "CollectError" + , "error" .= String "NoCostModel" + , "language" .= toJSON lang + ] + Alonzo.BadTranslation err -> + object + [ "kind" .= String "PlutusTranslationError" + , "error" .= case err of + Conway.BabbageContextError _babbageCtxErr -> + String "???" + Conway.CertificateNotSupported _cert -> + String "???" ] instance ToJSON Alonzo.TagMismatchDescription where diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index feff0469095..81e143eed8f 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/cardano-node/src/Cardano/Tracing/Peer.hs @@ -32,6 +32,7 @@ import Cardano.BM.Trace (traceNamedObject) import Cardano.BM.Tracing import Ouroboros.Consensus.Block (Header) +import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar, readTVar) import Ouroboros.Consensus.Util.Orphans () import Ouroboros.Network.ConnectionId (remoteAddress) @@ -97,9 +98,9 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd tuple3pop (a, b, _) = (a, b) getCandidates - :: STM.StrictTVar IO (Map peer (STM.StrictTVar IO (Net.AnchoredFragment (Header blk)))) + :: StrictTVar IO (Map peer (StrictTVar IO (Net.AnchoredFragment (Header blk)))) -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk))) - getCandidates var = STM.readTVar var >>= traverse STM.readTVar + getCandidates var = readTVar var >>= traverse readTVar extractPeers :: NodeKernel IO RemoteAddress LocalConnectionId blk -> IO [Peer blk] diff --git a/flake.lock b/flake.lock index b495f546b9e..fb2a8d44829 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1702742788, - "narHash": "sha256-lSU0M27LC0d60cJ2C2Kdo6gBwTCCYRiALbD528CoTtc=", + "lastModified": 1703398734, + "narHash": "sha256-DVaL6dBqgGOOjr3kyHi3NgtD4UrwTVsSMLkpUToyPt4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "4a236a8ad9e3c6d20235de27eacbe3d4de72479c", + "rev": "dbfa903050eb861fcbd0c22dd5a4746f68d6d42e", "type": "github" }, "original": { @@ -624,11 +624,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1701303758, - "narHash": "sha256-8XqVEQwmJBxRPFa7SizJuZxbG+NFEZKWdhtYPTQ7ZKM=", + "lastModified": 1703722959, + "narHash": "sha256-fshXL4s6XB3lAbmewKvI6w9+tSJ0XjtqkVfD+/wPxu8=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "8a0e3ae9295b7ef8431b9be208dd06aa2789be53", + "rev": "84f2074283c53674de4ef5eb939605ec9b968bad", "type": "github" }, "original": {