Review changes

Author: jutaro

cardano-node/src/Cardano/Node/Run.hs

@@ -729,8 +729,7 @@ updateBlockForging startupTracer blockType nodeKernel nc = do
                     (BlockForgingUpdate (if isNonProducing || null blockForging
                                           then DisabledBlockForging
                                           else EnabledBlockForging))
-          unless isNonProducing $
-            setBlockForging nodeKernel blockForging
+          setBlockForging nodeKernel blockForging
         Nothing ->
           traceWith startupTracer
             $ BlockForgingBlockTypeMismatch

cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs

@@ -504,9 +504,9 @@ instance ( LogFormatting (Header blk)
                | dtal == DDetailed ]
             ++ [ "events" .= toJSON (map (forMachine dtal) events)
                | not (null events) ]
-            ++ [ "tipBlockHash" .= tipBlockHash]
-            ++ [ "tipBlockParentHash" .= tipBlockParentHash]
-            ++ [ "tipBlockIssuerVerificationKeyHash" .= tipBlockIssuerVkHashText]
+            ++ [ "tipBlockHash" .= tipBlockHash
+               , "tipBlockParentHash" .= tipBlockParentHash
+               , "tipBlockIssuerVerificationKeyHash" .= tipBlockIssuerVkHashText]
   forMachine dtal (ChainDB.SwitchedToAFork events selChangedInfo old new) =
       let ChainInformation { .. } = chainInformation selChangedInfo old new 0
           tipBlockIssuerVkHashText :: Text
@@ -527,9 +527,9 @@ instance ( LogFormatting (Header blk)
                | dtal == DDetailed ]
             ++ [ "events" .= toJSON (map (forMachine dtal) events)
                | not (null events) ]
-            ++ [ "tipBlockHash" .= tipBlockHash]
-            ++ [ "tipBlockParentHash" .= tipBlockParentHash]
-            ++ [ "tipBlockIssuerVerificationKeyHash" .= tipBlockIssuerVkHashText]
+            ++ [ "tipBlockHash" .= tipBlockHash
+               , "tipBlockParentHash" .= tipBlockParentHash
+               , "tipBlockIssuerVerificationKeyHash" .= tipBlockIssuerVkHashText]
 
   forMachine dtal (ChainDB.AddBlockValidation ev') =
     forMachine dtal ev'
@@ -2152,13 +2152,7 @@ chainInformation selChangedInfo oldFrag frag blocksUncoupledDelta = ChainInforma
     }
   where
     tipIssuerVkHash :: BlockIssuerVerificationKeyHash
-    tipIssuerVkHash =
-      case AF.head frag of
-        Left AF.AnchorGenesis ->
-          NoBlockIssuer
-        Left (AF.Anchor _s _h _b) ->
-          NoBlockIssuer
-        Right blk -> getIssuerVerificationKeyHash blk
+    tipIssuerVkHash = either (const NoBlockIssuer) getIssuerVerificationKeyHash (AF.head frag)
 
 fragmentChainDensity ::
   HasHeader (Header blk)

cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs

@@ -1,48 +1,59 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+
 -- | Check namespace consistencies agains configurations
 module Test.Cardano.Tracing.NewTracing.Consistency (tests) where
 
 import           Cardano.Node.Tracing.Consistency (checkNodeTraceConfiguration)
 
-import           Control.Monad.IO.Class (liftIO)
+import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Data.Text
+import           System.Directory (canonicalizePath)
+import           System.FilePath ((</>))
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H
-import qualified Hedgehog.Extras.Test.Base as H.Base
+import qualified Hedgehog.Extras.Test.Base as H
+import qualified Hedgehog.Extras.Test.Process as H
 import           Hedgehog.Internal.Property (PropertyName (PropertyName))
 
-tests :: IO Bool
-tests = H.checkSequential
+tests :: MonadIO m => m Bool
+tests = do
+  H.checkSequential
       $ H.Group "Configuration Consistency tests"
-      $ test
-     <$> [ (  []
-              -- This file name shoud reference the current standard config with new tracing
-           , "mainnet-config-new-tracing.json"
-           , configPrefix)
-         , (  []
-           , "goodConfig.yaml"
-           , testPrefix)
-         , (  [ "Config namespace error: Illegal namespace ChainDB.CopyToImmutableDBEvent2.CopiedBlockToImmutableDB"
-              , "Config namespace error: Illegal namespace SubscriptionDNS"
-              ]
-           , "badConfig.yaml"
-           , testPrefix)
-         ]
+      $ Prelude.map test
+            [ (  []
+                  -- This file name shoud reference the current standard config with new tracing
+              , "mainnet-config-new-tracing.json"
+              , configPrefix)
+            , (  []
+              , "goodConfig.yaml"
+              , testPrefix)
+            , (  [ "Config namespace error: Illegal namespace ChainDB.CopyToImmutableDBEvent2.CopiedBlockToImmutableDB"
+                  , "Config namespace error: Illegal namespace SubscriptionDNS"
+                  ]
+              , "badConfig.yaml"
+              , testPrefix)
+            ]
   where
     test (actualValue, goldenBaseName, prefix) =
         (PropertyName goldenBaseName, goldenTestJSON actualValue goldenBaseName prefix)
 
 
-goldenTestJSON :: [Text] -> FilePath -> FilePath -> Property
-goldenTestJSON expectedOutcome goldenFileBaseName prefix =
+goldenTestJSON :: [Text] -> FilePath -> (FilePath -> IO FilePath) -> Property
+goldenTestJSON expectedOutcome goldenFileBaseName prefixFunc =
     H.withTests 1 $ H.withShrinks 0 $ H.property $ do
-      goldenFp    <- H.Base.note $ prefix <> goldenFileBaseName
+      basePath <- H.getProjectBase
+      prefixPath <- liftIO $ prefixFunc basePath
+      goldenFp    <- H.note $ prefixPath </> goldenFileBaseName
       actualValue <- liftIO $ checkNodeTraceConfiguration goldenFp
       actualValue H.=== expectedOutcome
 
 
-configPrefix :: FilePath
-configPrefix = "../configuration/cardano/"
+configPrefix :: FilePath -> IO FilePath
+configPrefix projectBase = do
+  base <- canonicalizePath projectBase
+  return $ base </> "configuration/cardano"
 
-testPrefix :: FilePath
-testPrefix = "test/Test/Cardano/Tracing/NewTracing/data/"
+testPrefix :: FilePath ->  IO FilePath
+testPrefix _ = pure "test/Test/Cardano/Tracing/NewTracing/data/"