Configuration for ledger peers

Add a possibility to either specify when the governor should start using
peers from the current ledger state.
"useLedgerAfterSlot": <slot number>
A negative value disable peers from the ledger and is usefull for block
producers. The option is disabled by default.

cardano-node/src/Cardano/Node/Configuration/Topology.hs

@@ -10,6 +10,7 @@ module Cardano.Node.Configuration.Topology
   , NodeSetup(..)
   , RemoteAddress(..)
   , PeerAdvertise(..)
+  , UseLedger(..)
   , nodeAddressToSockAddr
   , readTopologyFile
   , remoteAddressToNodeAddress
@@ -26,9 +27,11 @@ import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.Text as Text
 
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
+import           Cardano.Slotting.Slot (SlotNo (..))
 import           Cardano.Node.Types
 
 import           Ouroboros.Network.NodeToNode (PeerAdvertise (..))
+import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
 import           Ouroboros.Consensus.Util.Condense (Condense (..))
 
 
@@ -85,11 +88,24 @@ instance ToJSON RemoteAddress where
                           DoAdvertisePeer    -> True
       ]
 
+newtype UseLedger = UseLedger UseLedgerAfter deriving (Eq, Show)
+
+instance FromJSON UseLedger where
+  parseJSON (Data.Aeson.Number n) =
+    if n >= 0 then return $ UseLedger $ UseLedgerAfter $ SlotNo $ floor n
+              else return $ UseLedger $ DontUseLedger
+  parseJSON _ = mzero
+
+instance ToJSON UseLedger where
+  toJSON (UseLedger (UseLedgerAfter (SlotNo n))) = Number $ fromIntegral n
+  toJSON (UseLedger DontUseLedger)               = Number (-1)
+
 data NodeSetup = NodeSetup
   { nodeId :: !Word64
   , nodeIPv4Address :: !(Maybe NodeIPv4Address)
   , nodeIPv6Address :: !(Maybe NodeIPv6Address)
   , producers :: ![RemoteAddress]
+  , useLedger :: !UseLedger
   } deriving (Eq, Show)
 
 instance FromJSON NodeSetup where
@@ -99,6 +115,7 @@ instance FromJSON NodeSetup where
                   <*> o .: "nodeIPv4Address"
                   <*> o .: "nodeIPv6Address"
                   <*> o .: "producers"
+                  <*> (o .:? "useLedgerAfterSlot" .!= (UseLedger DontUseLedger))
 
 instance ToJSON NodeSetup where
   toJSON ns =
@@ -107,23 +124,27 @@ instance ToJSON NodeSetup where
       , "nodeIPv4Address" .= nodeIPv4Address ns
       , "nodeIPv6Address" .= nodeIPv6Address ns
       , "producers" .= producers ns
+      , "useLedgerAfterSlot" .= useLedger ns
       ]
 
 data NetworkTopology = MockNodeTopology ![NodeSetup]
-                     | RealNodeTopology ![RemoteAddress]
+                     | RealNodeTopology ![RemoteAddress] !UseLedger
   deriving (Eq, Show)
 
 instance FromJSON NetworkTopology where
   parseJSON = withObject "NetworkTopology" $ \o -> asum
                 [ MockNodeTopology <$> o .: "MockProducers"
                 , RealNodeTopology <$> o .: "Producers"
+                                   <*> (o .:? "useLedgerAfterSlot" .!= (UseLedger DontUseLedger))
                 ]
 
 instance ToJSON NetworkTopology where
   toJSON top =
     case top of
       MockNodeTopology nss -> object [ "MockProducers" .= toJSON nss ]
-      RealNodeTopology ras -> object [ "Producers" .= toJSON ras ]
+      RealNodeTopology ras ul -> object [ "Producers" .= toJSON ras
+                                        ,  "useLedgerAfterSlot" .= toJSON ul
+                                        ]
 
 -- | Read the `NetworkTopology` configuration from the specified file.
 -- While running a real protocol, this gives your node its own address and

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

@@ -68,6 +68,7 @@ import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Network.Magic (NetworkMagic (..))
 import           Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..),
                    DomainAddress, PeerSelectionTargets (..))
+import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
 
 import           Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..),
                      gatherConfiguredSockets, getSocketOrSocketInfoAddr)
@@ -224,6 +225,7 @@ handleSimpleNode p trace nodeTracers nc onKernel = do
           ((\(a,b) -> (nodeDnsAddressToDomainAddress a, b))
             `map` dnsLocalRoots)
           []
+          (useLedgerAfterSlot nt)
 
   ipv4 <- traverse getSocketOrSocketInfoAddr publicIPv4SocketOrAddr
   ipv6 <- traverse getSocketOrSocketInfoAddr publicIPv6SocketOrAddr
@@ -360,6 +362,7 @@ createDiffusionArguments
   -> [(SockAddr, PeerAdvertise)]
   -> [(DomainAddress, PeerAdvertise)]
   -> [DomainAddress]
+  -> UseLedgerAfter
   -> DiffusionArguments
 createDiffusionArguments NodeConfiguration {
                            ncTargetNumberOfRootPeers,
@@ -376,6 +379,7 @@ createDiffusionArguments NodeConfiguration {
                          daStaticLocalRootPeers
                          daLocalRootPeers
                          daPublicRootPeers
+                         daUseLedgerAfter
                          =
   DiffusionArguments
     { daIPv4Address = case publicIPv4SocketsOrAddrs of
@@ -392,6 +396,7 @@ createDiffusionArguments NodeConfiguration {
     , daStaticLocalRootPeers
     , daLocalRootPeers
     , daPublicRootPeers
+    , daUseLedgerAfter
     -- TODO: these limits are arbitrary at the moment;
     -- issue: https://github.com/input-output-hk/ouroboros-network/issues/1836
     , daAcceptedConnectionsLimit = AcceptedConnectionsLimit {
@@ -420,6 +425,17 @@ producerAddresses
      , [(NodeDnsAddress, PeerAdvertise)])
 producerAddresses nt =
   case nt of
-    RealNodeTopology producers' -> partitionEithers $ map remoteAddressToNodeAddress producers'
+    RealNodeTopology producers' _ -> partitionEithers $ map remoteAddressToNodeAddress producers'
     MockNodeTopology nodeSetup ->
       partitionEithers . map remoteAddressToNodeAddress $ concatMap producers nodeSetup
+
+useLedgerAfterSlot
+  :: NetworkTopology
+  -> UseLedgerAfter
+useLedgerAfterSlot nt =
+  case nt of
+       RealNodeTopology _ (UseLedger ul) -> ul
+       MockNodeTopology (nodeSetup:_)    ->
+           let (UseLedger ul) = useLedger nodeSetup in
+           ul
+       MockNodeTopology [] -> DontUseLedger

cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs

@@ -437,6 +437,7 @@ instance HasSeverityAnnotation TraceLedgerPeers where
       PickedPeer {}                  -> Debug
       PickedPeers {}                 -> Info
       FetchingNewLedgerState {}      -> Info
+      DisabledLedgerPeers {}         -> Info
       WaitingOnRequest {}            -> Debug
       RequestForPeers {}             -> Debug
       ReusingLedgerState {}          -> Debug
@@ -1317,6 +1318,10 @@ instance ToObject TraceLedgerPeers where
     mkObject
       [ "kind" .= String "TraceLedgerPeers FallingBackToBootstrapPeers"
       ]
+  toObject _verb DisabledLedgerPeers =
+    mkObject
+      [ "kind" .= String "TraceLedgerPeers DisabledLedgerPeers"
+      ]
 
 
 instance Show addr

cardano-node/test/Test/Cardano/Node/Gen.hs

@@ -19,10 +19,13 @@ module Test.Cardano.Node.Gen
 import           Cardano.Prelude
 
 import           Cardano.Node.Configuration.Topology (NetworkTopology (..), NodeSetup (..),
-                     PeerAdvertise (..), RemoteAddress (..))
+                     PeerAdvertise (..), RemoteAddress (..), UseLedger (..))
 import           Cardano.Node.Types (NodeAddress' (..), NodeHostIPAddress (..),
                    NodeHostIPv4Address (..), NodeHostIPv6Address (..),
                    NodeIPAddress, NodeIPv4Address, NodeIPv6Address)
+import           Cardano.Slotting.Slot (SlotNo (..))
+import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
+
 
 import qualified Data.IP as IP
 
@@ -36,7 +39,7 @@ genNetworkTopology :: Gen NetworkTopology
 genNetworkTopology =
   Gen.choice
     [ MockNodeTopology <$> Gen.list (Range.linear 0 10) genNodeSetup
-    , RealNodeTopology <$> Gen.list (Range.linear 0 10) genRemoteAddress
+    , RealNodeTopology <$> Gen.list (Range.linear 0 10) genRemoteAddress <*> genUseLedger
     ]
 
 genNodeAddress' :: Gen addr -> Gen (NodeAddress' addr)
@@ -84,11 +87,17 @@ genNodeSetup =
     <*> Gen.maybe (genNodeAddress' genNodeHostIPv4Address)
     <*> Gen.maybe (genNodeAddress' genNodeHostIPv6Address)
     <*> Gen.list (Range.linear 0 6) genRemoteAddress
+    <*> genUseLedger
 
 genRemoteAddress :: Gen RemoteAddress
 genRemoteAddress =
   RemoteAddress
     <$> Gen.element cooking
     <*> fmap fromIntegral (Gen.word16 $ Range.linear 100 20000)
-    <*> Gen.element [DoAdvertisePeer, DoNotAdvertisePeer] 
+    <*> Gen.element [DoAdvertisePeer, DoNotAdvertisePeer]
 
+genUseLedger :: Gen UseLedger
+genUseLedger = do
+    slot <- Gen.integral (Range.linear (-1) 10) :: Gen Integer
+    if slot >= 0 then return $ UseLedger $ UseLedgerAfter $ SlotNo $ fromIntegral slot
+                 else return $ UseLedger $ DontUseLedger