Integrate Bootstrap Peers

bench/locli/locli.cabal

@@ -121,7 +121,7 @@ library
                       , optparse-generic
                       , ouroboros-consensus
                       -- for Data.SOP.Strict:
-                      , ouroboros-network ^>= 0.10
+                      , ouroboros-network ^>= 0.11
                       , ouroboros-network-api
                       , process
                       , quiet

bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

@@ -74,6 +74,8 @@ import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError))
 import           Cardano.Benchmarking.Script.Types
 import           Cardano.Benchmarking.Version as Version
 
+import           Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))
+
 liftCoreWithEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ExceptT TxGenError IO x) -> ActionM (Either TxGenError x)
 liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall)
 
@@ -167,7 +169,7 @@ queryEra :: ActionM AnyCardanoEra
 queryEra = do
   localNodeConnectInfo <- getLocalConnectInfo
   chainTip  <- liftIO $ getLocalChainTip localNodeConnectInfo
-  ret <- liftIO $ queryNodeLocalState localNodeConnectInfo (Just $ chainTipToChainPoint chainTip) QueryCurrentEra
+  ret <- liftIO $ queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra
   case ret of
     Right era -> return era
     Left err -> liftTxGenError $ TxGenError $ show err
@@ -182,7 +184,7 @@ queryRemoteProtocolParameters = do
                  QueryInEra era (Ledger.PParams (ShelleyLedgerEra era))
               -> ActionM ProtocolParameters
     callQuery query@(QueryInShelleyBasedEra shelleyEra _) = do
-        res <- liftIO $ queryNodeLocalState localNodeConnectInfo (Just $ chainTipToChainPoint chainTip) (QueryInEra query)
+        res <- liftIO $ queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) (QueryInEra query)
         case res of
           Right (Right pp) -> do
             let pp' = fromLedgerPParams shelleyEra pp

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-01-24T13:20:47Z
-  , cardano-haskell-packages 2024-01-23T08:57:44Z
+  , hackage.haskell.org 2024-01-29T14:21:53Z
+  , cardano-haskell-packages 2024-01-28T20:24:54Z
 
 packages:
   cardano-git-rev
@@ -60,3 +60,51 @@ package plutus-scripts-bench
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
 -- `smtp-mail` should depend on `crypton-connection` rather than `connection`!
+
+source-repository-package
+    type: git
+    location: https://github.com/input-output-hk/ouroboros-network/
+    tag: a6a6eea03db7be888c88bef785a0088c00c48c33
+    subdir: ouroboros-network
+            ouroboros-network-framework
+            ouroboros-network-api
+            ouroboros-network-testing
+            ouroboros-network-protocols
+    --sha256: sha256-2aCQhTq2A2Y5w1CGCGzpssat1NRbhQ6Gd9jifyBvAig=
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/ouroboros-consensus/
+  tag: fdf80b0fdb1b329f7ddbf89caca5d4a7c5229612
+  subdir: ouroboros-consensus
+          ouroboros-consensus-diffusion
+  --sha256: sha256-2A6kcCDxdxZRFjMTDVL5nM8XYlqKALIh158Ctmq3SX8=
+
+-- Remove once QSM 0.9 is released, see
+-- https://github.com/stevana/quickcheck-state-machine/pull/31
+source-repository-package
+  type: git
+  location: https://github.com/stevana/quickcheck-state-machine
+  tag: 8e2bfb2214c7af1dae728180f2092effea6fbeb7
+  --sha256: sha256-SRcuyKs0Sz+GBsCKE16LSnH14p3q8ZLxkcVyfErvfPQ=
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/ekg-forward
+  tag: 8a745e90509731b518f5aee4b465ec4c294d1275
+  --sha256: sha256-PTjnPJ5gQcicbO7CxY8bLE+0rpgtgcz5ZMDbvb9kpRE=
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/cardano-api
+  tag: 5aa8c5bf8f6ec525534d50d7dfc91f6095604cbf
+  subdir: cardano-api
+  --sha256: sha256-9nkOh2KCeyJNwV0rtVQV0cHF7cz7U8tkzAj7P6zCFQ0=
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/cardano-cli
+  tag: 76c5de6dcbd5eb78cb2478fad09717100c437271
+  subdir: cardano-cli
+  --sha256: sha256-YtL85csGDoG9qAEDwSZonb0MikNu/RiCuv8he2Kjhu4=
+

cardano-node/cardano-node.cabal

@@ -171,7 +171,7 @@ library
                       , formatting
                       , generic-data
                       , hostname
-                      , io-classes >= 0.3
+                      , io-classes >= 1.3
                       , iohk-monitoring
                       , iproute
                       , lobemo-backend-aggregation
@@ -188,9 +188,9 @@ library
                       , ouroboros-consensus-diffusion ^>= 0.9
                       , ouroboros-consensus-protocol
                       , ouroboros-network-api
-                      , ouroboros-network ^>= 0.10
+                      , ouroboros-network ^>= 0.11.0
                       , ouroboros-network-framework
-                      , ouroboros-network-protocols ^>= 0.6
+                      , ouroboros-network-protocols ^>= 0.7.0
                       , 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

@@ -46,7 +46,9 @@ import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.Network ()
 import           Control.Applicative (Alternative (..))
 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 (..))
@@ -56,7 +58,7 @@ data NodeSetup = NodeSetup
   , nodeIPv4Address :: !(Maybe NodeIPv4Address)
   , nodeIPv6Address :: !(Maybe NodeIPv6Address)
   , producers       :: ![RootConfig]
-  , useLedger       :: !UseLedger
+  , useLedger       :: !UseLedgerPeers
   } deriving (Eq, Show)
 
 instance FromJSON NodeSetup where
@@ -66,7 +68,7 @@ instance FromJSON NodeSetup where
                   <*> o .:  "nodeIPv4Address"
                   <*> o .:  "nodeIPv6Address"
                   <*> o .:  "producers"
-                  <*> o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger
+                  <*> o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers
 
 instance ToJSON NodeSetup where
   toJSON ns =
@@ -88,7 +90,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
@@ -124,6 +126,9 @@ data LocalRootPeersGroup = LocalRootPeersGroup
   { localRoots :: RootConfig
   , hotValency :: HotValency
   , warmValency :: WarmValency
+  , peerTrustable :: 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
@@ -137,6 +142,7 @@ instance FromJSON LocalRootPeersGroup where
                   <$> parseJSON (Object o)
                   <*> pure hv
                   <*> o .:? "warmValency" .!= WarmValency v
+                  <*> o .:? "peerTrustable" .!= IsNotTrustable
 
 instance ToJSON LocalRootPeersGroup where
   toJSON lrpg =
@@ -145,6 +151,7 @@ instance ToJSON LocalRootPeersGroup where
       , "advertise" .= rootAdvertise (localRoots lrpg)
       , "hotValency" .= hotValency lrpg
       , "warmValency" .= warmValency lrpg
+      , "peerTrustable" .= peerTrustable lrpg
       ]
 
 newtype LocalRootPeersGroups = LocalRootPeersGroups
@@ -167,22 +174,24 @@ instance FromJSON PublicRootPeers where
 instance ToJSON PublicRootPeers where
   toJSON = toJSON . publicRoots
 
-data NetworkTopology = RealNodeTopology !LocalRootPeersGroups ![PublicRootPeers] !UseLedger
+data NetworkTopology = RealNodeTopology !LocalRootPeersGroups ![PublicRootPeers] !UseLedgerPeers !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 .:? "useBootstrapPeers" .!= DontUseBootstrapPeers)
 
 instance ToJSON NetworkTopology where
   toJSON top =
     case top of
-      RealNodeTopology lrpg prp ul -> object [ "localRoots"         .= lrpg
-                                             , "publicRoots"        .= prp
-                                             , "useLedgerAfterSlot" .= ul
-                                             ]
+      RealNodeTopology lrpg prp ul ubp -> object [ "localRoots"         .= lrpg
+                                                 , "publicRoots"        .= prp
+                                                 , "useLedgerAfterSlot" .= ul
+                                                 , "useBootstrapPeers"  .= ubp
+                                                 ]
 
 --
 -- Legacy p2p topology file format
@@ -198,10 +207,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 .: "peerTrustable"
 
 instance FromJSON (Legacy LocalRootPeersGroups) where
   parseJSON = withObject "LocalRootPeersGroups" $ \o ->
@@ -216,9 +227,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.
 --
@@ -231,7 +243,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
+          | hasBootstrapChance t -> Right t
+          | otherwise            -> Left handlerBootstrap
+      )
       `combine`
       first handlerJSON (eitherDecode bs')
 
@@ -259,6 +276,14 @@ readTopologyFile tr nc = do
     , "configuration flag. "
     , Text.pack err
     ]
+  handlerBootstrap :: Text
+  handlerBootstrap = mconcat
+    [ "You seem to have not configured any trustable peer. "
+    , "This is important in order for the node to make progress "
+    , "in bootstrap mode. Make sure you provide at least one bootstrap peer "
+    , "source (by setting useBootstrapPeer topology file option) "
+    , "or mark a local root peer as trustable. "
+    ]
 
 readTopologyFileOrError :: Tracer IO (StartupTrace blk)
                         -> NodeConfiguration -> IO NetworkTopology
@@ -267,3 +292,22 @@ 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
+--
+hasBootstrapChance :: NetworkTopology -> Bool
+hasBootstrapChance (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp) =
+    case ubp of
+      DontUseBootstrapPeers   -> True
+      UseBootstrapPeers []    -> anyTrustable
+      UseBootstrapPeers (_:_) -> True
+  where
+    anyTrustable =
+      any (\(LocalRootPeersGroup _ _ _ pt) -> case pt of
+              IsNotTrustable -> False
+              IsTrustable    -> True
+          ) lprgs