Merge branch 'master' of github.com:IntersectMBO/cardano-node into zl…

…iu41/880pre

.github/workflows/github-page.yml

@@ -63,4 +63,5 @@ jobs:
       with:
         github_token: ${{ secrets.GITHUB_TOKEN || github.token }}
         publish_dir: haddocks
+        cname: cardano-node.cardano.intersectmbo.org
         force_orphan: true

cabal.project

@@ -64,13 +64,13 @@ package plutus-scripts-bench
 source-repository-package
     type: git
     location: https://github.com/IntersectMBO/cardano-api.git
-    tag: dbdaa3ebe2916b13a234ebdedf23d919d5e1b3ea
+    tag: 3388849f3e935576265dc2d3d2ee3427a383c264
     subdir: cardano-api
-    --sha256: sha256-Ol1eb88uafxqew+wuKdbTF4EKQ7Mvvgr4NHJnmqs78w=
+    --sha256: sha256-7W500dNvyiQ9gkgXPEm6jEiJFq0vyGXgGm3zWwdmBqM=
 
 source-repository-package
     type: git
     location: https://github.com/IntersectMBO/cardano-cli.git
-    tag: 2bef81e2d3a9c0c3094936d3c1e3606179108836
+    tag: a6be51c2a4581ac08b248d18d6cb878e6d7ef457
     subdir: cardano-cli
-    --sha256: sha256-LBIJ0TRu4P82qDNvyf5I3SBghHbCPsv6+olY1IY5rBc=
+    --sha256: sha256-y0sYas9XEQauCDevnCCVxGPp6D7Mzl9MVwVerEGVBXI=

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

@@ -10,12 +10,11 @@ module Testnet.Components.Configuration
   , numSeededUTxOKeys
   ) where
 
+import           Cardano.Api.Pretty
 import           Cardano.Api.Shelley hiding (cardanoEra)
-
 import qualified Cardano.Node.Configuration.Topology as NonP2P
 import qualified Cardano.Node.Configuration.TopologyP2P as P2P
 import           Cardano.Node.Types
-import           Data.Bifunctor
 import           Ouroboros.Network.PeerSelection.LedgerPeers
 import           Ouroboros.Network.PeerSelection.RelayAccessPoint
 import           Ouroboros.Network.PeerSelection.State.LocalRootPeers
@@ -25,12 +24,16 @@ import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.IO.Class (MonadIO)
 import           Data.Aeson
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Lens as L
+import           Data.Bifunctor
 import qualified Data.ByteString.Lazy as LBS
+import           Data.Char (toLower)
 import qualified Data.List as List
 import           Data.String
 import           Data.Time
 import           GHC.Stack (HasCallStack)
 import qualified GHC.Stack as GHC
+import           Lens.Micro
 import           System.FilePath.Posix (takeDirectory, (</>))
 
 import           Hedgehog
@@ -39,9 +42,6 @@ import qualified Hedgehog.Extras.Stock.Time as DTC
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 
-import qualified Data.Aeson.Lens as L
-import           Lens.Micro
-
 import           Testnet.Defaults
 import           Testnet.Filepath
 import           Testnet.Process.Run (execCli_)
@@ -208,12 +208,4 @@ mkTopologyConfig numNodes allPorts port True = Aeson.encode topologyP2P
 
 
 convertToEraString :: AnyCardanoEra -> String
-convertToEraString (AnyCardanoEra e) =
-  case e of
-    ConwayEra -> "conway"
-    BabbageEra -> "babbage"
-    AlonzoEra -> "alonzo"
-    MaryEra -> "mary"
-    AllegraEra -> "allegra"
-    ShelleyEra -> "shelley"
-    ByronEra -> "byron"
+convertToEraString = map toLower . docToString . pretty

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

@@ -41,13 +41,11 @@ checkStakePoolRegistered
   => TmpAbsolutePath
   -> ExecConfig
   -> FilePath -- ^ Stake pool cold verification key file
-  -> CardanoTestnetOptions
   -> FilePath -- ^ Output file path of stake pool info
   -> m String -- ^ Stake pool ID
-checkStakePoolRegistered tempAbsP execConfig poolColdVkeyFp cTestnetOpts outputFp =
+checkStakePoolRegistered tempAbsP execConfig poolColdVkeyFp outputFp =
   GHC.withFrozenCallStack $ do
     let tempAbsPath' = unTmpAbsPath tempAbsP
-        testnetMag = cardanoTestnetMagic cTestnetOpts
         oFpAbs = tempAbsPath' </> outputFp
 
     stakePoolId' <- filter ( /= '\n') <$>
@@ -58,7 +56,6 @@ checkStakePoolRegistered tempAbsP execConfig poolColdVkeyFp cTestnetOpts outputF
     -- Check to see if stake pool was registered
     void $ execCli' execConfig
       [ "query", "stake-pools"
-      , "--testnet-magic", show @Int testnetMag
       , "--out-file", oFpAbs
       ]
 
@@ -78,14 +75,12 @@ checkStakeKeyRegistered
   :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => TmpAbsolutePath
   -> ExecConfig
-  -> CardanoTestnetOptions
   -> String -- ^ Stake address
   -> FilePath -- ^ Output file path of stake address info
   -> m DelegationsAndRewards
-checkStakeKeyRegistered tempAbsP execConfig cTestnetOpts stakeAddr outputFp  =
+checkStakeKeyRegistered tempAbsP execConfig stakeAddr outputFp  =
   GHC.withFrozenCallStack $ do
     let tempAbsPath' = unTmpAbsPath tempAbsP
-        testnetMag = cardanoTestnetMagic cTestnetOpts
         oFpAbs = tempAbsPath' </> outputFp
 
     sAddr <- case deserialiseAddress AsStakeAddress $ Text.pack stakeAddr of
@@ -95,7 +90,6 @@ checkStakeKeyRegistered tempAbsP execConfig cTestnetOpts stakeAddr outputFp  =
     void $ execCli' execConfig
       [ "query", "stake-address-info"
       , "--address", stakeAddr
-      , "--testnet-magic", show @Int testnetMag
       , "--out-file", oFpAbs
       ]
 
@@ -273,7 +267,6 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
   void $ execCli' execConfig
     [ "transaction", "build"
     , eraFlag
-    , "--testnet-magic", show @Int testnetMag
     , "--change-address", changeAddr
     , "--tx-in", Text.unpack $ renderTxIn fundingInput
     , "--tx-out", poolowneraddresswstakecred <> "+" <> show @Int 5_000_000
@@ -300,7 +293,6 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
   void $ execCli' execConfig
            [ "transaction", "submit"
            , "--tx-file", pledgeAndPoolRegistrationTx
-           , "--testnet-magic", show @Int testnetMag
            ]
   -- TODO: Currently we can't propagate the error message thrown by checkStakeKeyRegistered when using byDurationM
   -- Instead we wait 15 seconds
@@ -310,7 +302,6 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
     checkStakeKeyRegistered
       tap
       execConfig
-      cTestnetOptions
       poolownerstakeaddr
       ("spo-"<> show identifier <> "-requirements" </> "pledger.stake.info")
 
@@ -324,7 +315,6 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') cTestnetOptions
               tap
               execConfig
               poolColdVkeyFp
-              cTestnetOptions
               currentRegistedPoolsJson
   return (poolId, poolColdSkeyFp, poolColdVkeyFp, vrfSkeyFp, vrfVkeyFp)
 

cardano-testnet/src/Testnet/Filepath.hs

@@ -4,7 +4,6 @@
 
 module Testnet.Filepath
   ( TmpAbsolutePath(..)
-  , makeDbDir
   , makeLogDir
   , makeSocketDir
   , makeSprocket
@@ -19,8 +18,6 @@ import           System.FilePath
 import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
 
 
-
-
 makeSprocket
   :: TmpAbsolutePath
   -> String -- ^ node name
@@ -40,10 +37,7 @@ makeSocketDir :: TmpAbsolutePath -> FilePath
 makeSocketDir fp = makeTmpRelPath fp </> "socket"
 
 makeTmpBaseAbsPath :: TmpAbsolutePath -> FilePath
-makeTmpBaseAbsPath (TmpAbsolutePath fp) = takeDirectory fp
+makeTmpBaseAbsPath (TmpAbsolutePath fp) = addTrailingPathSeparator $ takeDirectory fp
 
 makeLogDir :: TmpAbsolutePath -> FilePath
-makeLogDir (TmpAbsolutePath fp) = fp </> "logs"
-
-makeDbDir :: Int -> TmpAbsolutePath -> FilePath
-makeDbDir nodeNumber (TmpAbsolutePath fp) = fp </> "db/node-" </> show nodeNumber
+makeLogDir (TmpAbsolutePath fp) = addTrailingPathSeparator $ fp </> "logs"

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

@@ -146,13 +146,15 @@ mkExecConfig :: ()
   => MonadIO m
   => FilePath
   -> IO.Sprocket
+  -> Int -- ^ Network id
   -> m ExecConfig
-mkExecConfig tempBaseAbsPath sprocket = do
+mkExecConfig tempBaseAbsPath sprocket networkId = do
   env' <- H.evalIO IO.getEnvironment
 
   noteShow H.ExecConfig
     { H.execConfigEnv = Last $ Just $
       [ ("CARDANO_NODE_SOCKET_PATH", IO.sprocketArgumentName sprocket)
+      , ("CARDANO_NODE_NETWORK_ID", show networkId)
       ]
       -- The environment must be passed onto child process on Windows in order to
       -- successfully start that process.
@@ -186,9 +188,6 @@ resourceAndIOExceptionHandlers = [ Handler $ return . ProcessIOException
                                  ]
 
 
-
-
-
 procFlexNew
   :: String
   -- ^ Cabal package name corresponding to the executable

cardano-testnet/src/Testnet/Property/Checks.hs

@@ -39,12 +39,10 @@ prop_spos_in_ledger_state
   -> m ()
 prop_spos_in_ledger_state output tNetOptions execConfig =
   GHC.withFrozenCallStack $ do
-    let testnetMag = cardanoTestnetMagic tNetOptions
-        numExpectedPools = length $ cardanoNodes tNetOptions
+    let numExpectedPools = length $ cardanoNodes tNetOptions
 
     void $ execCli' execConfig
         [ "query", "stake-pools"
-        , "--testnet-magic", show @Int testnetMag
         , "--out-file", output
         ]
 

cardano-testnet/src/Testnet/Property/Utils.hs

@@ -21,7 +21,6 @@ module Testnet.Property.Utils
   ) where
 
 import           Cardano.Api
-
 import           Cardano.Chain.Genesis (GenesisHash (unGenesisHash), readGenesisData)
 import           Cardano.CLI.Types.Output
 import qualified Cardano.Crypto.Hash.Blake2b as Crypto
@@ -104,7 +103,6 @@ waitUntilEpoch fp testnetMagic execConfig desiredEpoch = do
 
   void $ H.execCli' execConfig
     [ "query",  "tip"
-    , "--testnet-magic", show @Int testnetMagic
     , "--out-file", fp
     ]
 
@@ -124,17 +122,14 @@ queryTip
   :: (MonadCatch m, MonadIO m, MonadTest m, HasCallStack)
   => QueryTipOutput
   -- ^ Output file
-  -> Int
-  -- ^ Testnet magic
   -> ExecConfig
   -> m QueryTipLocalStateOutput
-queryTip (QueryTipOutput fp) testnetMag execConfig = do
+queryTip (QueryTipOutput fp) execConfig = do
   exists <- H.evalIO $ doesFileExist fp
   when exists $ H.evalIO $ removeFile fp
 
   void $ H.execCli' execConfig
     [ "query",  "tip"
-    , "--testnet-magic", show @Int testnetMag
     , "--out-file", fp
     ]
 

cardano-testnet/src/Testnet/Runtime.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Testnet.Runtime
   ( LeadershipSlot(..)
@@ -26,11 +27,12 @@ module Testnet.Runtime
   , shelleyGenesis
   , getStartTime
   , fromNominalDiffTimeMicro
+  , startLedgerStateLogging
   ) where
 
 import           Cardano.Api
+import qualified Cardano.Api as Api
 import           Cardano.Api.Pretty
-
 import qualified Cardano.Chain.Genesis as G
 import           Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic (..))
 import           Cardano.Ledger.Crypto (StandardCrypto)
@@ -39,10 +41,9 @@ import           Cardano.Node.Configuration.POM
 import qualified Cardano.Node.Protocol.Byron as Byron
 import           Cardano.Node.Types
 
-import           Prelude
-
-import           Control.Exception
+import           Control.Exception.Safe
 import           Control.Monad
+import qualified Control.Monad.Class.MonadTimer.SI as MT
 import           Control.Monad.Error.Class
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class (lift)
@@ -57,23 +58,25 @@ import           GHC.Generics (Generic)
 import qualified GHC.IO.Handle as IO
 import           GHC.Stack
 import qualified GHC.Stack as GHC
+import           Prelude
+import           Prettyprinter ((<+>))
 import qualified System.Directory as IO
 import           System.FilePath
 import qualified System.IO as IO
 import qualified System.Process as IO
 
+import           Hedgehog (MonadTest)
 import qualified Hedgehog as H
 import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
-import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H
+import qualified Hedgehog.Extras.Test.Base as H
+import qualified Hedgehog.Extras.Test.Concurrent as H
 
 import           Testnet.Filepath
+import qualified Testnet.Ping as Ping
 import           Testnet.Process.Run
 import           Testnet.Start.Types
 
-import qualified Control.Monad.Class.MonadTimer.SI as MT
-import           Prettyprinter ((<+>))
-import qualified Testnet.Ping as Ping
-
 data TestnetRuntime = TestnetRuntime
   { configurationFile :: FilePath
   , shelleyGenesisFile :: FilePath
@@ -210,17 +213,17 @@ startNode tp node port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
   hNodeStdout <- handleIOExceptT FileRelatedFailure $ IO.openFile nodeStdoutFile IO.WriteMode
   hNodeStderr <- handleIOExceptT FileRelatedFailure $ IO.openFile nodeStderrFile IO.ReadWriteMode
 
-  unless (List.length (IO.sprocketArgumentName sprocket) <= IO.maxSprocketArgumentNameLength) $
+  unless (List.length (H.sprocketArgumentName sprocket) <= H.maxSprocketArgumentNameLength) $
      left MaxSprocketLengthExceededError
 
   let portString = show port
-      socketAbsPath = IO.sprocketSystemName sprocket
+      socketAbsPath = H.sprocketSystemName sprocket
 
   nodeProcess
     <- firstExceptT ExecutableRelatedFailure
          $ hoistExceptT lift $ procNode $ mconcat
                        [ nodeCmd
-                       , [ "--socket-path", IO.sprocketArgumentName sprocket
+                       , [ "--socket-path", H.sprocketArgumentName sprocket
                          , "--port", portString
                          ]
                        ]
@@ -278,7 +281,6 @@ createDirectoryIfMissingNew_ :: HasCallStack => FilePath -> IO ()
 createDirectoryIfMissingNew_ directory = GHC.withFrozenCallStack $
   void $ createDirectoryIfMissingNew directory
 
-
 createSubdirectoryIfMissingNew :: ()
   => HasCallStack
   => FilePath
@@ -287,3 +289,36 @@ createSubdirectoryIfMissingNew :: ()
 createSubdirectoryIfMissingNew parent subdirectory = GHC.withFrozenCallStack $ do
   IO.createDirectoryIfMissing True $ parent </> subdirectory
   pure subdirectory
+
+-- | Start ledger state logging for the first node in the background.
+-- Logs will be placed in <tmp workspace directory>/logs/ledger-state.log
+-- The logging thread will be cancelled when `MonadResource` releases all resources.
+startLedgerStateLogging
+  :: forall m. MonadCatch m
+  => MonadResource m
+  => MonadTest m
+  => TestnetRuntime
+  -> FilePath -- ^ tmp workspace directory
+  -> m ()
+startLedgerStateLogging testnetRuntime tmpWorkspace = do
+  socketPath <- H.noteM $ H.sprocketSystemName <$> H.headM (poolSprockets testnetRuntime)
+  let logFile = makeLogDir (TmpAbsolutePath tmpWorkspace) </> "ledger-state.log"
+  _ <- runInBackground . runExceptT $
+    foldBlocks
+      (File $ configurationFile testnetRuntime)
+      (Api.File socketPath)
+      Api.QuickValidation
+      ()
+      (handler logFile)
+  pure ()
+  where
+    -- handler :: FilePath -> Env -> LedgerState -> [LedgerEvent] -> BlockInMode -> () -> IO ((), FoldStatus)
+    handler outputFp _ ledgerState _ _ _ = do
+      appendFile outputFp $ "#### BLOCK ####" <> "\n"
+      appendFile outputFp $ show ledgerState <> "\n"
+      pure ((), ContinueFold)
+    -- | Runs an action in background, and registers cleanup to `MonadResource m`
+    -- The argument forces IO monad to prevent leaking of `MonadResource` to the child thread
+    runInBackground :: IO a -> m ()
+    runInBackground act = void $ allocate (H.async act) H.cancel
+