Add test for --shutdown-on-slot-synced

cardano-testnet/cardano-testnet.cabal

@@ -125,6 +125,7 @@ test-suite cardano-testnet-tests
                         -- Spec.Plutus.Script.TxInLockingPlutus
                         -- Spec.Plutus.SubmitApi.TxInLockingPlutus
                         Spec.Shutdown
+                        Spec.ShutdownOnSlotSynced
                         Test.Util
 
   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T

cardano-testnet/test/Main.hs

@@ -16,6 +16,7 @@ import           Test.Tasty (TestTree)
 -- import qualified Spec.Plutus.Script.TxInLockingPlutus
 -- import qualified Spec.Plutus.SubmitApi.TxInLockingPlutus
 import qualified Spec.Shutdown
+import qualified Spec.ShutdownOnSlotSynced
 import qualified System.Environment as E
 import qualified Test.Tasty as T
 import qualified Test.Tasty.Ingredients as T
@@ -36,6 +37,7 @@ tests = do
      --  , H.ignoreOnWindows "Plutus.Direct.ScriptContextEqualityMint" Spec.Plutus.Direct.ScriptContextEqualityMint.hprop_plutus_script_context_mint_equality
         -- There is a blocking call on Windows that prevents graceful shutdown and we currently aren't testing the shutdown IPC flag.
         H.ignoreOnWindows "Shutdown" Spec.Shutdown.hprop_shutdown
+      , H.ignoreOnWindows "ShutdownOnSlotSynced" Spec.ShutdownOnSlotSynced.hprop_shutdownOnSlotSynced
       ]
     ]
 

cardano-testnet/test/Spec/ShutdownOnSlotSynced.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+{-# OPTIONS_GHC -Wwarn #-}
+
+module Spec.ShutdownOnSlotSynced
+  ( hprop_shutdownOnSlotSynced
+  ) where
+
+import           Control.Monad
+import           Data.Bool ((&&))
+import           Data.Either (Either (Right), isRight)
+import           Data.Function
+import           Data.Int
+import           Data.List (find, isInfixOf, lines, reverse, words, (++))
+import           Data.Maybe
+import           Data.Ord
+import           GHC.IO.Exception (ExitCode (ExitSuccess))
+import           GHC.Num
+import           Hedgehog (Property, assert, (===))
+import           Prelude (fromIntegral, round)
+import           Text.Read (readMaybe)
+import           Text.Show (Show (..))
+
+import qualified Hedgehog.Extras.Test.Base as H
+import qualified Hedgehog.Extras.Test.File as H
+import qualified Hedgehog.Extras.Test.Process as H
+import qualified Test.Base as H
+import           Testnet.Cardano (TestnetNode (..), TestnetNodeOptions (TestnetNodeOptions),
+                   TestnetOptions (..), TestnetRuntime (..), defaultTestnetNodeOptions,
+                   defaultTestnetOptions, testnet)
+import qualified Testnet.Cardano as TC
+import qualified Testnet.Conf as H
+
+hprop_shutdownOnSlotSynced :: Property
+hprop_shutdownOnSlotSynced = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsBasePath' -> do
+  -- Start a local test net
+  conf <- H.noteShowM $ H.mkConf tempAbsBasePath' Nothing
+  let maxSlot = 1500
+      slotLen = 0.01
+  let fastTestnetOptions = defaultTestnetOptions
+        { epochLength = 300
+        , slotLength = slotLen
+        , bftNodeOptions =
+          [ TestnetNodeOptions
+              { TC.extraNodeCliArgs = ["--shutdown-on-slot-synced", show maxSlot]
+              }
+          , defaultTestnetNodeOptions
+          , defaultTestnetNodeOptions
+          ]
+        }
+  TC.TestnetRuntime { bftNodes = node:_ } <- testnet fastTestnetOptions conf
+
+  -- Wait for the node to exit
+  let timeout :: Int
+      timeout = round (30 + (fromIntegral maxSlot * slotLen))
+  mExitCodeRunning <- H.waitSecondsForProcess timeout (nodeProcessHandle node)
+
+  -- Check results
+  when (isRight mExitCodeRunning) $ do
+    H.cat (nodeStdout node)
+    H.cat (nodeStderr node)
+  mExitCodeRunning === Right ExitSuccess
+  log <- H.readFile (nodeStdout node)
+  slotTip <- case find (isInfixOf "Closed db with immutable tip") (reverse (lines log)) of
+    Nothing -> fail "Could not find current tip in node's log."
+    Just line -> case listToMaybe (reverse (words line)) of
+      Nothing -> fail "Impossible"
+      Just lastWord -> case readMaybe @Integer lastWord of
+        Nothing -> fail ("Expected a node tip as the last word of the log line, but got: " ++ line)
+        Just slotTip -> H.noteShow slotTip
+
+  let epsilon = 50
+  assert (maxSlot <= slotTip && slotTip <= maxSlot + epsilon)
+  return ()