Output the diffs between epoch state transitions in startLedgerNewEpo…

…chStateLogging

cardano-testnet/cardano-testnet.cabal

@@ -57,6 +57,7 @@ library
                       , containers
                       , contra-tracer
                       , data-default-class
+                      , Diff
                       , directory
                       , exceptions
                       , filepath

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

cardano-testnet/src/Testnet/Runtime.hs

@@ -1,12 +1,10 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# 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 <tmp workspace directory>/logs/ledger-new-epoch-state.log
+-- Pretty JSON logs will be placed in:
+-- 1. <tmp workspace directory>/logs/ledger-new-epoch-state.log
+-- 2. <tmp workspace directory>/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)=

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.