Node 8.8.0-pre

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
 
 

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

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 []

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

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

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]

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

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]