Merge pull request IntersectMBO#5523 from input-output-hk/jordan/init…

…ial-ledger-events-integration

Initial ledger events integration into cardano-testnet

cardano-testnet/cardano-testnet.cabal

@@ -165,6 +165,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
@@ -186,6 +187,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/Node/LedgerEvents.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Testnet.Test.Node.LedgerEvents
+  ( hprop_ledger_events_sanity_check
+  ) 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
+
+-- Ledger events can be emitted upon the application of the various ledger rules.
+-- Event definition example: https://github.com/input-output-hk/cardano-ledger/blob/afedb7d519761ccdd9c013444aa4b3e0bf0e68ef/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs#L198
+-- Event emission: https://github.com/input-output-hk/cardano-ledger/blob/afedb7d519761ccdd9c013444aa4b3e0bf0e68ef/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs#L389
+-- We can directly access these events via `foldBlocks` exposed by cardano-api. In the normal operation of a node, these events are ignored
+-- (see: https://github.com/input-output-hk/ouroboros-consensus/commit/c1abf51948a673a2bbd540e5b7929ce1f07c108e#diff-4274b4c9494fc060b0980695df1b5de3412eccd31cd10c77836ef5bc66e40dd8R123) however a node's client
+-- that is requesting blocks can reconstruct the ledger state and access the ledger events via `tickThenApplyLedgerResult`. This is what
+-- `foldBlocks` does. Below is a simple test that illustrates `foldBlocks` pattern matching on the RetiredPools event (https://github.com/input-output-hk/cardano-ledger/blob/afedb7d519761ccdd9c013444aa4b3e0bf0e68ef/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs#L177).
+-- This sets the stage for more direct testing of clusters allowing us to avoid querying the node, dealing with serialization to and from disk,
+-- setting timeouts for expected results etc.
+hprop_ledger_events_sanity_check :: Property
+hprop_ledger_events_sanity_check = H.integrationRetryWorkspace 2 "ledger-events-sanity-check" $ \tempAbsBasePath' -> do
+  -- Start a local test net
+  conf <- H.noteShowM $  mkConf tempAbsBasePath'
+
+  let fastTestnetOptions = cardanoDefaultTestnetOptions
+        { cardanoEpochLength = 100
+        , 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 -- Block i
+  -> [LedgerEvent] -- ^ Accumulator at block i - 1
+  -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status
+foldBlocksAccumulator _ _ allEvents _ _ =
+  if any filterPoolReap allEvents
+  then return (allEvents , StopFold)
+  else return ([], 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

@@ -177,6 +177,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,7 +27,8 @@ 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 "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown
+    , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.hprop_ledger_events_sanity_check
     , 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