Merge #1928

1928: Refactor node addresses and updated ouroboros-network dependency r=dcoutts a=coot Updated version of `ouroboros-network`. This PR also includes a refactoring of address types that the node is using to a more consistent form. Co-authored-by: Thomas Winant <thomas@well-typed.com> Co-authored-by: Marcin Szamotulski <profunctor@pm.me>
IntersectMBO · Oct 13, 2020 · 8f2cb03 · 8f2cb03
2 parents 7b18c7a + 7d35cf3
commit 8f2cb03
Show file tree

Hide file tree

Showing 22 changed files with 602 additions and 301 deletions.
diff --git a/cabal.project b/cabal.project
@@ -288,85 +288,85 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: ouroboros-network
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: io-sim
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: ouroboros-consensus
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: ouroboros-consensus-byron
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: ouroboros-consensus-shelley
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: ouroboros-consensus-cardano
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: typed-protocols
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: typed-protocols-examples
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: ouroboros-network-framework
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: network-mux
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: io-sim-classes
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
-  --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+  tag: f6466b6473df52a42316061e495f0defa2a71442
+  --sha256: 0wvqrnhhlgx90cccsdgj94qgnvy6yb41x63gihdascx1cnhxzkik
   subdir: Win32-network
 
 constraints:

diff --git a/cardano-node-chairman/app/Cardano/Chairman.hs b/cardano-node-chairman/app/Cardano/Chairman.hs
@@ -13,8 +13,7 @@ module Cardano.Chairman (chairmanTest) where
 
 import           Cardano.Api.Protocol.Types (SomeNodeClientProtocol (..))
 import           Cardano.Node.Types (SocketPath (..))
-import           Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show)
-import           Control.Concurrent.Async (forConcurrently_)
+import           Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show, throwIO)
 import           Control.Monad (void)
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadST
@@ -281,7 +280,7 @@ runChairman tracer cfg networkMagic securityParam runningTime socketPaths = do
     let initialChains = Map.fromList
           [ (socketPath, AF.Empty AF.AnchorGenesis)
           | socketPath <- socketPaths]
-    chainsVar <- newTVarM initialChains
+    chainsVar <- newTVarIO initialChains
 
     void $ timeout runningTime $
       withIOManager $ \iomgr ->
@@ -448,7 +447,7 @@ checkConsensus
   -> STM m (ConsensusSuccess blk)
 checkConsensus chainsVar securityParam = do
   chainsSnapshot <- readTVar chainsVar
-  either throwM return $ consensusCondition securityParam chainsSnapshot
+  either throwIO return $ consensusCondition securityParam chainsSnapshot
 
 -- | Client Application
 localInitiatorNetworkApplication
@@ -475,7 +474,7 @@ localInitiatorNetworkApplication
   -> SecurityParam
   -> Versions
         NodeToClientVersion
-        DictVersion
+        (DictVersion NodeToClientVersion AgreedOptions)
         (OuroborosApplication InitiatorMode LocalAddress ByteString m () Void)
 localInitiatorNetworkApplication
     chairmanTracer chainSyncTracer

diff --git a/cardano-node-chairman/src/Testnet/ByronShelley.hs b/cardano-node-chairman/src/Testnet/ByronShelley.hs
@@ -65,6 +65,11 @@ import qualified Testnet.Conf as H
 {- HLINT ignore "Redundant <&>" -}
 {- HLINT ignore "Redundant flip" -}
 
+
+ifaceAddress :: String
+ifaceAddress = "127.0.0.1"
+
+
 testnet :: H.Conf -> H.Integration [String]
 testnet H.Conf {..} = do
   -- This script sets up a cluster that starts out in Byron, and can transition to Shelley.
@@ -146,7 +151,7 @@ testnet H.Conf {..} = do
       J.object
       [ "Producers" .= J.toJSON
         [ J.object
-          [ "addr" .= J.toJSON @String "127.0.0.1"
+          [ "addr" .= J.toJSON @String ifaceAddress
           , "port" .= J.toJSON @Int peerPort
           , "valency" .= J.toJSON @Int 1
           ]
@@ -630,6 +635,7 @@ testnet H.Conf {..} = do
         , "--shelley-kes-key", tempAbsPath </> node </> "shelley/kes.skey"
         , "--shelley-vrf-key", tempAbsPath </> node </> "shelley/vrf.skey"
         , "--shelley-operational-certificate", tempAbsPath </> node </> "shelley/node.cert"
+        , "--host-addr", ifaceAddress
         , "--port",  portString
         ] <&>
         ( \cp -> cp

diff --git a/cardano-node-chairman/src/Testnet/Shelley.hs b/cardano-node-chairman/src/Testnet/Shelley.hs
@@ -54,6 +54,11 @@ import qualified Testnet.Conf as H
 {- HLINT ignore "Redundant <&>" -}
 {- HLINT ignore "Redundant flip" -}
 
+
+ifaceAddress :: String
+ifaceAddress = "127.0.0.1"
+
+
 rewriteGenesisSpec :: Int -> Value -> Value
 rewriteGenesisSpec supply =
   rewriteObject
@@ -162,7 +167,7 @@ testnet H.Conf {..} = do
       J.object
       [ "Producers" .= J.toJSON
         [ J.object
-          [ "addr" .= J.toJSON @String "127.0.0.1"
+          [ "addr" .= J.toJSON @String ifaceAddress
           , "port" .= J.toJSON @Int peerPort
           , "valency" .= J.toJSON @Int 1
           ]
@@ -337,6 +342,7 @@ testnet H.Conf {..} = do
         , "--shelley-kes-key", tempAbsPath </> node </> "kes.skey"
         , "--shelley-vrf-key", tempAbsPath </> node </> "vrf.skey"
         , "--shelley-operational-certificate" , tempAbsPath </> node </> "node.cert"
+        , "--host-addr", ifaceAddress
         , "--port", portString
         , "--socket-path", IO.sprocketArgumentName sprocket
         ] <&>

diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -86,6 +86,7 @@ library
                      , cborg >= 0.2.4 && < 0.3
                      , containers
                      , directory
+                     , dns
                      , filepath
                      , generic-data
                      , hedgehog-extras
@@ -170,6 +171,7 @@ library cardano-node-config
                      , cardano-prelude
                      , cardano-slotting
                      , containers
+                     , dns
                      , filepath
                      , generic-data
                      , iohk-monitoring

diff --git a/cardano-node/chairman/Cardano/Chairman.hs b/cardano-node/chairman/Cardano/Chairman.hs
@@ -11,10 +11,9 @@
 
 module Cardano.Chairman (chairmanTest) where
 
-import           Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show)
+import           Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show, throwIO)
 import           Prelude (String, error, show)
 
-import           Control.Concurrent.Async (forConcurrently_)
 import           Control.Monad (void)
 import           Data.ByteString.Lazy (ByteString)
 import           Data.Coerce (coerce)
@@ -285,7 +284,7 @@ runChairman tracer cfg networkMagic securityParam runningTime socketPaths = do
 
     let initialChains = Map.fromList [ (socketPath, AF.Empty AF.AnchorGenesis)
                                      | socketPath <- socketPaths]
-    chainsVar <- newTVarM initialChains
+    chainsVar <- newTVarIO initialChains
 
     void $ timeout runningTime $
       withIOManager $ \iomgr ->
@@ -471,7 +470,7 @@ checkConsensus
     -> STM m (ConsensusSuccess blk)
 checkConsensus chainsVar securityParam = do
     chainsSnapshot <- readTVar chainsVar
-    either throwM return $ consensusCondition securityParam chainsSnapshot
+    either throwIO return $ consensusCondition securityParam chainsSnapshot
 
 
 --
@@ -500,7 +499,7 @@ localInitiatorNetworkApplication
   -> SocketPath
   -> ChainsVar m blk
   -> SecurityParam
-  -> Versions NodeToClientVersion DictVersion
+  -> Versions NodeToClientVersion (DictVersion NodeToClientVersion AgreedOptions)
               (OuroborosApplication InitiatorMode LocalAddress ByteString m () Void)
 localInitiatorNetworkApplication chairmanTracer chainSyncTracer
                                  localTxSubmissionTracer

diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs
@@ -35,10 +35,13 @@ import           Cardano.Node.Protocol.Types (Protocol (..))
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config
 import           Ouroboros.Network.Block (MaxSlotNo (..))
+import           Ouroboros.Network.NodeToNode (DiffusionMode (..))
 
 data NodeConfiguration
   = NodeConfiguration
-      {  ncNodeAddr        :: !(Maybe NodeAddress)
+      {  ncNodeIPv4Addr    :: !(Maybe NodeHostIPv4Address)
+      ,  ncNodeIPv6Addr    :: !(Maybe NodeHostIPv6Address)
+      ,  ncNodePortNumber  :: !(Maybe PortNumber)
           -- | Filepath of the configuration yaml file. This file determines
           -- all the configuration settings required for the cardano node
           -- (logging, tracing, protocol, slot length etc)
@@ -55,6 +58,7 @@ data NodeConfiguration
 
          -- Node parameters, not protocol-specific:
        , ncSocketPath     :: !(Maybe SocketPath)
+       , ncDiffusionMode  :: !DiffusionMode
 
          -- BlockFetch configuration
        , ncMaxConcurrencyBulkSync :: !(Maybe MaxConcurrencyBulkSync)
@@ -70,7 +74,9 @@ data NodeConfiguration
 
 data PartialNodeConfiguration
   = PartialNodeConfiguration
-      {  pncNodeAddr        :: !(Last NodeAddress)
+      {  pncNodeIPv4Addr    :: !(Last NodeHostIPv4Address)
+      ,  pncNodeIPv6Addr    :: !(Last NodeHostIPv6Address)
+      ,  pncNodePortNumber  :: !(Last PortNumber)
          -- | Filepath of the configuration yaml file. This file determines
          -- all the configuration settings required for the cardano node
          -- (logging, tracing, protocol, slot length etc)
@@ -87,6 +93,7 @@ data PartialNodeConfiguration
 
          -- Node parameters, not protocol-specific:
        , pncSocketPath     :: !(Last SocketPath)
+       , pncDiffusionMode  :: !(Last DiffusionMode)
 
          -- BlockFetch configuration
        , pncMaxConcurrencyBulkSync :: !(Last MaxConcurrencyBulkSync)
@@ -114,6 +121,8 @@ instance FromJSON PartialNodeConfiguration where
 
       -- Node parameters, not protocol-specific
       pncSocketPath' <- Last <$> v .:? "SocketPath"
+      pncDiffusionMode'
+        <- Last . fmap getDiffusionMode <$> v .:? "DiffusionMode"
 
       -- Blockfetch parameters
       pncMaxConcurrencyBulkSync' <- Last <$> v .:? "MaxConcurrencyBulkSync"
@@ -144,13 +153,16 @@ instance FromJSON PartialNodeConfiguration where
       pure PartialNodeConfiguration {
              pncProtocolConfig = pncProtocolConfig'
            , pncSocketPath = pncSocketPath'
+           , pncDiffusionMode = pncDiffusionMode'
            , pncMaxConcurrencyBulkSync = pncMaxConcurrencyBulkSync'
            , pncMaxConcurrencyDeadline = pncMaxConcurrencyDeadline'
            , pncViewMode = pncViewMode'
            , pncLoggingSwitch = Last $ Just pncLoggingSwitch'
            , pncLogMetrics = pncLogMetrics'
            , pncTraceConfig = pncTraceConfig'
-           , pncNodeAddr = mempty
+           , pncNodeIPv4Addr = mempty
+           , pncNodeIPv6Addr = mempty
+           , pncNodePortNumber = mempty
            , pncConfigFile = mempty
            , pncTopologyFile = mempty
            , pncDatabaseFile = mempty
@@ -239,9 +251,12 @@ defaultPartialNodeConfiguration =
     , pncDatabaseFile = Last . Just $ DbFile "mainnet/db/"
     , pncLoggingSwitch = Last $ Just True
     , pncSocketPath = mempty
+    , pncDiffusionMode = Last $ Just InitiatorAndResponderDiffusionMode
     , pncTopologyFile = Last . Just $ TopologyFile "configuration/cardano/mainnet-topology.json"
     , pncViewMode = Last $ Just SimpleView
-    , pncNodeAddr = mempty
+    , pncNodeIPv4Addr = mempty
+    , pncNodeIPv6Addr = mempty
+    , pncNodePortNumber = mempty
     , pncProtocolFiles = mempty
     , pncValidateDB = mempty
     , pncShutdownIPC = mempty
@@ -273,8 +288,11 @@ makeNodeConfiguration pnc = do
   loggingSwitch <- lastToEither "Missing LoggingSwitch" $ pncLoggingSwitch pnc
   logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc
   traceConfig <- lastToEither "Missing TraceConfig" $ pncTraceConfig pnc
+  diffusionMode <- lastToEither "Missing DiffusionMode" $ pncDiffusionMode pnc
   return $ NodeConfiguration
-             { ncNodeAddr = getLast $ pncNodeAddr pnc
+             { ncNodeIPv4Addr = getLast $ pncNodeIPv4Addr pnc
+             , ncNodeIPv6Addr = getLast $ pncNodeIPv6Addr pnc
+             , ncNodePortNumber = getLast $ pncNodePortNumber pnc
              , ncConfigFile = configFile
              , ncTopologyFile = topologyFile
              , ncDatabaseFile = databaseFile
@@ -284,6 +302,7 @@ makeNodeConfiguration pnc = do
              , ncShutdownOnSlotSynced = shutdownOnSlotSynced
              , ncProtocolConfig = protocolConfig
              , ncSocketPath = getLast $ pncSocketPath pnc
+             , ncDiffusionMode = diffusionMode
              , ncMaxConcurrencyBulkSync = getLast $ pncMaxConcurrencyBulkSync pnc
              , ncMaxConcurrencyDeadline = getLast $ pncMaxConcurrencyDeadline pnc
              , ncViewMode = viewMode