Include the NodeConfig in the consensus test output

The `getCreator` method, which tells you which node produced a block, is used
in the checks of some consensus tests. The `getCreator` method takes a
`NodeConfig`, but we didn't have a `NodeConfig` in those testing contexts, so
we were using `error` instead. This was "fine" because this `NodeConfig` is
only really used for the real PBFT implementation, which is not used in the
tests, only in the demo. However, using `error` here is dirty and might work
for now, but that may change in the future.

Fix this by letting the test setup function return the `NodeConfig` for each
node in addition to its chain. This `NodeConfig` can then be passed to
`getCreator`.

Actually, `getCreator` would work with any `NodeConfig` from the test setup,
regardless to which node its corresponds. This is because `getCreator` only
reads data from the `NodeConfig` that is common to all nodes, no node-specific
data is used. Nonetheless, it is nicer to use the `NodeConfig` that belongs to
"correct" node.

ouroboros-consensus/test-consensus/Test/Dynamic/BFT.hs

@@ -56,13 +56,16 @@ prop_simple_bft_convergence k numCoreNodes =
       numCoreNodes
   where
     isValid :: [NodeId]
-            -> Map NodeId (Chain (SimpleBlock DemoBFT SimpleBlockMockCrypto))
+            -> Map NodeId ( NodeConfig DemoBFT
+                          , Chain (SimpleBlock DemoBFT SimpleBlockMockCrypto))
             -> Property
-    isValid nodeIds final = counterexample (show final) $
-          tabulate "shortestLength" [show (rangeK k (shortestLength final))]
+    isValid nodeIds final = counterexample (show final') $
+          tabulate "shortestLength" [show (rangeK k (shortestLength final'))]
      $    Map.keys final === nodeIds
-     .&&. allEqual (takeChainPrefix <$> Map.elems final)
+     .&&. allEqual (takeChainPrefix <$> Map.elems final')
       where
+        -- Without the 'NodeConfig's
+        final' = snd <$> final
         takeChainPrefix :: Chain (SimpleBlock DemoBFT SimpleBlockMockCrypto)
                         -> Chain (SimpleBlock DemoBFT SimpleBlockMockCrypto)
         takeChainPrefix = id -- in BFT, chains should indeed all be equal.

ouroboros-consensus/test-consensus/Test/Dynamic/General.hs

@@ -31,6 +31,7 @@ import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Demo
 import           Ouroboros.Consensus.Ledger.Mock
 import           Ouroboros.Consensus.Node
+import           Ouroboros.Consensus.Protocol.Abstract (NodeConfig)
 import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Consensus.Util.Random
 import           Ouroboros.Consensus.Util.ThreadRegistry
@@ -43,7 +44,7 @@ prop_simple_protocol_convergence :: forall p c.
                                    )
                                  => (CoreNodeId -> ProtocolInfo (SimpleBlock p c))
                                  -> (   [NodeId]
-                                     -> Map NodeId (Chain (SimpleBlock p c))
+                                     -> Map NodeId (NodeConfig p, Chain (SimpleBlock p c))
                                      -> Property)
                                  -> NumCoreNodes
                                  -> NumSlots
@@ -67,7 +68,7 @@ test_simple_protocol_convergence :: forall m p c.
                                     )
                                  => (CoreNodeId -> ProtocolInfo (SimpleBlock p c))
                                  -> (   [NodeId]
-                                     -> Map NodeId (Chain (SimpleBlock p c))
+                                     -> Map NodeId (NodeConfig p, Chain (SimpleBlock p c))
                                      -> Property)
                                  -> NumCoreNodes
                                  -> NumSlots

ouroboros-consensus/test-consensus/Test/Dynamic/LeaderSchedule.hs

@@ -81,17 +81,21 @@ prop_simple_leader_schedule_convergence numSlots numCoreNodes params seed =
                     numSlots
                     seed
   where
-    nodeConfig = error "NodeConfig required in LeaderSchedule tests"
     isValid :: [NodeId]
-            -> Map NodeId (Chain (SimpleBlock DemoLeaderSchedule SimpleBlockMockCrypto))
+            -> Map NodeId ( NodeConfig DemoLeaderSchedule
+                          , Chain (SimpleBlock DemoLeaderSchedule SimpleBlockMockCrypto))
             -> Property
     isValid nodeIds final =
-          counterexample (tracesToDot nodeConfig final)
-     $    tabulate "shortestLength" [show (rangeK (praosSecurityParam params) (shortestLength final))]
-     $    Map.keys final === nodeIds
-     .&&. prop_all_common_prefix
-            (maxRollbacks $ praosSecurityParam params)
-            (Map.elems final)
+            counterexample (tracesToDot final)
+       $    tabulate "shortestLength"
+            [show (rangeK (praosSecurityParam params) (shortestLength final'))]
+       $    Map.keys final === nodeIds
+       .&&. prop_all_common_prefix
+              (maxRollbacks $ praosSecurityParam params)
+              (Map.elems final')
+      where
+        -- Without the 'NodeConfig's
+        final' = snd <$> final
 
 {-------------------------------------------------------------------------------
   Dependent generation and shrinking of leader schedules

ouroboros-consensus/test-consensus/Test/Dynamic/Network.hs

@@ -43,6 +43,7 @@ import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Mock
 import qualified Ouroboros.Consensus.Ledger.Mock as Mock
 import           Ouroboros.Consensus.Node
+import           Ouroboros.Consensus.Protocol.Abstract (NodeConfig)
 import           Ouroboros.Consensus.Util.Condense
 import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Consensus.Util.Random
@@ -75,7 +76,7 @@ broadcastNetwork :: forall m p c.
                  -> (CoreNodeId -> ProtocolInfo (SimpleBlock p c))
                  -> ChaChaDRG
                  -> NumSlots
-                 -> m (Map NodeId (Chain (SimpleBlock p c)))
+                 -> m (Map NodeId (NodeConfig p, Chain (SimpleBlock p c)))
 broadcastNetwork registry btime numCoreNodes pInfo initRNG numSlots = do
 
     -- all known addresses
@@ -161,7 +162,7 @@ broadcastNetwork registry btime numCoreNodes pInfo initRNG numSlots = do
           (mkCommsUp   chainSyncProducer  codecChainSyncId)
           (mkCommsUp   blockFetchProducer codecBlockFetchId)
 
-      return (us, node)
+      return (coreNodeId, node)
 
     -- STM variable to record the final chains of the nodes
     varRes <- atomically $ newTVar Nothing
@@ -170,8 +171,9 @@ broadcastNetwork registry btime numCoreNodes pInfo initRNG numSlots = do
       -- Wait a random amount of time after the final slot for the block fetch
       -- and chain sync to finish
       threadDelay 2000
-      res <- fmap Map.fromList $ forM nodes $ \(us, node) ->
-        (us, ) <$> ChainDB.toChain (getChainDB node)
+      res <- fmap Map.fromList $ forM nodes $ \(cid, node) ->
+        (\ch -> (fromCoreNodeId cid, (pInfoConfig (pInfo cid), ch))) <$>
+        ChainDB.toChain (getChainDB node)
       atomically $ writeTVar varRes (Just res)
 
     atomically $ blockUntilJust (readTVar varRes)

ouroboros-consensus/test-consensus/Test/Dynamic/PBFT.hs

@@ -65,13 +65,16 @@ prop_simple_pbft_convergence sp numCoreNodes@(NumCoreNodes nn) =
     sigThd = (1.0 / fromIntegral nn) + 0.1
     params = PBftParams sp (fromIntegral nn) sigWin sigThd
     isValid :: [NodeId]
-            -> Map NodeId (Chain (SimpleBlock DemoMockPBFT SimpleBlockMockCrypto))
+            -> Map NodeId ( NodeConfig DemoMockPBFT
+                          , Chain (SimpleBlock DemoMockPBFT SimpleBlockMockCrypto))
             -> Property
-    isValid nodeIds final = counterexample (show final) $
-          tabulate "shortestLength" [show (rangeK sp (shortestLength final))]
+    isValid nodeIds final = counterexample (show final') $
+          tabulate "shortestLength" [show (rangeK sp (shortestLength final'))]
      $    Map.keys final === nodeIds
-     .&&. allEqual (takeChainPrefix <$> Map.elems final)
+     .&&. allEqual (takeChainPrefix <$> Map.elems final')
       where
+        -- Without the 'NodeConfig's
+        final' = snd <$> final
         takeChainPrefix :: Chain (SimpleBlock DemoMockPBFT SimpleBlockMockCrypto)
                         -> Chain (SimpleBlock DemoMockPBFT SimpleBlockMockCrypto)
         takeChainPrefix = id -- in PBFT, chains should indeed all be equal.

ouroboros-consensus/test-consensus/Test/Dynamic/Praos.hs

@@ -93,29 +93,30 @@ prop_simple_praos_convergence params numCoreNodes numSlots =
     PraosParams{..} = params
 
     isValid :: [NodeId]
-            -> Map NodeId (Chain (SimpleBlock DemoPraos SimpleBlockMockCrypto))
+            -> Map NodeId ( NodeConfig DemoPraos
+                          , Chain (SimpleBlock DemoPraos SimpleBlockMockCrypto))
             -> Property
-    isValid nodeIds final = counterexample (show final) $
-      -- Oh dear, oh dear. This node config isn't used except in the RealPBFT
-      -- case, and it's not available here, so we leave it undefined. But this
-      -- isn't especially nice, since there's nothing stopping somebody changing
-      -- things later to use it. All of this only exists in test code, though.
-      let nc       = error "Node config missing for Praos protocol"
-          schedule = leaderScheduleFromTrace nc numSlots final
-          longest  = longestCrowdedRun schedule
-          crowded  = crowdedRunLength longest
-      in    counterexample (tracesToDot nc final)
-          $ counterexample (condense schedule)
-          $ counterexample (show longest)
-          $ label ("longest crowded run " <> show crowded)
-          $ tabulate "shortestLength" [show (rangeK praosSecurityParam (shortestLength final))]
-          $ (Map.keys final === nodeIds)
-            .&&. if crowded > maxRollbacks praosSecurityParam
-                  then label "too crowded"     $ property True
-                  else label "not too crowded" $
-                          prop_all_common_prefix
-                            (maxRollbacks praosSecurityParam)
-                            (Map.elems final)
+    isValid nodeIds final
+       = counterexample (show final')
+       $ counterexample (tracesToDot final)
+       $ counterexample (condense schedule)
+       $ counterexample (show longest)
+       $ label ("longest crowded run " <> show crowded)
+       $ tabulate "shortestLength"
+         [show (rangeK praosSecurityParam (shortestLength final'))]
+       $ (Map.keys final === nodeIds)
+         .&&. if crowded > maxRollbacks praosSecurityParam
+               then label "too crowded"     $ property True
+               else label "not too crowded" $
+                       prop_all_common_prefix
+                         (maxRollbacks praosSecurityParam)
+                         (Map.elems final')
+      where
+        -- Without the 'NodeConfig's
+        final'   = snd <$> final
+        schedule = leaderScheduleFromTrace numSlots final
+        longest  = longestCrowdedRun schedule
+        crowded  = crowdedRunLength longest
 
 prop_all_common_prefix :: (HasHeader b, Condense b, Eq b)
                        => Word64 -> [Chain b] -> Property

ouroboros-consensus/test-consensus/Test/Dynamic/Util.hs

@@ -141,19 +141,19 @@ instance Labellable EdgeLabel where
     toLabelValue = const $ StrLabel Text.empty
 
 tracesToDot :: forall b. (HasHeader b, HasCreator b)
-            => NodeConfig (BlockProtocol b)
-            -> Map NodeId (Chain b)
+            => Map NodeId (NodeConfig (BlockProtocol b), Chain b)
             -> String
-tracesToDot nc traces = Text.unpack $ printDotGraph $ graphToDot quickParams graph
+tracesToDot traces = Text.unpack $ printDotGraph $ graphToDot quickParams graph
   where
-    chainBlockInfos :: Chain b -> Map (ChainHash b) (BlockInfo b)
-    chainBlockInfos = Chain.foldChain f (Map.singleton GenesisHash genesisBlockInfo)
+    chainBlockInfos :: NodeConfig (BlockProtocol b) -> Chain b
+                    -> Map (ChainHash b) (BlockInfo b)
+    chainBlockInfos nc = Chain.foldChain f (Map.singleton GenesisHash genesisBlockInfo)
       where
         f m b = let info = blockInfo nc b
                 in  Map.insert (biHash info) info m
 
     blockInfos :: Map (ChainHash b) (BlockInfo b)
-    blockInfos = Map.unions $ map chainBlockInfos $ Map.elems traces
+    blockInfos = Map.unions $ map (uncurry chainBlockInfos) $ Map.elems traces
 
     lastHash :: Chain b -> ChainHash b
     lastHash Genesis  = GenesisHash
@@ -164,8 +164,9 @@ tracesToDot nc traces = Text.unpack $ printDotGraph $ graphToDot quickParams gra
       where
         i = (\info -> (info, Set.empty)) <$> blockInfos
 
-        f m nid chain = Map.adjust
-            (\(info, believers) -> (info, Set.insert nid believers))
+        f m nid (_, chain) = Map.adjust
+            (\(info, believers) ->
+              (info, Set.insert nid believers))
             (lastHash chain)
             m
 
@@ -195,18 +196,20 @@ tracesToDot nc traces = Text.unpack $ printDotGraph $ graphToDot quickParams gra
     graph = mkGraph ns es
 
 leaderScheduleFromTrace :: forall b. (HasCreator b, HasHeader b)
-                        => NodeConfig (BlockProtocol b)
-                        -> NumSlots
-                        -> Map NodeId (Chain b)
+                        => NumSlots
+                        -> Map NodeId (NodeConfig (BlockProtocol b), Chain b)
                         -> LeaderSchedule
-leaderScheduleFromTrace nc (NumSlots numSlots) =
-    LeaderSchedule . Map.foldl' (Chain.foldChain step) initial
+leaderScheduleFromTrace (NumSlots numSlots) = LeaderSchedule .
+    Map.foldl' (\m (nc, c) -> Chain.foldChain (step nc) m c) initial
   where
     initial :: Map SlotNo [CoreNodeId]
     initial = Map.fromList [(slot, []) | slot <- [1 .. fromIntegral numSlots]]
 
-    step :: Map SlotNo [CoreNodeId] -> b -> Map SlotNo [CoreNodeId]
-    step m b = Map.adjust (insert $ getCreator nc b) (blockSlot b) m
+    step :: NodeConfig (BlockProtocol b)
+         -> Map SlotNo [CoreNodeId]
+         -> b
+         -> Map SlotNo [CoreNodeId]
+    step nc m b = Map.adjust (insert $ getCreator nc b) (blockSlot b) m
 
     insert :: CoreNodeId -> [CoreNodeId] -> [CoreNodeId]
     insert nid xs