Working

cabal.project

@@ -56,3 +56,10 @@ package bitvec
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
 -- `smtp-mail` should depend on `crypton-connection` rather than `connection`!
+
+source-repository-package
+    type: git
+    location: https://github.com/input-output-hk/cardano-api.git
+    tag: 0004fa2ba0a2887129dcf9eb84fdc6e581e54bea
+    subdir: cardano-api
+

cardano-testnet/cardano-testnet.cabal

@@ -164,6 +164,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.Cli.QuerySlotNumber
                         Cardano.Testnet.Test.FoldBlocks
                         Cardano.Testnet.Test.Misc
+                        Cardano.Testnet.Test.Node.LedgerEvents
                         Cardano.Testnet.Test.Node.Shutdown
 
   type:                 exitcode-stdio-1.0
@@ -185,6 +186,7 @@ test-suite cardano-testnet-test
                       , text
                       , time
                       , transformers
+                      , transformers-except
 
   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs

@@ -67,7 +67,8 @@ prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \tempAbsBasePath'
       -- 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 ()
+        let handler :: Env -> LedgerState -> [LedgerEvent] -> BlockInMode CardanoMode -> () -> IO ((), FoldStatus)
+            handler _env _ledgerState _ledgerEvents _blockInCardanoMode _ = IO.putMVar lock () >> return ((), ContinueFold)
         e <- runExceptT (C.foldBlocks (File configFile) (C.File socketPathAbs) C.QuickValidation () handler)
         either (throw . FoldBlocksException) (\_ -> pure ()) e
     link a -- Throw async thread's exceptions in main thread

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Testnet.Test.Node.LedgerEvents
+  ( hprop_ledger_events
+  ) where
+
+import           Cardano.Api
+
+import           Cardano.Testnet
+
+import           Prelude
+
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Except.Extra
+import qualified Data.Text as Text
+import           GHC.IO.Exception (IOException)
+import           GHC.Stack (callStack)
+import           System.FilePath ((</>))
+
+import           Hedgehog
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
+import qualified Hedgehog.Extras.Test.Base as H
+
+import qualified Testnet.Property.Utils as H
+import           Testnet.Runtime
+
+newtype AdditionalCatcher
+  = IOE IOException
+  deriving Show
+
+
+hprop_ledger_events :: Property
+hprop_ledger_events = H.integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tempAbsBasePath' -> do
+  -- Start a local test net
+  conf <- H.noteShowM $  mkConf tempAbsBasePath'
+
+  let fastTestnetOptions = cardanoDefaultTestnetOptions
+        { cardanoEpochLength = 50
+        , cardanoSlotLength = 0.1
+        }
+
+  !testnetRuntime
+    <- cardanoTestnet fastTestnetOptions conf
+  NodeRuntime{nodeSprocket} <- H.headM $ poolRuntime <$> poolNodes testnetRuntime
+  let socketName' = IO.sprocketName nodeSprocket
+      socketBase = IO.sprocketBase nodeSprocket -- /tmp
+      socketPath = socketBase </> socketName'
+
+  H.note_ $ "Sprocket: " <> show nodeSprocket
+  H.note_ $ "Abs path: " <> tempAbsBasePath'
+  H.note_ $ "Socketpath: " <> socketPath
+
+
+  !ret <- runExceptT $ handleIOExceptT IOE
+                   $ runExceptT $ foldBlocks
+                       (File $ configurationFile testnetRuntime)
+                       (File socketPath)
+                       FullValidation
+                       [] -- Initial accumulator state
+                       foldBlocksAccumulator
+  case ret of
+    Left (IOE e) ->
+      H.failMessage callStack $ "foldBlocks failed with: " <> show e
+    Right (Left e) ->
+      H.failMessage callStack $ "foldBlocks failed with: " <> Text.unpack (renderFoldBlocksError e)
+    Right (Right _v) -> success
+
+
+foldBlocksAccumulator
+  :: Env
+  -> LedgerState
+  -> [LedgerEvent]
+  -> BlockInMode CardanoMode -- Block i
+  -> [LedgerEvent] -- ^ Accumulator at block i - 1
+  -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status
+foldBlocksAccumulator _ _ currentEvents _ acc =
+  if any filterPoolReap currentEvents
+  -- TODO: When we switch to a TChan in foldBlocks we won't have to keep track of
+  -- the events ourselves.
+  then return (currentEvents ++ acc, StopFold)
+  else return (currentEvents ++ acc, ContinueFold)
+ where
+  -- We end the fold on PoolReap ledger event
+  filterPoolReap :: LedgerEvent -> Bool
+  filterPoolReap (PoolReap _) = True
+  filterPoolReap _ = False
+
+

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs

@@ -176,6 +176,7 @@ hprop_shutdown = H.integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' ->
 
       return ()
 
+
 hprop_shutdownOnSlotSynced :: Property
 hprop_shutdownOnSlotSynced = H.integrationRetryWorkspace 2 "shutdown-on-slot-synced" $ \tempAbsBasePath' -> do
   -- Start a local test net

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

@@ -10,6 +10,7 @@ import qualified Cardano.Testnet.Test.Cli.Babbage.StakeSnapshot
 import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo
 import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber
 import qualified Cardano.Testnet.Test.FoldBlocks
+import qualified Cardano.Testnet.Test.Node.LedgerEvents
 import qualified Cardano.Testnet.Test.Node.Shutdown
 
 import           Prelude
@@ -26,10 +27,11 @@ import qualified Testnet.Property.Run as H
 tests :: IO TestTree
 tests = pure $ T.testGroup "test/Spec.hs"
   [ T.testGroup "Spec"
-    [  H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown
-    , H.ignoreOnWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint
+    [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown
+    , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.hprop_ledger_events
+     -- H.ignoreOnWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint
     -- ShutdownOnSlotSynced FAILS Still. The node times out and it seems the "shutdown-on-slot-synced" flag does nothing
-    -- , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced
+    , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced
     , T.testGroup "Babbage"
         -- TODO: Babbage --next leadership schedule still fails. Once this fix is propagated to the cli (https://github.com/input-output-hk/cardano-api/pull/274)
         -- this should remedy. Double check and make sure we have re-enabled it and remove this comment.