Merge #4563

4563: New p2p topology file format r=coot a=coot

Fixes #4559.


Co-authored-by: Marcin Szamotulski <[email protected]>
Co-authored-by: olgahryniuk <[email protected]>

Author: 3 people

Diff for: cardano-node/ChangeLog.md

@@ -1,5 +1,29 @@
 # Changelog for cardano-node
 
+## vNext
+
+### node changes
+
+None
+
+### consensus changes
+
+None
+
+### network changes
+
+- New P2P topology file format. See [issue #4563][#4563] or the [config
+  files][understanding-config-files] documentation. The old P2P topology
+  format will be supported for next two major releases of the node (the last
+  supported major version will be `1.37`).
+
+[#4563]: https://github.com/input-output-hk/cardano-node/issues/4563
+[understanding-config-files]: https://github.com/input-output-hk/cardano-node/blob/master/doc/getting-started/understanding-config-files.md
+
+### ledger changes
+
+None
+
 ## 1.35.3 -- August 2022
 
 ### node changes
@@ -17,14 +41,14 @@ None
 
 ### ledger changes
 
-- Fix the alonzo UTxO rule to use alonzo minfee function (#2938)
+- Fix the Alonzo UTXO rule to use Alonzo minfee function (#2938)
 
 ## 1.35.2 -- July 2022 (not released)
 
 ### node changes
 
-- Bump Babbage to report it supports 7.1 in block header (#4211)
-- Update Plutus, Ledger, and Network dependencies (#4220)
+- Bump Babbage to report it supports 7.1 in the block header (#4211)
+- Update Plutus, ledger, and network dependencies (#4220)
 
 ### consensus changes
 
@@ -45,7 +69,7 @@ None
 
 ### ledger changes
 
-- Update plutus #2917
+- Update Plutus #2917
 
 ## 1.35.1 -- July 2022 (not released)
 
@@ -69,38 +93,38 @@ None
 
 ### node changes
 - RTS workaround converting SIGTERM into SIGINT (#3641)
-- Install a dummy SIGHUP handler for non p2p mode (#3896)
+- Install a dummy SIGHUP handler for non P2P mode (#3896)
 - Add --shutdown-on-slot-synced test and ensure ExitSuccess (#3670)
 - cardano-node: implement --shutdown-on-block-synced (#3932)
-- Update dependencies and pins. (#3700)
+- Update dependencies and pins (#3700)
 - Propagate protocol in block type (#3818)
 - Create VRF signing key file with correct permissions (#1948)
 - Fix for eliding of the ChainDB tracer (#4038)
 - Tracing infra updates:
   - Configuration structure rework, for better UX: (#3867)
   - Rework implementation to eliminate prototypes from trace definitions (#3731)
   - Fix tracing config to allow selection of the new tracing system (#3655)
-  - Register GC metrics. (#3858)
+  - Register GC metrics (#3858)
   - Metrics are no longer impacted by severities and frequency limits (#3876)
   - Porting ekg-direct metrics to new-tracing (#3873)
   - Node state data point extensions and fixes: (#3854, #3656)
   - Old peers tracing was erroneously called in new tracing (#3880)
   - Remove unused constraints from TraceConstraints (#3822)
-  - Properly init trace forwarding when needed. (#3634)
+  - Properly init trace forwarding when needed (#3634)
 - cardano-tracer:
   - Format fixes for forwarded traces: (#3640, #3654, #3660, #3671).
   - Test fixes: (#3714)
-  - Remove symlink, fix logs cut off. (#3930)
-  - Fix bug with empty line (#3962)
+  - Remove symlink, fix logs cut off (#3930)
+  - Fix the bug with empty line (#3962)
   - RTView, a web performance dashboard, as part of cardano-tracer (#3852)
   - RTView: CPU usage (GC + App) as pct, https by default, errors export (#3934)
 - Documentation updates;
   - Update Haskell installation method and mention libsecp256k1 (#3796)
   - Update cardano-node-cli-reference.md (#3630)
-  - Documentation improvements for new tracing. (#3834, #3842)
-  - Recommended system requirements. (#4005)
+  - Documentation improvements for new tracing (#3834, #3842)
+  - Recommended system requirements (#4005)
   - Further explain the `libsodium` installation (#4000)
-- Various workbench, build, testing and benchmarking infrastructure improvements. (#3638, #3643, #3705, #3789, #3812, #3824, #3941, #3851)
+- Various workbench, build, testing and benchmarking infrastructure improvements: (#3638, #3643, #3705, #3789, #3812, #3824, #3941, #3851)
 
 ### consensus changes
 - Block diffusion pipelining (#3688, #3742, #3752, #3688)
@@ -109,7 +133,7 @@ None
 - New function getOpCertCounters (#3781)
 - Bugfix: transaction validity intervals will actually be limited, as of Babbage (#3754)
 - Simplification: Babbage will run proper Praos protocol instead of Transitional Praos, since d will remain at 0 (#3595)
-- protocol: add `PraosProtocolSupportsNode` class (#3758)
+- Protocol: add `PraosProtocolSupportsNode` class (#3758)
 - Provide an `EpochInfo` that can fail to ledger. (#3770)
 - Add `COMPLETE` pragma for `FallingEdge` pattern synonym (#3766)
 - Simplification: remove stale handshake versions (#3696, #3699)

Diff for: cardano-node/cardano-node.cabal

@@ -215,6 +215,7 @@ test-suite cardano-node-test
   type:                 exitcode-stdio-1.0
 
   build-depends:        aeson             >= 1.5.6.0
+                      , bytestring
                       , cardano-api
                       , cardano-node
                       , cardano-prelude
@@ -226,6 +227,7 @@ test-suite cardano-node-test
                       , ouroboros-consensus
                       , ouroboros-network
                       , time
+                      , vector
 
   other-modules:        Test.Cardano.Node.FilePermissions
                         Test.Cardano.Node.Gen

Diff for: cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
 
 module Cardano.Node.Configuration.TopologyP2P
   ( TopologyError(..)
@@ -30,11 +33,14 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.Text as Text
 
+import "contra-tracer" Control.Tracer (Tracer, traceWith)
+
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Slotting.Slot (SlotNo (..))
 
 import           Cardano.Node.Configuration.NodeAddress
 import           Cardano.Node.Types
+import           Cardano.Node.Startup (StartupTrace (..))
 import           Cardano.Node.Configuration.Topology (TopologyError (..))
 
 import           Ouroboros.Network.NodeToNode (PeerAdvertise (..))
@@ -132,77 +138,120 @@ data LocalRootPeersGroup = LocalRootPeersGroup
   , valency    :: Int
   } deriving (Eq, Show)
 
+-- | Does not use the 'FromJSON' instance of 'RootConfig', so that
+-- 'accessPoints', 'advertise' and 'valency' fields are attached to the same
+-- object.
 instance FromJSON LocalRootPeersGroup where
   parseJSON = withObject "LocalRootPeersGroup" $ \o ->
                 LocalRootPeersGroup
-                  <$> o .: "localRoots"
+                  <$> parseJSON (Object o)
                   <*> o .: "valency"
 
 instance ToJSON LocalRootPeersGroup where
   toJSON lrpg =
     object
-      [ "localRoots" .= localRoots lrpg
-      , "valency"    .= valency lrpg
+      [ "accessPoints" .= rootAccessPoints (localRoots lrpg)
+      , "advertise" .= rootAdvertise (localRoots lrpg)
+      , "valency" .= valency lrpg
       ]
 
 newtype LocalRootPeersGroups = LocalRootPeersGroups
   { groups :: [LocalRootPeersGroup]
   } deriving (Eq, Show)
 
 instance FromJSON LocalRootPeersGroups where
-  parseJSON = withObject "LocalRootPeersGroups" $ \o ->
-                LocalRootPeersGroups
-                  <$> o .: "groups"
+  parseJSON = fmap LocalRootPeersGroups . parseJSONList
 
 instance ToJSON LocalRootPeersGroups where
-  toJSON lrpg =
-    object
-      [ "groups" .= groups lrpg
-      ]
+  toJSON = toJSONList . groups
 
 newtype PublicRootPeers = PublicRootPeers
   { publicRoots :: RootConfig
   } deriving (Eq, Show)
 
 instance FromJSON PublicRootPeers where
-  parseJSON = withObject "PublicRootPeers" $ \o ->
-                PublicRootPeers
-                  <$> o .: "publicRoots"
+  parseJSON = fmap PublicRootPeers . parseJSON
 
 instance ToJSON PublicRootPeers where
-  toJSON prp =
-    object
-      [ "publicRoots" .= publicRoots prp
-      ]
+  toJSON = toJSON . publicRoots
 
 data NetworkTopology = RealNodeTopology !LocalRootPeersGroups ![PublicRootPeers] !UseLedger
   deriving (Eq, Show)
 
 instance FromJSON NetworkTopology where
   parseJSON = withObject "NetworkTopology" $ \o ->
-                RealNodeTopology <$> (o .: "LocalRoots"                                     )
-                                 <*> (o .: "PublicRoots"                                    )
+                RealNodeTopology <$> (o .: "localRoots"                                     )
+                                 <*> (o .: "publicRoots"                                    )
                                  <*> (o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger)
 
 instance ToJSON NetworkTopology where
   toJSON top =
     case top of
-      RealNodeTopology lrpg prp ul -> object [ "LocalRoots"         .= lrpg
-                                             , "PublicRoots"        .= prp
+      RealNodeTopology lrpg prp ul -> object [ "localRoots"         .= lrpg
+                                             , "publicRoots"        .= prp
                                              , "useLedgerAfterSlot" .= ul
                                              ]
 
+--
+-- Legacy p2p topology file format
+--
+
+-- | A newtype wrapper which provides legacy 'FromJSON' instances.
+--
+newtype Legacy a = Legacy { getLegacy :: a }
+
+instance FromJSON (Legacy a) => FromJSON (Legacy [a]) where
+  parseJSON = fmap (Legacy . map getLegacy) . parseJSONList
+
+instance FromJSON (Legacy LocalRootPeersGroup) where
+  parseJSON = withObject "LocalRootPeersGroup" $ \o ->
+                fmap Legacy $ LocalRootPeersGroup
+                  <$> o .: "localRoots"
+                  <*> o .: "valency"
+
+instance FromJSON (Legacy LocalRootPeersGroups) where
+  parseJSON = withObject "LocalRootPeersGroups" $ \o ->
+                Legacy . LocalRootPeersGroups . getLegacy
+                  <$> o .: "groups"
+
+instance FromJSON (Legacy PublicRootPeers) where
+  parseJSON = withObject "PublicRootPeers" $ \o ->
+                Legacy . PublicRootPeers
+                  <$> o .: "publicRoots"
+
+instance FromJSON (Legacy NetworkTopology) where
+  parseJSON = fmap Legacy
+            . withObject "NetworkTopology" (\o ->
+                RealNodeTopology <$> fmap getLegacy (o .: "LocalRoots")
+                                 <*> fmap getLegacy (o .: "PublicRoots")
+                                 <*> (o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger))
+
 -- | Read the `NetworkTopology` configuration from the specified file.
 --
-readTopologyFile :: NodeConfiguration -> IO (Either Text NetworkTopology)
-readTopologyFile nc = do
+readTopologyFile :: Tracer IO (StartupTrace blk)
+                 -> NodeConfiguration -> IO (Either Text NetworkTopology)
+readTopologyFile tr nc = do
   eBs <- Exception.try $ BS.readFile (unTopology $ ncTopologyFile nc)
 
   case eBs of
     Left e -> return . Left $ handler e
-    Right bs -> return . first handlerJSON . eitherDecode $ LBS.fromStrict bs
+    Right bs ->
+      let bs' = LBS.fromStrict bs in
+      first handlerJSON (eitherDecode bs')
+      `combine`
+      first handlerJSON (eitherDecode bs')
 
  where
+  combine :: Either Text NetworkTopology
+          -> Either Text (Legacy NetworkTopology)
+          -> IO (Either Text NetworkTopology)
+  combine a b = case (a, b) of
+    (Right {}, _)     -> return a
+    (_, Right {})     -> traceWith tr NetworkConfigLegacy
+                      >> return (getLegacy <$> b)
+    (Left _, Left _)  -> -- ignore parsing error of legacy format
+                         return a
+
   handler :: IOException -> Text
   handler e = Text.pack $ "Cardano.Node.Configuration.Topology.readTopologyFile: "
                         ++ displayException e
@@ -214,9 +263,10 @@ readTopologyFile nc = do
                     \make sure that you correctly setup EnableP2P \
                     \configuration flag. " <> Text.pack err
 
-readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology
-readTopologyFileOrError nc =
-      readTopologyFile nc
+readTopologyFileOrError :: Tracer IO (StartupTrace blk)
+                        -> NodeConfiguration -> IO NetworkTopology
+readTopologyFileOrError tr nc =
+      readTopologyFile tr nc
   >>= either (\err -> panic $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: "
                            <> err)
              pure

Diff for: cardano-node/src/Cardano/Node/Run.hs

@@ -405,7 +405,7 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
       EnabledP2PMode -> do
         traceWith (startupTracer tracers)
                   (StartupP2PInfo (ncDiffusionMode nc))
-        nt <- TopologyP2P.readTopologyFileOrError nc
+        nt <- TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc
         let (localRoots, publicRoots) = producerAddresses nt
         traceWith (startupTracer tracers)
                 $ NetworkConfig localRoots
@@ -513,14 +513,15 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
                      developmentNtcVersions)
 
 #ifdef UNIX
+  -- only used when P2P is enabled
   updateTopologyConfiguration :: StrictTVar IO [(Int, Map RelayAccessPoint PeerAdvertise)]
                               -> StrictTVar IO [RelayAccessPoint]
                               -> StrictTVar IO UseLedgerAfter
                               -> Signals.Handler
   updateTopologyConfiguration localRootsVar publicRootsVar useLedgerVar =
     Signals.Catch $ do
       traceWith (startupTracer tracers) NetworkConfigUpdate
-      result <- try $ readTopologyFileOrError nc
+      result <- try $ TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc
       case result of
         Left (FatalError err) ->
           traceWith (startupTracer tracers)

Diff for: cardano-node/src/Cardano/Node/Startup.hs

@@ -89,6 +89,10 @@ data StartupTrace blk =
   --
   | NetworkConfigUpdateError Text
 
+  -- | Legacy topology file format is used.
+  --
+  | NetworkConfigLegacy
+
   -- | Log peer-to-peer network configuration, either on startup or when its
   -- updated.
   --

Diff for: cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs

@@ -132,6 +132,7 @@ namesStartupInfo = \case
   NetworkConfigUpdateUnsupported            -> ["NetworkConfigUpdateUnsupported"]
   NetworkConfigUpdateError {}               -> ["NetworkConfigUpdateError"]
   NetworkConfig {}                          -> ["NetworkConfig"]
+  NetworkConfigLegacy {}                    -> ["NetworkConfigLegacy"]
   P2PWarning {}                             -> ["P2PWarning"]
   P2PWarningDevelopementNetworkProtocols {} -> ["P2PWarningDevelopementNetworkProtocols"]
   WarningDevelopmentNetworkProtocols {}     -> ["WarningDevelopmentNetworkProtocols"]
@@ -211,6 +212,10 @@ instance ( Show (BlockNodeToNodeVersion blk)
                , "publicRoots" .= toJSON publicRoots
                , "useLedgerAfter" .= UseLedger useLedgerAfter
                ]
+  forMachine _dtal NetworkConfigLegacy =
+      mconcat [ "kind" .= String "NetworkConfigLegacy"
+              , "message" .= String p2pNetworkConfigLegacyMessage
+              ]
   forMachine _dtal P2PWarning =
       mconcat [ "kind" .= String "P2PWarning"
                , "message" .= String p2pWarningMessage ]
@@ -318,6 +323,7 @@ ppStartupInfoTrace (NetworkConfig localRoots publicRoots useLedgerAfter) =
                             ++ show (unSlotNo slotNo)
       DontUseLedger         -> "Don't use ledger to get root peers."
   ]
+ppStartupInfoTrace NetworkConfigLegacy = p2pNetworkConfigLegacyMessage
 
 ppStartupInfoTrace P2PWarning = p2pWarningMessage
 
@@ -364,6 +370,14 @@ p2pWarningDevelopmentNetworkProtocolsMessage :: Text
 p2pWarningDevelopmentNetworkProtocolsMessage =
     "peer-to-peer requires TestEnableDevelopmentNetworkProtocols to be set to True"
 
+p2pNetworkConfigLegacyMessage :: Text
+p2pNetworkConfigLegacyMessage =
+    pack
+  $ intercalate "\n"
+  [ "You are using legacy p2p topology file format."
+  , "See https://github.com/input-output-hk/cardano-node/issues/4559"
+  , "Note that the legacy p2p format will be removed in `1.37` release."
+  ]
 
 docStartupInfo :: Documented (StartupTrace blk)
 docStartupInfo = Documented [