diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index cf4f6c5a2f6..4b59d7ecaef 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -33,7 +33,9 @@ library , bytestring , cardano-api , cardano-cli + , cardano-crypto-class , cardano-git-rev + , cardano-ledger-byron , cardano-node , containers , directory @@ -103,6 +105,7 @@ test-suite cardano-testnet-tests other-modules: Test.Cli.Alonzo.LeadershipSchedule Test.Cli.Babbage.LeadershipSchedule Test.Cli.KesPeriodInfo + Test.FoldBlocks Test.Misc Test.Node.Shutdown Test.ShutdownOnSlotSynced @@ -110,18 +113,21 @@ test-suite cardano-testnet-tests type: exitcode-stdio-1.0 build-depends: aeson + , async , cardano-api , cardano-cli , cardano-testnet , containers , directory , filepath - , hedgehog + , hedgehog , hedgehog-extras , process , tasty + , tasty-hedgehog , text , time + , transformers other-modules: diff --git a/cardano-testnet/src/Testnet/Cardano.hs b/cardano-testnet/src/Testnet/Cardano.hs index f6d8f1d34b0..84396769768 100644 --- a/cardano-testnet/src/Testnet/Cardano.hs +++ b/cardano-testnet/src/Testnet/Cardano.hs @@ -17,20 +17,26 @@ module Testnet.Cardano , cardanoTestnet ) where -import Prelude +import qualified Cardano.Crypto.Hash.Blake2b +import qualified Cardano.Crypto.Hash.Class import Control.Monad -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Except import Data.Aeson ((.=)) +import qualified Data.ByteString as BS import Data.ByteString.Lazy (ByteString) import Data.List ((\\)) import Data.Maybe import Data.String +import qualified Hedgehog as H import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..)) import Hedgehog.Extras.Stock.Time (formatIso8601, showUTCTimeSeconds) import Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..)) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) +import Prelude import System.FilePath.Posix (()) +import Cardano.Chain.Genesis (GenesisHash (unGenesisHash), readGenesisData) import qualified Cardano.Node.Configuration.Topology as NonP2P import qualified Cardano.Node.Configuration.TopologyP2P as P2P import qualified Data.Aeson as J @@ -52,8 +58,8 @@ import qualified System.Info as OS import qualified Util.Assert as H import qualified Util.Process as H import Util.Process (execCli_) -import Util.Runtime as TR (NodeLoggingFormat (..), PaymentKeyPair (..), PoolNode (PoolNode), - PoolNodeKeys (..), TestnetRuntime (..), startNode) +import Util.Runtime as TR (NodeLoggingFormat (..), PaymentKeyPair (..), + PoolNode (PoolNode), PoolNodeKeys (..), TestnetRuntime (..), startNode) import qualified Testnet.Conf as H @@ -706,6 +712,15 @@ cardanoTestnet testnetOptions H.Conf {..} = do -- Generated a signed 'do it all' transaction: H.assertIO . IO.doesFileExist $ tempAbsPath "tx1.tx" + -- Add Byron, Shelley and Alonzo genesis hashes to node configuration + byronGenesisHash <- getByronGenesisHash $ tempAbsPath "byron/genesis.json" + shelleyGenesisHash <- getShelleyGenesisHash $ tempAbsPath "shelley/genesis.json" + alonzoGenesisHash <- getShelleyGenesisHash $ tempAbsPath "shelley/genesis.alonzo.json" + H.rewriteYamlFile (tempAbsPath "configuration.yaml") . J.rewriteObject + $ HM.insert "ByronGenesisHash" byronGenesisHash + . HM.insert "ShelleyGenesisHash" shelleyGenesisHash + . HM.insert "AlonzoGenesisHash" alonzoGenesisHash + -------------------------------- -- Launch cluster of three nodes @@ -761,3 +776,18 @@ cardanoTestnet testnetOptions H.Conf {..} = do , wallets , delegators = [] -- TODO this should be populated } + +-- * Generate hashes for genesis.json files + +getByronGenesisHash :: (H.MonadTest m, MonadIO m) => FilePath -> m J.Value +getByronGenesisHash path = do + e <- runExceptT $ readGenesisData path + (_, genesisHash) <- H.leftFail e + let genesisHash' = J.toJSON $ unGenesisHash genesisHash + pure genesisHash' + +getShelleyGenesisHash :: (H.MonadTest m, MonadIO m) => FilePath -> m J.Value +getShelleyGenesisHash path = do + content <- liftIO $ BS.readFile path + let genesisHash = Cardano.Crypto.Hash.Class.hashWith id content :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 BS.ByteString + pure $ J.toJSON genesisHash diff --git a/cardano-testnet/test/Main.hs b/cardano-testnet/test/Main.hs index 40e2d94fe38..23b161b73aa 100644 --- a/cardano-testnet/test/Main.hs +++ b/cardano-testnet/test/Main.hs @@ -14,6 +14,7 @@ import qualified Test.Tasty.Ingredients as T --import qualified Test.Cli.Alonzo.LeadershipSchedule import qualified Test.Cli.Babbage.LeadershipSchedule import qualified Test.Cli.KesPeriodInfo +import qualified Test.FoldBlocks import qualified Test.Node.Shutdown import qualified Test.ShutdownOnSlotSynced import qualified Util.Ignore as H @@ -35,6 +36,7 @@ tests = pure $ T.testGroup "test/Spec.hs" -- TODO: Babbage temporarily ignored due to broken protocol-state query , H.disabled "kes-period-info" Test.Cli.KesPeriodInfo.hprop_kes_period_info ] + , Test.FoldBlocks.tests ] ingredients :: [T.Ingredient] diff --git a/cardano-testnet/test/Test/FoldBlocks.hs b/cardano-testnet/test/Test/FoldBlocks.hs new file mode 100644 index 00000000000..f5db5b25ba8 --- /dev/null +++ b/cardano-testnet/test/Test/FoldBlocks.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.FoldBlocks where + +import qualified Control.Concurrent as IO +import Control.Concurrent.Async (async, link) +import Control.Exception (Exception, throw) +import Control.Monad (forever) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (runExceptT) +import qualified Data.Text as TS +import Prelude +import qualified System.Directory as IO +import System.FilePath (()) + +import qualified Hedgehog as H +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as HE +import qualified Hedgehog.Extras.Test as HE +import qualified Hedgehog.Extras.Test.Base as H +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testPropertyNamed) + +import qualified Cardano.Api as C +import qualified Testnet.Cardano as TN +import qualified Testnet.Conf as TC (Conf (..), ProjectBase (ProjectBase), + YamlFilePath (YamlFilePath), mkConf) +import qualified Util.Base as U +import qualified Util.Runtime as U + + +newtype FoldBlocksException = FoldBlocksException C.FoldBlocksError +instance Exception FoldBlocksException +instance Show FoldBlocksException where + show (FoldBlocksException a) = TS.unpack $ C.renderFoldBlocksError a + +tests :: TestTree +tests = testGroup "FoldBlocks" + [ testPropertyNamed "foldBlocks receives ledger state" "prop_foldBlocks_fails" prop_foldBlocks + ] + +-- | This test starts a testnet with wery short timing, then starts +-- `foldBlocks` in another thread to listen for ledger state, ledger +-- events and block, and on reception writes this to the `lock` `MVar` +-- that main thread blocks on. +prop_foldBlocks :: H.Property +prop_foldBlocks = U.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsBasePath' -> do + + -- Start testnet + base <- HE.noteM $ liftIO . IO.canonicalizePath =<< HE.getProjectBase + configurationTemplate <- H.noteShow $ base "configuration/defaults/byron-mainnet/configuration.yaml" + conf <- HE.noteShowM $ + TC.mkConf (TC.ProjectBase base) (TC.YamlFilePath configurationTemplate) + (tempAbsBasePath' <> "/") + Nothing + + let options = TN.defaultTestnetOptions + -- NB! The `activeSlotsCoeff` value is very important for + -- chain extension for the two-node/one-pool testnet that + -- `defaultTestnetOptions` define. The default 0.2 often fails + -- to extend the chain in a reasonable time (< 90s, e.g as the + -- deadline is defined in Testnet.Cardano). + { TN.activeSlotsCoeff = 0.9 } + runtime <- TN.cardanoTestnet options conf + + -- Get socketPath + socketPathAbs <- do + socketPath' <- HE.sprocketArgumentName <$> HE.headM (U.nodeSprocket <$> TN.bftNodes runtime) + H.note =<< liftIO (IO.canonicalizePath $ TC.tempAbsPath conf socketPath') + + configurationFile <- H.noteShow $ TC.tempAbsPath conf "configuration.yaml" + + -- Start foldBlocks in a separate thread + lock <- liftIO IO.newEmptyMVar + liftIO $ do + a <- async $ + -- The `forever` is here because `foldBlocks` drains blocks + -- until current slot and then quits -- even if there are no + -- permanent (= older than the k parameter) blocks created. In + -- that case we simply restart `foldBlocks` again. + forever $ do + let handler _env _ledgerState _ledgerEvents _blockInCardanoMode _ = IO.putMVar lock () + e <- runExceptT (C.foldBlocks configurationFile socketPathAbs C.QuickValidation () handler) + either (throw . FoldBlocksException) (\_ -> pure ()) e + link a -- Throw async thread's exceptions in main thread + + -- The `lock` is written to from within the `handler` above. It + -- tests that `foldBlocks` receives ledger state; once that happens, + -- handler is called, which then writes to the `lock` and allows the + -- test to finish. + _ <- liftIO $ IO.readMVar lock + H.assert True