Bootstrap Peers

bench/locli/locli.cabal

@@ -121,7 +121,7 @@ library
                       , optparse-generic
                       , ouroboros-consensus
                       -- for Data.SOP.Strict:
-                      , ouroboros-network ^>= 0.11
+                      , ouroboros-network ^>= 0.12
                       , ouroboros-network-api
                       , process
                       , quiet
@@ -175,7 +175,7 @@ test-suite test-locli
   build-depends:        cardano-prelude
                       , containers
                       , hedgehog
-                      , hedgehog-extras ^>= 0.6.1.0
+                      , hedgehog-extras < 0.6.2
                       , locli
                       , text
 

bench/plutus-scripts-bench/plutus-scripts-bench.cabal

@@ -73,7 +73,7 @@ library
   -- IOG dependencies
   --------------------------
   build-depends:
-    , cardano-api             ^>= 8.38.0.0
+    , cardano-api             ^>= 8.39.2.0
     , plutus-ledger-api       >=1.0.0
     , plutus-tx               >=1.0.0
     , plutus-tx-plugin        ^>=1.21

bench/tx-generator/tx-generator.cabal

@@ -100,7 +100,7 @@ library
                       , attoparsec-aeson
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 8.38.0.0
+                      , cardano-api ^>= 8.39.2.0
                       , cardano-binary
                       , cardano-cli ^>= 8.20.1.0
                       , cardano-crypto-class

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2024-02-21T10:56:14Z
-  , cardano-haskell-packages 2024-02-21T14:57:01Z
+  , hackage.haskell.org 2024-02-26T18:07:09Z
+  , cardano-haskell-packages 2024-02-26T17:55:44Z
 
 packages:
   cardano-git-rev

cardano-node-chairman/app/Cardano/Chairman.hs

@@ -343,7 +343,7 @@ chainSyncClient tracer sockPath chainsVar secParam = ChainSyncClient $ pure $
     }
   where
     clientStIdle :: ClientStIdle BlockInMode ChainPoint ChainTip IO ()
-    clientStIdle = SendMsgRequestNext clientStNext (pure clientStNext)
+    clientStIdle = SendMsgRequestNext (pure ()) clientStNext
 
     clientStNext :: ClientStNext BlockInMode ChainPoint ChainTip IO ()
     clientStNext = ClientStNext

cardano-node-chairman/cardano-node-chairman.cabal

@@ -73,7 +73,7 @@ test-suite chairman-tests
                       , cardano-crypto-class ^>= 2.1.2
                       , filepath
                       , hedgehog
-                      , hedgehog-extras ^>= 0.6.1.0
+                      , hedgehog-extras < 0.6.2
                       , network
                       , process
                       , random

cardano-node/cardano-node.cabal

@@ -144,7 +144,7 @@ library
                       , async
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 8.38.0.0
+                      , cardano-api ^>= 8.39.2.0
                       , cardano-crypto-class
                       , cardano-crypto-wrapper
                       , cardano-git-rev
@@ -171,7 +171,7 @@ library
                       , formatting
                       , generic-data
                       , hostname
-                      , io-classes >= 0.3
+                      , io-classes >= 1.4
                       , iohk-monitoring
                       , iproute
                       , lobemo-backend-aggregation
@@ -183,14 +183,14 @@ library
                       , network-mux >= 0.4
                       , nothunks
                       , optparse-applicative-fork >= 0.18.1
-                      , ouroboros-consensus ^>= 0.15
-                      , ouroboros-consensus-cardano ^>= 0.13
-                      , ouroboros-consensus-diffusion ^>= 0.10
+                      , ouroboros-consensus ^>= 0.16
+                      , ouroboros-consensus-cardano ^>= 0.14
+                      , ouroboros-consensus-diffusion ^>= 0.11
                       , ouroboros-consensus-protocol
                       , ouroboros-network-api
-                      , ouroboros-network ^>= 0.11
+                      , ouroboros-network ^>= 0.12
                       , ouroboros-network-framework
-                      , ouroboros-network-protocols ^>= 0.7
+                      , ouroboros-network-protocols ^>= 0.8
                       , prettyprinter
                       , prettyprinter-ansi-terminal
                       , psqueues
@@ -201,6 +201,7 @@ library
                       , stm
                       , strict-sop-core
                       , strict-stm
+                      , strict-checked-vars
                       , time
                       , trace-dispatcher ^>= 2.5
                       , trace-forward ^>= 2.2

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

@@ -30,7 +30,9 @@ import           Cardano.Node.Startup (StartupTrace (..))
 import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.Network ()
 import           Ouroboros.Network.NodeToNode (PeerAdvertise (..))
-import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
+import           Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
+import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers (..))
+import           Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
 import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 import           Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..),
                    WarmValency (..))
@@ -53,7 +55,7 @@ data NodeSetup = NodeSetup
   , nodeIPv4Address :: !(Maybe NodeIPv4Address)
   , nodeIPv6Address :: !(Maybe NodeIPv6Address)
   , producers       :: ![RootConfig]
-  , useLedger       :: !UseLedger
+  , useLedger       :: !UseLedgerPeers
   } deriving (Eq, Show)
 
 instance FromJSON NodeSetup where
@@ -63,7 +65,7 @@ instance FromJSON NodeSetup where
                   <*> o .:  "nodeIPv4Address"
                   <*> o .:  "nodeIPv6Address"
                   <*> o .:  "producers"
-                  <*> o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger
+                  <*> o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers
 
 instance ToJSON NodeSetup where
   toJSON ns =
@@ -85,7 +87,7 @@ data RootConfig = RootConfig
     -- or domain name and a port number.
   , rootAdvertise    :: PeerAdvertise
     -- ^ 'advertise' configures whether the root should be advertised through
-    -- gossip.
+    -- peer sharing.
   } deriving (Eq, Show)
 
 instance FromJSON RootConfig where
@@ -121,6 +123,9 @@ data LocalRootPeersGroup = LocalRootPeersGroup
   { localRoots :: RootConfig
   , hotValency :: HotValency
   , warmValency :: WarmValency
+  , trustable   :: PeerTrustable
+    -- ^ 'trustable' configures whether the root should be trusted in fallback
+    -- state.
   } deriving (Eq, Show)
 
 -- | Does not use the 'FromJSON' instance of 'RootConfig', so that
@@ -134,6 +139,7 @@ instance FromJSON LocalRootPeersGroup where
                   <$> parseJSON (Object o)
                   <*> pure hv
                   <*> o .:? "warmValency" .!= WarmValency v
+                  <*> o .:? "trustable" .!= IsNotTrustable
 
 instance ToJSON LocalRootPeersGroup where
   toJSON lrpg =
@@ -142,6 +148,7 @@ instance ToJSON LocalRootPeersGroup where
       , "advertise" .= rootAdvertise (localRoots lrpg)
       , "hotValency" .= hotValency lrpg
       , "warmValency" .= warmValency lrpg
+      , "trustable" .= trustable lrpg
       ]
 
 newtype LocalRootPeersGroups = LocalRootPeersGroups
@@ -164,22 +171,32 @@ instance FromJSON PublicRootPeers where
 instance ToJSON PublicRootPeers where
   toJSON = toJSON . publicRoots
 
-data NetworkTopology = RealNodeTopology !LocalRootPeersGroups ![PublicRootPeers] !UseLedger
+data NetworkTopology = RealNodeTopology { ntLocalRootPeersGroups :: !LocalRootPeersGroups
+                                        , ntPublicRootPeers      :: ![PublicRootPeers]
+                                        , ntUseLedgerPeers       :: !UseLedgerPeers
+                                        , ntUseBootstrapPeers    :: !UseBootstrapPeers
+                                        }
   deriving (Eq, Show)
 
 instance FromJSON NetworkTopology where
   parseJSON = withObject "NetworkTopology" $ \o ->
-                RealNodeTopology <$> (o .: "localRoots"                                     )
-                                 <*> (o .: "publicRoots"                                    )
-                                 <*> (o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger)
+                RealNodeTopology <$> (o .: "localRoots"                                  )
+                                 <*> (o .: "publicRoots"                                 )
+                                 <*> (o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers  )
+                                 <*> (o .:? "bootstrapPeers" .!= DontUseBootstrapPeers)
 
 instance ToJSON NetworkTopology where
   toJSON top =
     case top of
-      RealNodeTopology lrpg prp ul -> object [ "localRoots"         .= lrpg
-                                             , "publicRoots"        .= prp
-                                             , "useLedgerAfterSlot" .= ul
-                                             ]
+      RealNodeTopology { ntLocalRootPeersGroups
+                       , ntPublicRootPeers
+                       , ntUseLedgerPeers
+                       , ntUseBootstrapPeers
+                       } -> object [ "localRoots"         .= ntLocalRootPeersGroups
+                                   , "publicRoots"        .= ntPublicRootPeers
+                                   , "useLedgerAfterSlot" .= ntUseLedgerPeers
+                                   , "bootstrapPeers"     .= ntUseBootstrapPeers
+                                   ]
 
 --
 -- Legacy p2p topology file format
@@ -195,10 +212,12 @@ instance FromJSON (Legacy a) => FromJSON (Legacy [a]) where
 instance FromJSON (Legacy LocalRootPeersGroup) where
   parseJSON = withObject "LocalRootPeersGroup" $ \o -> do
                 hv@(HotValency v) <- o .: "hotValency"
+                wv <- o .:? "warmValency" .!= WarmValency v
                 fmap Legacy $ LocalRootPeersGroup
                   <$> o .: "localRoots"
                   <*> pure hv
-                  <*> pure (WarmValency v)
+                  <*> pure wv
+                  <*> o .: "trustable"
 
 instance FromJSON (Legacy LocalRootPeersGroups) where
   parseJSON = withObject "LocalRootPeersGroups" $ \o ->
@@ -213,9 +232,10 @@ instance FromJSON (Legacy PublicRootPeers) where
 instance FromJSON (Legacy NetworkTopology) where
   parseJSON = fmap Legacy
             . withObject "NetworkTopology" (\o ->
-                RealNodeTopology <$> fmap getLegacy (o .: "LocalRoots")
-                                 <*> fmap getLegacy (o .: "PublicRoots")
-                                 <*> (o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger))
+              RealNodeTopology <$> fmap getLegacy (o .: "LocalRoots")
+                               <*> fmap getLegacy (o .: "PublicRoots")
+                               <*> (o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers)
+                               <*> pure DontUseBootstrapPeers)
 
 -- | Read the `NetworkTopology` configuration from the specified file.
 --
@@ -228,7 +248,12 @@ readTopologyFile tr nc = do
     Left e -> return . Left $ handler e
     Right bs ->
       let bs' = LBS.fromStrict bs in
-      first handlerJSON (eitherDecode bs')
+      (case eitherDecode bs' of
+        Left err -> Left (handlerJSON err)
+        Right t
+          | isValidTrustedPeerConfiguration t -> Right t
+          | otherwise                         -> Left handlerBootstrap
+      )
       `combine`
       first handlerJSON (eitherDecode bs')
 
@@ -256,6 +281,13 @@ readTopologyFile tr nc = do
     , "configuration flag. "
     , Text.pack err
     ]
+  handlerBootstrap :: Text
+  handlerBootstrap = mconcat
+    [ "You seem to have not configured any trustable peers. "
+    , "This is important in order for the node to make progress "
+    , "in bootstrap mode. Make sure you provide at least one bootstrap peer "
+    , "source. "
+    ]
 
 readTopologyFileOrError :: Tracer IO (StartupTrace blk)
                         -> NodeConfiguration -> IO NetworkTopology
@@ -264,3 +296,25 @@ readTopologyFileOrError tr nc =
   >>= either (\err -> error $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: "
                            <> Text.unpack err)
              pure
+
+--
+-- Checking for chance of progress in bootstrap phase
+--
+
+-- | This function returns false if non-trustable peers are configured
+--
+isValidTrustedPeerConfiguration :: NetworkTopology -> Bool
+isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp) =
+    case ubp of
+      DontUseBootstrapPeers   -> True
+      UseBootstrapPeers []    -> anyTrustable
+      UseBootstrapPeers (_:_) -> True
+  where
+    anyTrustable =
+      any (\(LocalRootPeersGroup lr _ _ pt) -> case pt of
+              IsNotTrustable -> False
+              IsTrustable    -> not
+                              . null
+                              . rootAccessPoints
+                              $ lr
+          ) lprgs