Match Topology.hs with master branch Topology

- Added p2p-master branch types to TopologyP2P (e.g. UseLedger)
IntersectMBO · Oct 18, 2021 · 5d64086 · 5d64086
1 parent c7e38a0
commit 5d64086
Show file tree

Hide file tree

Showing 2 changed files with 52 additions and 61 deletions.
diff --git a/cardano-node/src/Cardano/Node/Configuration/Topology.hs b/cardano-node/src/Cardano/Node/Configuration/Topology.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Cardano.Node.Configuration.Topology
@@ -9,11 +8,8 @@ module Cardano.Node.Configuration.Topology
   , NodeHostIPv6Address(..)
   , NodeSetup(..)
   , RemoteAddress(..)
-  , PeerAdvertise(..)
-  , UseLedger(..)
   , nodeAddressToSockAddr
   , readTopologyFile
-  , readTopologyFileOrError
   , remoteAddressToNodeAddress
   )
 where
@@ -28,11 +24,8 @@ 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 (..))
 
 
@@ -47,25 +40,29 @@ data RemoteAddress = RemoteAddress
   -- ^ Either a dns address or an ip address.
   , raPort      :: !PortNumber
   -- ^ Port number of the destination.
-  , raAdvertise :: !PeerAdvertise
-  -- ^ Advertise the peer through gossip protocol.
+  , raValency :: !Int
   -- ^ If a DNS address is given valency governs
-  } deriving (Eq, Show)
+  -- to how many resolved IP addresses
+  -- should we maintain active (hot) connection;
+  -- if an IP address is given valency is used as
+  -- a Boolean value, @0@ means to ignore the address;
+  } deriving (Eq, Ord, Show)
 
 
 -- | Parse 'raAddress' field as an IP address; if it parses and the valency is
 -- non zero return corresponding NodeAddress.
 --
 remoteAddressToNodeAddress
   :: RemoteAddress
-  -> Either (NodeIPAddress,  PeerAdvertise)
-            (NodeDnsAddress, PeerAdvertise)
-remoteAddressToNodeAddress RemoteAddress { raAddress, raPort, raAdvertise } =
-    case readMaybe (Text.unpack raAddress) of
-      Nothing   -> Right ( NodeAddress (NodeHostDnsAddress raAddress) raPort
-                         , raAdvertise )
-      Just addr -> Left  ( NodeAddress (NodeHostIPAddress addr) raPort
-                         , raAdvertise )
+  -> Maybe (Either NodeIPAddress
+                   (NodeDnsAddress, Int))
+remoteAddressToNodeAddress (RemoteAddress _addrText _port 0) =
+    Nothing
+remoteAddressToNodeAddress (RemoteAddress addrText port valency) =
+    case readMaybe (Text.unpack addrText) of
+      Nothing   -> Just $ Right (NodeAddress (NodeHostDnsAddress addrText) port
+                                , valency)
+      Just addr -> Just $ Left  (NodeAddress (NodeHostIPAddress addr) port)
 
 
 instance Condense RemoteAddress where
@@ -77,46 +74,30 @@ instance FromJSON RemoteAddress where
     RemoteAddress
       <$> v .: "addr"
       <*> ((fromIntegral :: Int -> PortNumber) <$> v .: "port")
-      <*> (bool DoNotAdvertisePeer DoAdvertisePeer <$> v .: "advertise")
+      <*> v .: "valency"
 
 instance ToJSON RemoteAddress where
   toJSON ra =
     object
       [ "addr" .= raAddress ra
       , "port" .= (fromIntegral (raPort ra) :: Int)
-      , "advertise" .= case raAdvertise ra of
-                          DoNotAdvertisePeer -> False
-                          DoAdvertisePeer    -> True
+      , "valency" .= raValency ra
       ]
 
-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
   parseJSON = withObject "NodeSetup" $ \o ->
                 NodeSetup
-                  <$> o .:  "nodeId"
-                  <*> o .:  "nodeIPv4Address"
-                  <*> o .:  "nodeIPv6Address"
-                  <*> o .:  "producers"
-                  <*> o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger
+                  <$> o .: "nodeId"
+                  <*> o .: "nodeIPv4Address"
+                  <*> o .: "nodeIPv6Address"
+                  <*> o .: "producers"
 
 instance ToJSON NodeSetup where
   toJSON ns =
@@ -125,27 +106,23 @@ instance ToJSON NodeSetup where
       , "nodeIPv4Address" .= nodeIPv4Address ns
       , "nodeIPv6Address" .= nodeIPv6Address ns
       , "producers" .= producers ns
-      , "useLedgerAfterSlot" .= useLedger ns
       ]
 
 data NetworkTopology = MockNodeTopology ![NodeSetup]
-                     | RealNodeTopology ![RemoteAddress] !UseLedger
+                     | RealNodeTopology ![RemoteAddress]
   deriving (Eq, Show)
 
 instance FromJSON NetworkTopology where
   parseJSON = withObject "NetworkTopology" $ \o -> asum
-                [ MockNodeTopology <$> o .:  "MockProducers"
-                , RealNodeTopology <$> o .:  "Producers"
-                                   <*> o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger
+                [ MockNodeTopology <$> o .: "MockProducers"
+                , RealNodeTopology <$> o .: "Producers"
                 ]
 
 instance ToJSON NetworkTopology where
   toJSON top =
     case top of
       MockNodeTopology nss -> object [ "MockProducers" .= toJSON nss ]
-      RealNodeTopology ras ul -> object [ "Producers" .= toJSON ras
-                                        ,  "useLedgerAfterSlot" .= toJSON ul
-                                        ]
+      RealNodeTopology ras -> object [ "Producers" .= toJSON ras ]
 
 -- | Read the `NetworkTopology` configuration from the specified file.
 -- While running a real protocol, this gives your node its own address and
@@ -164,11 +141,8 @@ readTopologyFile nc = do
                         ++ displayException e
   handlerJSON :: String -> Text
   handlerJSON err = "Is your topology file formatted correctly? \
-                    \The port and valency fields should be numerical. " <> Text.pack err
-
-readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology
-readTopologyFileOrError nc =
-      readTopologyFile nc
-  >>= either (\err -> panic $ "Cardano.Node.Run.handleSimpleNode.readTopologyFile: "
-                           <> err)
-             pure
+                    \Expecting Non-P2P Topology file format. \
+                    \The port and valency fields should be numerical. \
+                    \If you specified the correct topology file \
+                    \make sure that you correctly setup EnableP2P \
+                    \configuration flag. " <> Text.pack err
diff --git a/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs b/cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs
@@ -31,13 +31,26 @@ 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           Cardano.Node.Configuration.Topology (TopologyError (..), UseLedger (..))
+import           Cardano.Node.Configuration.Topology (TopologyError (..))
 
 import           Ouroboros.Network.NodeToNode (PeerAdvertise (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..), RelayAddress (..))
 
+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)
@@ -145,8 +158,8 @@ data NetworkTopology = RealNodeTopology !LocalRootPeersGroups ![PublicRootPeers]
 
 instance FromJSON NetworkTopology where
   parseJSON = withObject "NetworkTopology" $ \o ->
-                RealNodeTopology <$> (o .:? "LocalRoots"         .!= LocalRootPeersGroups [])
-                                 <*> (o .:? "PublicRoots"        .!= [])
+                RealNodeTopology <$> (o .: "LocalRoots"                                     )
+                                 <*> (o .: "PublicRoots"                                    )
                                  <*> (o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger)
 
 instance ToJSON NetworkTopology where
@@ -174,11 +187,15 @@ readTopologyFile nc = do
                         ++ displayException e
   handlerJSON :: String -> Text
   handlerJSON err = "Is your topology file formatted correctly? \
-                    \The port and valency fields should be numerical. " <> Text.pack err
+                    \Expecting P2P Topology file format. \
+                    \The port and valency fields should be numerical. \
+                    \If you specified the correct topology file \
+                    \make sure that you correctly setup EnableP2P \
+                    \configuration flag. " <> Text.pack err
 
 readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology
 readTopologyFileOrError nc =
       readTopologyFile nc
-  >>= either (\err -> panic $ "Cardano.Node.Run.handleSimpleNode.readTopologyFile: "
+  >>= either (\err -> panic $ "Cardano.Node.Run.handleSimpleNodeP2P.readTopologyFile: "
                            <> err)
              pure