WIP release 9.3

bench/plutus-scripts-bench/plutus-scripts-bench.cabal

@@ -81,9 +81,9 @@ library
   --------------------------
   build-depends:
     , cardano-api             ^>=9.3
-    , plutus-ledger-api       ^>=1.32
-    , plutus-tx               ^>=1.32
-    , plutus-tx-plugin        ^>=1.32
+    , plutus-ledger-api       ^>=1.34.1
+    , plutus-tx               ^>=1.34.1
+    , plutus-tx-plugin        ^>=1.34.1
 
   ------------------------
   -- Non-IOG dependencies

bench/tx-generator/src/Cardano/Benchmarking/Command.hs

@@ -52,6 +52,7 @@ import           Data.Foldable as Fold (forM_)
 import           Data.List as List (unwords)
 import           Data.Time.Format as Time (defaultTimeLocale, formatTime)
 import           Data.Time.Clock.System as Time (getSystemTime, systemToUTCTime)
+import           Foreign.C (Errno(..))
 import           GHC.Weak as Weak (deRefWeak)
 
 import           System.Posix.Signals as Sig (Handler (CatchInfo),
@@ -64,6 +65,7 @@ import           GHC.Conc.Sync as Conc (threadLabel)
 #endif
 
 #ifdef UNIX
+deriving instance Show Errno
 deriving instance Show SignalInfo
 deriving instance Show SignalSpecificInfo
 #endif

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs

@@ -11,8 +11,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
@@ -26,10 +24,11 @@ module Cardano.Benchmarking.GeneratorTx.SubmissionClient
   ) where
 
 import           Cardano.Api hiding (Active)
-import           Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx)
+import           Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx, Tx (..))
 
 import           Cardano.Benchmarking.LogTypes
 import           Cardano.Benchmarking.Types
+import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Logging
 import           Cardano.Prelude hiding (ByteString, atomically, retry, state, threadDelay)
 import           Cardano.Tracing.OrphanInstances.Byron ()
@@ -40,7 +39,7 @@ import           Cardano.Tracing.OrphanInstances.Shelley ()
 import qualified Ouroboros.Consensus.Cardano as Consensus (CardanoBlock)
 import qualified Ouroboros.Consensus.Cardano.Block as Block
                    (TxId (GenTxIdAllegra, GenTxIdAlonzo, GenTxIdBabbage, GenTxIdConway, GenTxIdMary, GenTxIdShelley))
-import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId, txInBlockSize)
+import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId)
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Mempool
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Mempool (TxId (ShelleyTxId))
@@ -57,6 +56,8 @@ import qualified Data.List as L
 import qualified Data.List.Extra as L
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
+import           Lens.Micro ((^.))
+
 type CardanoBlock    = Consensus.CardanoBlock  StandardCrypto
 
 data SubmissionThreadStats
@@ -85,10 +86,9 @@ type LocalState era = (TxSource era, UnAcked (Tx era), SubmissionThreadStats)
 type EndOfProtocolCallback m = SubmissionThreadStats -> m ()
 
 txSubmissionClient
-  :: forall m era tx.
+  :: forall m era.
      ( MonadIO m, MonadFail m
      , IsShelleyBasedEra era
-     , tx      ~ Tx era
      )
   => Trace m NodeToNodeSubmissionTrace
   -> Trace m (TraceBenchTxSubmit TxId)
@@ -110,11 +110,11 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
     traceWith bmtr $ SubmissionClientDiscardAcknowledged  (getTxId . getTxBody <$> acked)
     return (txSource, UnAcked stillUnacked, newStats)
 
-  queueNewTxs :: [tx] -> LocalState era -> LocalState era
+  queueNewTxs :: [Tx era] -> LocalState era -> LocalState era
   queueNewTxs newTxs (txSource, UnAcked unAcked, stats)
     = (txSource, UnAcked (newTxs <> unAcked), stats)
 
-  client ::LocalState era -> ClientStIdle (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()
+  client :: LocalState era -> ClientStIdle (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()
 
   client localState = ClientStIdle
     { recvMsgRequestTxIds = requestTxIds localState
@@ -177,12 +177,15 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
               , stsUnavailable =
                 stsUnavailable stats + Unav (length missIds)}))
 
-  txToIdSize :: tx -> (GenTxId CardanoBlock, SizeInBytes)
-  txToIdSize = (Mempool.txId &&& (SizeInBytes . txInBlockSize)) . toGenTx
-
-  toGenTx :: tx -> GenTx CardanoBlock
-  toGenTx tx = toConsensusGenTx $ TxInMode (shelleyBasedEra @era) tx
+  txToIdSize :: Tx era -> (GenTxId CardanoBlock, SizeInBytes)
+  txToIdSize = (Mempool.txId . toGenTx) &&& (SizeInBytes . fromInteger . getTxSize)
+    where
+      getTxSize :: Tx era -> Integer
+      getTxSize (ShelleyTx sbe tx) =
+        shelleyBasedEraConstraints sbe $ tx ^. Ledger.sizeTxF
 
+  toGenTx :: Tx era -> GenTx CardanoBlock
+  toGenTx tx = toConsensusGenTx $ TxInMode shelleyBasedEra tx
 
   fromGenTxId :: GenTxId CardanoBlock -> TxId
   fromGenTxId (Block.GenTxIdShelley (Mempool.ShelleyTxId i)) = fromShelleyTxId i

bench/tx-generator/tx-generator.cabal

@@ -129,6 +129,7 @@ library
                       , generic-monoid
                       , ghc-prim
                       , io-classes
+                      , microlens
                       , mtl
                       , network
                       , network-mux

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 2024-09-05T18:39:40Z
-  , cardano-haskell-packages 2024-09-10T12:51:27Z
+  , hackage.haskell.org 2024-09-25T18:20:40Z
+  , cardano-haskell-packages 2024-09-24T09:13:59Z
 
 packages:
   cardano-node
@@ -67,3 +67,85 @@ allow-newer:
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-ledger
+  tag: b8eab98a780fe2bcf6e2fa5e73506e51a9e4754f
+  --sha256: sha256-Rlr5A8cIfg7AB30bJaKOYmpKQE0Te7spE3ExW8rFr1Y=
+  subdir:
+    eras/allegra/impl
+    eras/alonzo/impl
+    eras/alonzo/test-suite
+    eras/babbage/impl
+    eras/babbage/test-suite
+    eras/conway/impl
+    eras/conway/test-suite
+    eras/mary/impl
+    eras/shelley/impl
+    eras/shelley/test-suite
+    eras/shelley-ma/test-suite
+    libs/cardano-ledger-api
+    libs/cardano-ledger-core
+    libs/cardano-ledger-binary
+    libs/cardano-protocol-tpraos
+    libs/non-integral
+    libs/small-steps
+    libs/cardano-data
+    libs/set-algebra
+    libs/vector-map
+    eras/byron/chain/executable-spec
+    eras/byron/ledger/executable-spec
+    eras/byron/ledger/impl
+    eras/byron/ledger/impl/test
+    eras/byron/crypto
+    eras/byron/crypto/test
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 4350b1634a5c3f89dcfe1267f5049c1919ba609b
+  --sha256: sha256-p9gBOXkKrS/CQRWF13BuIdUUeaqTIPxWnFSVr99a8mg=
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-cardano
+    ouroboros-consensus-protocol
+    ouroboros-consensus-diffusion
+    sop-extras
+    strict-sop-core
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api
+  tag: 6053ccd1387caa3d97cb722268810b3171078a54
+  --sha256: sha256-dVDeIuAo3+X2QDGwTm2HKUsUvGLLsCEmwStmOoz78nQ=
+  subdir:
+    cardano-api
+    cardano-api-gen
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-network
+  tag: 763f987c701ece733bde191ef7acb737d5ec7701
+  --sha256: sha256-HY8Atn0uroB4ZgDwJTw2V6KcYZfYVCzBjL9YMlz9VPs=
+  subdir:
+   cardano-ping
+   monoidal-synchronisation
+   quickcheck-monoids
+   network-mux
+   ouroboros-network
+   ouroboros-network-api
+   ouroboros-network-framework
+   ouroboros-network-mock
+   ouroboros-network-protocols
+   ouroboros-network-testing
+   ntp-client
+   cardano-client
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-cli
+  tag: a85cee82486d94394a4d8fa51331f1fd2e113174
+  --sha256: sha256-Mt5PuDIdIP2WrXzgsTz51aZfMtqrcbBJ7MCoDCr6euk=
+  subdir:
+    cardano-cli

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -31,8 +31,8 @@ import           Cardano.Node.Protocol.Types (Protocol (..))
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config
 import           Cardano.Tracing.OrphanInstances.Network ()
-import           Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..),
-                   MempoolCapacityBytesOverride (..))
+import           Ouroboros.Consensus.Ledger.SupportsMempool
+import           Ouroboros.Consensus.Mempool (MempoolCapacityBytesOverride (..))
 import           Ouroboros.Consensus.Node (NodeDatabasePaths (..))
 import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..),
@@ -361,7 +361,7 @@ instance FromJSON PartialNodeConfiguration where
     where
       parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride
         where
-          parseNoOverride = fmap (MempoolCapacityBytesOverride . MempoolCapacityBytes) <$> v .:? "MempoolCapacityBytesOverride"
+          parseNoOverride = fmap (MempoolCapacityBytesOverride . ByteSize32) <$> v .:? "MempoolCapacityBytesOverride"
           parseOverride = do
             maybeString :: Maybe String <- v .:? "MempoolCapacityBytesOverride"
             case maybeString of

cardano-node/src/Cardano/Node/Handlers/Shutdown.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Node.Handlers.Shutdown
@@ -26,7 +27,6 @@ module Cardano.Node.Handlers.Shutdown
   )
 where
 
-import           Cardano.Api (bounded)
 
 import           Cardano.Slotting.Slot (WithOrigin (..))
 import           Ouroboros.Consensus.Block (Header)
@@ -51,6 +51,8 @@ import           System.Exit (ExitCode (..))
 import qualified System.IO as IO
 import qualified System.IO.Error as IO
 import           System.Posix.Types (Fd (Fd))
+import qualified Text.Read as Read
+
 
 import           Generic.Data.Orphans ()
 
@@ -81,6 +83,13 @@ parseShutdownOn = asum
     ]
   , pure NoShutdown
   ]
+  where
+    bounded :: forall a. (Bounded a, Integral a, Show a) => String -> Opt.ReadM a
+    bounded t = Opt.eitherReader $ \s -> do
+      i <- Read.readEither @Integer s
+      when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
+      when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
+      pure (fromIntegral i)
 
 data ShutdownTrace
   = ShutdownRequested

cardano-node/src/Cardano/Node/Parsers.hs

@@ -20,7 +20,7 @@ import           Cardano.Node.Configuration.Socket
 import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Types
 import           Cardano.Prelude (ConvertText (..))
-import           Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..))
+import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Node
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..),
                    SnapshotInterval (..))
@@ -211,12 +211,12 @@ parseMempoolCapacityOverride = parseOverride <|> parseNoOverride
   where
     parseOverride :: Parser MempoolCapacityBytesOverride
     parseOverride =
-      MempoolCapacityBytesOverride . MempoolCapacityBytes <$>
-      Opt.option (auto @Word32)
-        (  long "mempool-capacity-override"
-        <> metavar "BYTES"
-        <> help "[DEPRECATED: Set it in config file with key MempoolCapacityBytesOverride] The number of bytes"
-        )
+      MempoolCapacityBytesOverride . ByteSize32 <$>
+        Opt.option (auto @Word32)
+          (  long "mempool-capacity-override"
+          <> metavar "BYTES"
+          <> help "[DEPRECATED: Set it in config file with key MempoolCapacityBytesOverride] The number of bytes"
+          )
     parseNoOverride :: Parser MempoolCapacityBytesOverride
     parseNoOverride =
       flag' NoMempoolCapacityBytesOverride

cardano-node/src/Cardano/Node/TraceConstraints.hs

@@ -6,7 +6,6 @@
 
 module Cardano.Node.TraceConstraints (TraceConstraints) where
 
-
 import           Cardano.BM.Tracing (ToObject)
 import           Cardano.Ledger.Credential
 import           Cardano.Ledger.Crypto (StandardCrypto)
@@ -29,6 +28,7 @@ import           Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId)
 import           Ouroboros.Network.Block (Serialised)
 
 import           Data.Aeson
+import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Set
 
 -- | Tracing-related constraints for monitoring purposes.
@@ -71,4 +71,5 @@ type TraceConstraints blk =
     , LogFormatting (CannotForge blk)
     , LogFormatting (ForgeStateUpdateError blk)
     , LogFormatting (Set (Credential 'Staking StandardCrypto))
+    , LogFormatting (NonEmpty.NonEmpty (KeyHash 'Staking StandardCrypto))
     )

cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs

@@ -100,6 +100,12 @@ instance LogFormatting (Set (Credential 'Staking StandardCrypto)) where
              , "stakeCreds" .= map toJSON (Set.toList creds)
              ]
 
+instance LogFormatting (NonEmpty.NonEmpty (KeyHash 'Staking StandardCrypto)) where
+  forMachine _dtal keyHashes =
+    mconcat [ "kind" .= String "StakingKeyHashes"
+             , "stakeKeyHashes" .= toJSON keyHashes
+             ]
+
 instance
   ( LogFormatting (PredicateFailure (Ledger.EraRule "DELEG" era))
   , LogFormatting (PredicateFailure (Ledger.EraRule "POOL" era))
@@ -176,11 +182,6 @@ instance LogFormatting (Conway.ConwayDelegPredFailure era) where
       , "amount" .= coin
       , "error" .= String "Stake key has non-zero account balance"
       ]
-    Conway.DRepAlreadyRegisteredForStakeKeyDELEG credential ->
-      [ "kind" .= String "DRepAlreadyRegisteredForStakeKeyDELEG"
-      , "amount" .= String (textShow credential)
-      , "error" .= String "DRep already registered for the stake key"
-      ]
 
 instance
   ( ShelleyCompatible protocol era
@@ -1099,6 +1100,7 @@ instance
   , LogFormatting (PredicateFailure (Ledger.EraRule "GOV" era))
   , LogFormatting (PredicateFailure (Ledger.EraRule "CERTS" era))
   , LogFormatting (Set (Credential 'Staking (Ledger.EraCrypto era)))
+  , LogFormatting (NonEmpty.NonEmpty (KeyHash 'Staking (Ledger.EraCrypto era)))
   ) => LogFormatting (Conway.ConwayLedgerPredFailure era) where
   forMachine v (Conway.ConwayUtxowFailure f) = forMachine v f
   forMachine _ (Conway.ConwayTxRefScriptsSizeTooBig  actual limit) =
@@ -1184,6 +1186,10 @@ instance
     mconcat [ "kind" .= String "DisallowedVotesDuringBootstrap"
             , "votes" .= votes
             ]
+  forMachine _ (Conway.ZeroTreasuryWithdrawals govAction) =
+    mconcat [ "kind" .= String "ZeroTreasuryWithdrawals"
+            , "govAction" .= govAction
+            ]
 
 
 instance

cardano-node/src/Cardano/Node/Tracing/StateRep.hs

@@ -60,7 +60,7 @@ deriving instance (NFData OpeningDbs)
 
 data Replays
   = ReplayFromGenesis  (WithOrigin SlotNo)
-  | ReplayFromSnapshot SlotNo (WithOrigin SlotNo) (WithOrigin SlotNo)
+  | ReplayFromSnapshot (WithOrigin SlotNo) (WithOrigin SlotNo)
   | ReplayedBlock      SlotNo (WithOrigin SlotNo) (WithOrigin SlotNo)
   deriving (Generic, FromJSON, ToJSON)
 
@@ -219,8 +219,8 @@ traceNodeStateChainDB _scp tr ev =
       case ev' of
         LgrDb.ReplayFromGenesis (LgrDb.ReplayGoal p) ->
           traceWith tr $ NodeReplays $ ReplayFromGenesis (pointSlot p)
-        LgrDb.ReplayFromSnapshot _ (RP.RealPoint s _) (LgrDb.ReplayStart rs) (LgrDb.ReplayGoal rp) ->
-          traceWith tr $ NodeReplays $ ReplayFromSnapshot s (pointSlot rs) (pointSlot rp)
+        LgrDb.ReplayFromSnapshot _ (LgrDb.ReplayStart rs) (LgrDb.ReplayGoal rp) ->
+          traceWith tr $ NodeReplays $ ReplayFromSnapshot (pointSlot rs) (pointSlot rp)
         LgrDb.ReplayedBlock (RP.RealPoint s _) _ (LgrDb.ReplayStart rs) (LgrDb.ReplayGoal rp) ->
           traceWith tr $ NodeReplays $ ReplayedBlock s (pointSlot rs) (pointSlot rp)
     ChainDB.TraceInitChainSelEvent ev' ->