Merge branch 'IntersectMBO:master' into master

Author: crypto-titan

.github/workflows/haskell.yml

@@ -38,7 +38,7 @@ jobs:
 
     env:
       # Modify this value to "invalidate" the cabal cache.
-      CABAL_CACHE_VERSION: "2024-02-29"
+      CABAL_CACHE_VERSION: "2024-03-07"
 
     concurrency:
       group: >

Makefile

@@ -84,8 +84,8 @@ PROFILES_EPOCHTRANS       := epoch-transition
 PROFILES_PLUTUSCALL       := plutuscall-loop-plain plutuscall-secp-ecdsa-plain plutuscall-secp-schnorr-plain
 PROFILES_PLUTUSCALL       += plutuscall-loop-half plutuscall-secp-ecdsa-half plutuscall-secp-schnorr-half
 PROFILES_PLUTUSCALL       += plutuscall-loop-double plutuscall-secp-ecdsa-double plutuscall-secp-schnorr-double
-PROFILES_MODEL		        := model-value model-secp-ecdsa-plain model-secp-ecdsa-half model-secp-ecdsa-double
-PROFILES_MODEL		       	+= model-value-test
+PROFILES_MODEL            := model-value model-secp-ecdsa-plain model-secp-ecdsa-half model-secp-ecdsa-double
+PROFILES_MODEL            += model-value-test
 PROFILES_10               := 10 10-p2p 10-plutus 10-notracer
 PROFILES_FORGE_STRESS     := forge-stress forge-stress-p2p forge-stress-plutus forge-stress-plutus-solo forge-stress-notracer forge-stress-large forge-stress-solo forge-stress-solo-xs
 PROFILES_FORGE_STRESS_PRE := forge-stress-pre forge-stress-pre-plutus forge-stress-pre-notracer forge-stress-pre-solo forge-stress-pre-solo-xl forge-stress-pre-solo-xs
@@ -97,9 +97,10 @@ PROFILES_VENDOR           := dish dish-plutus dish-10M dish-10M-plutus
 # Cloud version of "default", "ci-test" and "ci-bench" plus value (52+explorer)
 # Not all local profiles are compatible or tested (yet) with a cloud runs
 PROFILES_NOMAD_PERF       := default-nomadperf ci-test-nomadperf ci-bench-nomadperf value-nomadperf oldtracing-nomadperf ci-test-oldtracing-nomadperf ci-bench-oldtracing-nomadperf value-oldtracing-nomadperf
-PROFILES_NOMAD_PERF       += plutus-nomadperf idle-nomadperf
+PROFILES_NOMAD_PERF       += plutus-nomadperf fast-nomadperf latency-nomadperf
 PROFILES_NOMAD_PERF_NOP2P := default-nomadperf-nop2p oldtracing-nomadperf-nop2p ci-test-nomadperf-nop2p ci-bench-nomadperf-nop2p
-PROFILES_NOMAD_PERF_NOP2P += value-nomadperf-nop2p value-oldtracing-nomadperf-nop2p plutus-nomadperf-nop2p
+PROFILES_NOMAD_PERF_NOP2P += value-nomadperf-nop2p value-oldtracing-nomadperf-nop2p plutus-nomadperf-nop2p fast-nomadperf-nop2p
+PROFILES_NOMAD_PERFSSD    := fast-nomadperfssd
 
 LOCAL_PROFILES += $(PROFILES_BASE)
 LOCAL_PROFILES += $(PROFILES_FAST)
@@ -118,6 +119,7 @@ LOCAL_PROFILES += $(PROFILES_CHAINSYNC)
 LOCAL_PROFILES += $(PROFILES_VENDOR)
 CLOUD_PROFILES += $(PROFILES_NOMAD_PERF)
 CLOUD_PROFILES += $(PROFILES_NOMAD_PERF_NOP2P)
+CLOUD_PROFILES += $(PROFILES_NOMAD_PERFSSD)
 
 
 ## Note:  to enable a shell for a profile, just add its name (one of names from 'make ps') to SHELL_PROFILES

README.rst

@@ -16,9 +16,9 @@
 
 .. contents:: Contents
 
-*************************
+*******************************************
 Overview of the ``cardano-node`` repository
-*************************
+*******************************************
 
 Integration of the `ledger <https://github.com/input-output-hk/cardano-ledger-specs>`_, `consensus <https://github.com/input-output-hk/ouroboros-consensus>`_,
 `networking <https://github.com/input-output-hk/ouroboros-network/tree/master/ouroboros-network>`_ and

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-02-27T08:06:51Z
-  , cardano-haskell-packages 2024-02-26T17:55:44Z
+  , hackage.haskell.org 2024-03-07T07:48:20Z
+  , cardano-haskell-packages 2024-03-05T10:16:08Z
 
 packages:
   cardano-git-rev

cardano-node/cardano-node.cabal

@@ -187,7 +187,7 @@ library
                       , ouroboros-consensus-cardano ^>= 0.14
                       , ouroboros-consensus-diffusion ^>= 0.11
                       , ouroboros-consensus-protocol
-                      , ouroboros-network-api
+                      , ouroboros-network-api >= 0.7.0.0 && < 0.7.1.0
                       , ouroboros-network ^>= 0.12
                       , ouroboros-network-framework
                       , ouroboros-network-protocols ^>= 0.8

cardano-testnet/CHANGELOG.md

@@ -1,5 +1,9 @@
 # Changelog for cardano-testnet
 
+## Next version
+
+* Update `cardano-ping` dependency
+
 ## 8.7.0
 
 * Using `cardano-node-8.7.0`, `cardano-api-8.33` and `cardano-cli-8.15`

cardano-testnet/cardano-testnet.cabal

@@ -48,7 +48,7 @@ library
                       , cardano-ledger-core:testlib
                       , cardano-ledger-shelley
                       , cardano-node
-                      , cardano-ping ^>= 0.2.0.10
+                      , cardano-ping ^>= 0.2.0.13
                       , contra-tracer
                       , containers
                       , data-default-class
@@ -175,6 +175,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.Cli.Conway.Plutus
                         Cardano.Testnet.Test.Cli.Conway.StakeSnapshot
                         Cardano.Testnet.Test.Cli.KesPeriodInfo
+                        Cardano.Testnet.Test.Cli.Queries
                         Cardano.Testnet.Test.Cli.QuerySlotNumber
                         Cardano.Testnet.Test.FoldBlocks
                         Cardano.Testnet.Test.Misc
@@ -206,7 +207,6 @@ test-suite cardano-testnet-test
                       , cardano-testnet
                       , containers
                       , directory
-                      , exceptions
                       , filepath
                       , hedgehog
                       , hedgehog-extras
@@ -220,6 +220,7 @@ test-suite cardano-testnet-test
                       , text
                       , time
                       , transformers
+                      , vector
 
   ghc-options:          -threaded -rtsopts "-with-rtsopts=-N -T"
 

cardano-testnet/src/Cardano/Testnet.hs

@@ -13,6 +13,8 @@ module Cardano.Testnet (
   TestnetNodeOptions(..),
   cardanoDefaultTestnetOptions,
   cardanoDefaultTestnetNodeOptions,
+  getDefaultAlonzoGenesis,
+  getDefaultShelleyGenesis,
 
   -- * Configuration
   Conf(..),

cardano-testnet/src/Testnet/Components/Query.hs

@@ -1,12 +1,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Testnet.Components.Query
   ( QueryTip
   , EpochStateView
+  , checkDRepsNumber
   , getEpochState
   , queryTip
   , waitUntilEpoch
@@ -19,6 +21,8 @@ module Testnet.Components.Query
   ) where
 
 import           Cardano.Api as Api
+import           Cardano.Api.Ledger (StandardCrypto)
+import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
 import           Cardano.CLI.Types.Output
@@ -28,6 +32,7 @@ import qualified Cardano.Ledger.UTxO as L
 import           Control.Exception.Safe (MonadCatch)
 import           Control.Monad
 import           Control.Monad.Trans.Resource
+import           Control.Monad.Trans.State.Strict (put)
 import           Data.Aeson
 import           Data.Bifunctor (bimap)
 import           Data.IORef
@@ -44,6 +49,7 @@ import           GHC.Stack
 import           Lens.Micro ((^.))
 import           System.Directory (doesFileExist, removeFile)
 
+import qualified Testnet.Process.Cli as P
 import qualified Testnet.Process.Run as H
 import           Testnet.Property.Assert
 import           Testnet.Property.Utils (runInBackground)
@@ -218,3 +224,65 @@ findLargestUtxoForPaymentKey epochStateView sbe address =
     . H.nothingFailM
     $ findLargestUtxoWithAddress epochStateView sbe (paymentKeyInfoAddr address)
 
+
+-- | @checkDRepsNumber config socket execConfig n@
+-- wait for the number of DReps being @n@ for two epochs. If
+-- this number is not attained before two epochs, the test is failed.
+checkDRepsNumber ::
+  (HasCallStack, MonadIO m, MonadCatch m, MonadTest m)
+  => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
+  -> NodeConfigFile 'In
+  -> SocketPath
+  -> H.ExecConfig
+  -> Int
+  -> m ()
+checkDRepsNumber sbe configurationFile socketPath execConfig expectedDRepsNb = do
+  QueryTipLocalStateOutput{mEpoch} <- P.execCliStdoutToJson execConfig [ "query", "tip" ]
+  currentEpoch <- H.evalMaybe mEpoch
+  let terminationEpoch = succ . succ $ currentEpoch
+  void $ H.evalMaybeM $ checkDRepsNumber' sbe configurationFile socketPath terminationEpoch expectedDRepsNb
+
+-- | @checkDRepsNumber' config socket terminationEpoch n@
+-- wait until @terminationEpoch@ for the number of DReps being @n@. If
+-- this number is not attained before @terminationEpoch@, the test is failed.
+-- So if you call this function, you are expecting the number of DReps to already
+-- be @n@, or to be @n@ before @terminationEpoch@
+checkDRepsNumber' ::
+  (HasCallStack, MonadIO m, MonadTest m)
+  => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs
+  -> NodeConfigFile In
+  -> SocketPath
+  -> EpochNo -- ^ The termination epoch: the constitution proposal must be found *before* this epoch
+  -> Int -- ^ The expected numbers of DReps. If this number is not reached until the termination epoch, this function fails the test.
+  -> m (Maybe [L.DRepState StandardCrypto]) -- ^ The DReps when the expected number of DReps was attained.
+checkDRepsNumber' sbe nodeConfigFile socketPath maxEpoch expectedDRepsNb = do
+  result <- runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing
+      $ \(AnyNewEpochState actualEra newEpochState) -> do
+        case testEquality sbe actualEra of
+          Just Refl -> do
+            let dreps = Map.elems $ shelleyBasedEraConstraints sbe newEpochState
+                      ^. L.nesEsL
+                      . L.esLStateL
+                      . L.lsCertStateL
+                      . L.certVStateL
+                      . L.vsDRepsL
+            if length dreps == expectedDRepsNb then do
+                put $ Just dreps
+                pure ConditionMet
+            else
+                pure ConditionNotMet
+          Nothing -> do
+            error $ "Eras mismatch! expected: " <> show sbe <> ", actual: " <> show actualEra
+  case result of
+    Left (FoldBlocksApplyBlockError (TerminationEpochReached epochNo)) -> do
+      H.note_ $ unlines
+                  [ "waitDRepsNumber: drep number did not become " <> show expectedDRepsNb <> " before termination epoch: " <> show epochNo
+                  , "This is likely an error of this test." ]
+      H.failure
+    Left err -> do
+      H.note_ $ unlines
+                  [ "waitDRepsNumber: could not reach termination epoch: " <> docToString (prettyError err)
+                  , "This is probably an error unrelated to this test." ]
+      H.failure
+    Right (_, val) ->
+      return val

cardano-testnet/src/Testnet/Process/Cli.hs

@@ -126,11 +126,11 @@ cliNodeKeyGen tmpDir vkey skey counter = do
 -- returning JSON to stdout, and needs going through a file instead, probably
 -- you should add a similar function to this one.
 execCliStdoutToJson :: ()
-  => (Aeson.FromJSON a, MonadTest m, MonadCatch m, MonadIO m)
+  => (HasCallStack, Aeson.FromJSON a, MonadTest m, MonadCatch m, MonadIO m)
   => ExecConfig -- ^ The configuration with which to call the CLI
   -> [String] -- ^ The CLI command to execute
   -> m a
-execCliStdoutToJson execConfig cmd = do
+execCliStdoutToJson execConfig cmd = GHC.withFrozenCallStack $ do
   result <- execCli' execConfig cmd
   H.leftFail $ Aeson.eitherDecode $ Data.String.fromString result