From 746038cbd7788b5359b7ab7e2cb3b9621efa7382 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 23 May 2024 10:30:15 -0400 Subject: [PATCH] Output the diffs between epoch state transitions in startLedgerNewEpochStateLogging --- cardano-testnet/cardano-testnet.cabal | 1 + cardano-testnet/src/Testnet/Property/Util.hs | 2 +- cardano-testnet/src/Testnet/Runtime.hs | 113 ++++++++++++++++-- .../Cardano/Testnet/Test/Gov/NoConfidence.hs | 1 - 4 files changed, 105 insertions(+), 12 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 2d9ab117aa9..25269537079 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -57,6 +57,7 @@ library , containers , contra-tracer , data-default-class + , Diff , directory , exceptions , filepath diff --git a/cardano-testnet/src/Testnet/Property/Util.hs b/cardano-testnet/src/Testnet/Property/Util.hs index 103199cd63a..18126a51ac1 100644 --- a/cardano-testnet/src/Testnet/Property/Util.hs +++ b/cardano-testnet/src/Testnet/Property/Util.hs @@ -71,7 +71,7 @@ runInBackground :: MonadTest m runInBackground act = void . H.evalM $ allocate (H.async act) cleanUp where cleanUp :: H.Async a -> IO () - cleanUp a = H.cancel a >> void (H.link a) + cleanUp a = H.cancel a >> H.link a decodeEraUTxO :: (IsShelleyBasedEra era, MonadTest m) => ShelleyBasedEra era -> Aeson.Value -> m (UTxO era) decodeEraUTxO _ = H.jsonErrorFail . Aeson.fromJSON diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index 2882a31dc3c..131a1b58e38 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} @@ -6,7 +5,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -23,15 +21,21 @@ import qualified Cardano.Ledger.Shelley.LedgerState as L import Prelude +import Control.Concurrent import Control.Exception.Safe import Control.Monad -import Control.Monad.State.Strict (StateT) +import Control.Monad.State.Strict import Control.Monad.Trans.Resource import Data.Aeson import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Algorithm.Diff +import Data.Algorithm.DiffOutput import qualified Data.ByteString.Lazy.Char8 as BSC +import Data.Function import qualified Data.List as List import Data.Text (Text, unpack) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text import GHC.Stack import qualified GHC.Stack as GHC import Network.Socket (PortNumber) @@ -180,7 +184,12 @@ createSubdirectoryIfMissingNew parent subdirectory = GHC.withFrozenCallStack $ d pure subdirectory -- | Start ledger's new epoch state logging for the first node in the background. --- Logs will be placed in /logs/ledger-new-epoch-state.log +-- Pretty JSON logs will be placed in: +-- 1. /logs/ledger-new-epoch-state.log +-- 2. /logs/ledger-new-epoch-state-diffs.log +-- NB: The diffs represent the the changes in the 'NewEpochState' between each +-- block or turn of the epoch. We have excluded the 'stashedAVVMAddresses' +-- field of 'NewEpochState' in the JSON rendering. -- The logging thread will be cancelled when `MonadResource` releases all resources. -- Idempotent. startLedgerNewEpochStateLogging @@ -215,14 +224,30 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac Api.QuickValidation (EpochNo maxBound) () - (\epochState _ _ -> handler logFile epochState) + (\epochState _ _ -> + liftIO $ evalStateT (handler logFile epochState) 0 + ) H.note_ $ "Started logging epoch states to: " <> logFile + + -- In order to create a diff of the epoch state logging file contents + -- we must do so when the resources are deallocated (see runInBackground) + -- and therefore when the log file is no longer in use. + void . H.evalM $ allocate (pure ()) $ \_ -> do + isFileReadableLoop logFile >>= \case + False -> error "isFileReadableLoop: Impossible" + True -> do + logFileContents <- IO.readFile logFile + let epochStateValues = epochStateBeforeAfterValues logFileContents + epochStateDiffs' = epochStateDiffs epochStateValues + Text.writeFile (logDir "ledger-epoch-state-diffs.log") epochStateDiffs' + where - handler :: FilePath -> AnyNewEpochState -> StateT () IO LedgerStateCondition - handler outputFp (AnyNewEpochState sbe nes) = handleException . liftIO $ do - appendFile outputFp $ "#### BLOCK ####" <> "\n" - appendFile outputFp $ BSC.unpack (shelleyBasedEraConstraints sbe $ encodePretty nes) <> "\n" - pure ConditionNotMet + handler :: FilePath -> AnyNewEpochState -> StateT Int IO LedgerStateCondition + handler outputFp (AnyNewEpochState sbe nes) = do + handleException . liftIO $ do + appendFile outputFp $ "#### BLOCK ####" <> "\n" + appendFile outputFp $ BSC.unpack (shelleyBasedEraConstraints sbe $ encodePretty nes) <> "\n" + pure ConditionNotMet where -- | Handle all sync exceptions and log them into the log file. We don't want to fail the test just -- because logging has failed. @@ -231,6 +256,74 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac <> displayException e <> "\n" pure ConditionMet +-- TODO: I hate this. Is there a better way to do this without +-- reaching for concurrency primitives? +isFileReadableLoop :: FilePath -> IO Bool +isFileReadableLoop fp = do + threadDelay 100000 + isFileReadable fp >>= \case + True -> return True + False -> isFileReadableLoop fp + +isFileReadable :: FilePath -> IO Bool +isFileReadable fp = IO.withFile fp IO.ReadMode $ \h -> IO.hIsReadable h + +-- | Produce tuples that represent the change of the 'NewEpochState' after +-- a transition. +epochStateBeforeAfterValues + :: String + -> [(Text, Text)] +epochStateBeforeAfterValues logFileContents = + let allEpochStates = filter (/= "") . Text.splitOn "#### BLOCK ####" $ Text.pack logFileContents + in getAllTransitions allEpochStates + +getAllTransitions :: [Text] -> [(Text, Text)] +getAllTransitions [] = [] +getAllTransitions trans = + let (singleTransition, rest) = splitAt 2 trans + tupleSingleTransition = toTuple singleTransition + in case singleTransition of + [a] -> [(a,"")] + _ -> tupleSingleTransition ++ getAllTransitions (snd (head tupleSingleTransition) : rest) + where + toTuple [a,b] = [(a,b)] + toTuple [] = [] + toTuple _ = error "toTuple: a single transition was not generated" + +epochStateDiffs + :: [(Text,Text)] + -> Text +epochStateDiffs [] = "No epoch state values to compare" +epochStateDiffs states = + -- We first get the block number changes + labelAllEpochStateTransitions + [ Text.pack $ epochStateTransitionDiff (Text.unpack i) (Text.unpack n) + | (i, n) <- states + ] & Text.intercalate "\n" + where + labelSingleEpochStateTransition :: Int -> Text + labelSingleEpochStateTransition transitionNumber = + "Epoch state transition: " <> Text.pack (show transitionNumber) + + labelAllEpochStateTransitions [] = [] + labelAllEpochStateTransitions trans = + go trans (1 :: Int) [] + where + go [] _ acc = acc + go (x:xs) 1 _ = go xs 2 [labelSingleEpochStateTransition 1, x] + go (x:xs) n acc = go xs (n + 1) (acc ++ [labelSingleEpochStateTransition n, x]) + +epochStateTransitionDiff + :: String -- ^ Initial epoch state + -> String -- ^ Following epoch state + -> String +epochStateTransitionDiff initialState next = + let removeBlockNumberChangeInitial = lines initialState + removeBlockNumberChangeNext = lines next + diffResult = getGroupedDiff removeBlockNumberChangeInitial removeBlockNumberChangeNext + in if null diffResult + then "No changes in epoch state" + else ppDiff diffResult instance (L.EraTxOut ledgerera, L.EraGov ledgerera) => ToJSON (L.NewEpochState ledgerera) where toJSON (L.NewEpochState nesEL nesBprev nesBCur nesEs nesRu nesPd _stashedAvvm)= diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index 93996d8c082..b653c03eb85 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -221,7 +221,6 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat -- Step 4. We confirm the no confidence motion has been ratified by checking -- for an empty constitutional committee. - H.nothingFailM $ watchEpochStateView epochStateView (return . committeeIsPresent False) (EpochInterval 10) -- | Checks if the committee is empty or not.