diff --git a/cardano-diffusion/lib/Cardano/Network/Diffusion.hs b/cardano-diffusion/lib/Cardano/Network/Diffusion.hs index a47de1475a1..32a24d7a96a 100644 --- a/cardano-diffusion/lib/Cardano/Network/Diffusion.hs +++ b/cardano-diffusion/lib/Cardano/Network/Diffusion.hs @@ -14,6 +14,8 @@ module Cardano.Network.Diffusion ( module Cardano.Network.Diffusion.Types , run + -- * Utils + , Diffusion.readIPAndPort ) where import Control.DeepSeq (NFData) diff --git a/cardano-diffusion/ping/Cardano/Network/Ping.hs b/cardano-diffusion/ping/Cardano/Network/Ping.hs index 6965a5024df..e2170707016 100644 --- a/cardano-diffusion/ping/Cardano/Network/Ping.hs +++ b/cardano-diffusion/ping/Cardano/Network/Ping.hs @@ -108,6 +108,7 @@ import System.IO qualified as IO import System.Random (initStdGen) import Text.Read (readMaybe) +import Cardano.Network.Diffusion (readIPAndPort) import Cardano.Network.Diffusion.Configuration (defaultChainSyncIdleTimeout) import Cardano.Network.NodeToClient qualified as NodeToClient import Cardano.Network.NodeToClient.Version @@ -147,7 +148,7 @@ data PingMode = -- ^ query handshake parameters deriving (Eq, Show) -type Port = Word +type Port = Socket.PortNumber -- | There are three stages for resolving addresses. -- @@ -335,43 +336,13 @@ argParser = addrParser :: Parser (Address (Unresolved SRVOrFilePathUnresolved)) addrParser = argument - ( uncurry IP <$> readIPv4AndPort - <|> uncurry IP <$> readIPv6AndPort + ( uncurry IP <$> readIPAndPort <|> readDomainNameOrFilePath ) ( help "List of IP/DNS/SRV address and ports or UNIX socket paths, e.g. 127.0.0.1:3001 [::1]:3001 example.org:3001." <> metavar "ADDRS" ) where - -- note: `Read` instances for `IP`, `IPv4`, `IPv6` expect no trailing - -- characters after the address, thus we need to find the split position - -- first. - - -- parse IPv4 address and port in a form `127.0.0.1:3001` - readIPv4AndPort :: ReadM (IP, Port) - readIPv4AndPort = - eitherReader $ \s -> do - case splitWith ':' s of - Nothing -> Left s - Just (addrStr, portStr) -> - maybe (Left s) Right $ - (,) <$> readMaybe addrStr - <*> readMaybe portStr - - -- parse IPv6 address and port in a form `[::1]:3001` or a UNIX file path - readIPv6AndPort :: ReadM (IP, Port) - readIPv6AndPort = - eitherReader $ \s -> - case s of - ('[':s') -> - case splitWith ']' s' of - Just (addrStr, ':' : portStr) -> - maybe (Left s) Right $ - (,) <$> readMaybe addrStr - <*> readMaybe portStr - _ -> Left s - _ -> Left s - readDomainNameOrFilePath :: ReadM (Address (Unresolved SRVOrFilePathUnresolved)) readDomainNameOrFilePath = eitherReader $ Right . mkAddress @@ -418,7 +389,7 @@ instance Exception AddressResolutionError where -- | Log messages to stderr. -- data PingWarning = AddressResolutionError AddressResolutionError - | DNSResolution DNS.Domain [IP] Word + | DNSResolution DNS.Domain [IP] Port | Error SomeException | ConnectError SockAddr SomeException diff --git a/ouroboros-network/changelog.d/20260803_173319_coot_diffusion_addresses.md b/ouroboros-network/changelog.d/20260803_173319_coot_diffusion_addresses.md new file mode 100644 index 00000000000..30da650264a --- /dev/null +++ b/ouroboros-network/changelog.d/20260803_173319_coot_diffusion_addresses.md @@ -0,0 +1,27 @@ + + +### Breaking + +- `Ouroboros.Network.Diffusion.Configuration` now has a single `dcAddresses :: + [Either ntnFd ntnAddr]` field, instead of the two `dcIPv[46]Address`. This + allows us to support multiple interfaces. Use + `Ouroboros.Network.Diffusion.readIPAddressAndPort` to parse `IP:Port` pari + from a command line. + + + diff --git a/ouroboros-network/demo/connection-manager.hs b/ouroboros-network/demo/connection-manager.hs index fb80bd5437c..2bb22200dff 100644 --- a/ouroboros-network/demo/connection-manager.hs +++ b/ouroboros-network/demo/connection-manager.hs @@ -198,7 +198,7 @@ withBidirectionalConnectionManager -> CM.ConnStateIdSupply m -> DiffTime -- protocol idle timeout -> DiffTime -- wait time timeout - -> Maybe peerAddr + -> [peerAddr] -> Random.StdGen -> ClientAndServerData -- ^ series of request possible to do with the bidirectional connection @@ -214,7 +214,7 @@ withBidirectionalConnectionManager snocket makeBearer socket connStateIdSupply protocolIdleTimeout timeWaitTimeout - localAddress + localAddresses stdGen ClientAndServerData { hotInitiatorRequests, @@ -261,8 +261,8 @@ withBidirectionalConnectionManager snocket makeBearer socket -- ConnectionManagerTrace tracer = ("cm",) `contramap` debugTracer, trTracer = ("cm-state",) `contramap` debugTracer, - ipv4Address = localAddress, - ipv6Address = Nothing, + ipv4Address = localAddresses, + ipv6Address = [], addressType = \_ -> Just IPv4Address, snocket = snocket, makeBearer = makeBearer, @@ -488,7 +488,7 @@ bidirectionalExperiment withBidirectionalConnectionManager snocket makeBearer socket0 connStateIdSupply protocolIdleTimeout timeWaitTimeout - (Just localAddr) stdGen clientAndServerData $ + [localAddr] stdGen clientAndServerData $ \connectionManager _serverAddr _inbGovAsync -> forever' $ do -- runInitiatorProtocols returns a list of results per each protocol -- in each bucket (warm \/ hot \/ established); but we run only one diff --git a/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Core.hs index 8fd696c052e..61200adac4c 100644 --- a/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Core.hs +++ b/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Core.hs @@ -95,14 +95,14 @@ data Arguments handlerTrace socket peerAddr handle handleError versionNumber ver -- bidirectional @TCP@ connections, it must be the same as the server -- listening @IPv4@ address. -- - ipv4Address :: Maybe peerAddr, + ipv4Address :: [peerAddr], -- | @IPv6@ address of the connection manager. If given, outbound -- connections to an @IPv6@ address will bound to it. To use -- bidirectional @TCP@ connections, it must be the same as the server -- listening @IPv6@ address. -- - ipv6Address :: Maybe peerAddr, + ipv6Address :: [peerAddr], addressType :: peerAddr -> Maybe AddressType, @@ -1470,10 +1470,10 @@ with args@Arguments { ) $ \socket -> do traceWith tracer (TrConnectionNotFound provenance peerAddr) - let addr = case addressType peerAddr of - Nothing -> Nothing - Just IPv4Address -> ipv4Address - Just IPv6Address -> ipv6Address + addr <- case addressType peerAddr of + Nothing -> pure Nothing + Just IPv4Address -> randomElement stdGenVar ipv4Address + Just IPv6Address -> randomElement stdGenVar ipv6Address configureSocket socket addr -- only bind to the ip address if: -- the diffusion is given `ipv4/6` addresses; @@ -2444,3 +2444,13 @@ data Trace peerAddr handlerTrace | TrUnexpectedlyFalseAssertion (AssertionLocation peerAddr) -- ^ This case is unexpected at call site. deriving Show + + +randomElement :: MonadSTM m + => StrictTVar m StdGen -> [a] -> m (Maybe a) +randomElement _ [] = pure Nothing +randomElement _ [a] = pure $ Just a +randomElement stdGenVar as = do + stdGen <- atomically $ stateTVar stdGenVar Random.splitGen + let (indx, _) = Random.uniformR (0, length as - 1) stdGen + return $ Just $ as List.!! indx diff --git a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs index 71ca7ec9517..125b04d08a2 100644 --- a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs +++ b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs @@ -725,10 +725,10 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap = in counterexample ("\nTransition Trace\n" ++ (intercalate "\n" . map show $ cmTrace)) (verifyTrace cmTrace) where - myAddress :: Maybe Addr + myAddress :: [Addr] myAddress = if bindToLocalAddress - then Just (TestAddress 0) - else Nothing + then [TestAddress 0] + else [] verifyTrace :: [TestAbstractTransitionTrace] -> Property verifyTrace = conjoin @@ -771,7 +771,7 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap = tracer, trTracer, ipv4Address = myAddress, - ipv6Address = Nothing, + ipv6Address = [], addressType = \_ -> Just IPv4Address, snocket = snocket, makeBearer = makeFDBearer, diff --git a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs index ad65e8a8bce..c74d78b13fa 100644 --- a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs +++ b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs @@ -767,7 +767,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer ( withInitiatorOnlyConnectionManager name simTimeouts nullTracer cmTracer stdGen snocket makeBearer connStateIdSupply - (Just localAddr) (mkNextRequests connVar) + [localAddr] (mkNextRequests connVar) timeLimitsHandshake acceptedConnLimit ( \ connectionManager -> connectionLoop SingInitiatorMode localAddr cc connectionManager Map.empty connVar @@ -805,7 +805,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer inboundTracer muxTracers debugTracer stdGen snocket makeBearer connStateIdSupply - (\_ -> pure ()) fd (Just localAddr) serverAcc + (\_ -> pure ()) fd [localAddr] serverAcc (mkNextRequests connVar) timeLimitsHandshake acceptedConnLimit @@ -823,7 +823,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer Unidirectional -> Job ( withInitiatorOnlyConnectionManager name simTimeouts trTracer cmTracer stdGen snocket makeBearer - connStateIdSupply (Just localAddr) + connStateIdSupply [localAddr] (mkNextRequests connVar) timeLimitsHandshake acceptedConnLimit @@ -2267,7 +2267,7 @@ prop_server_accept_error (Fixed rnd) (AbsIOError ioerr) = makeFDBearer connStateIdSupply (\_ -> pure ()) - socket0 (Just addr) + socket0 [addr] [accumulatorInit pdata] nextRequests noTimeLimitsHandshake diff --git a/ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs b/ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs index 904c2f58c57..6818a986b70 100644 --- a/ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs +++ b/ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs @@ -268,7 +268,7 @@ withInitiatorOnlyConnectionManager -- ^ series of request possible to do with the bidirectional connection -- manager towards some peer. -> CM.ConnStateIdSupply m - -> Maybe peerAddr + -> [peerAddr] -> TemperatureBundle (ConnectionId peerAddr -> STM m [req]) -- ^ Functions to get the next requests for a given connection -> ProtocolTimeLimits (Handshake UnversionedProtocol Term) @@ -280,7 +280,7 @@ withInitiatorOnlyConnectionManager -> m a) -> m a withInitiatorOnlyConnectionManager name timeouts trTracer tracer stdGen snocket makeBearer connStateIdSupply - localAddr nextRequests handshakeTimeLimits acceptedConnLimit k = do + localAddrs nextRequests handshakeTimeLimits acceptedConnLimit k = do mainThreadId <- myThreadId let muxTracers :: Mx.TracersWithBearer (ConnectionId peerAddr) m muxTracers = Mx.Tracers { @@ -317,8 +317,8 @@ withInitiatorOnlyConnectionManager name timeouts trTracer tracer stdGen snocket trTracer = (WithName name . fmap CM.abstractState) `contramap` trTracer, -- This is actually the low level bearer tracer - ipv4Address = localAddr, - ipv6Address = Nothing, + ipv4Address = localAddrs, + ipv6Address = [], addressType = \_ -> Just IPv4Address, snocket, makeBearer, @@ -459,7 +459,7 @@ withBidirectionalConnectionManager -> (socket -> m ()) -- ^ configure socket -> socket -- ^ listening socket - -> Maybe peerAddr + -> [peerAddr] -> acc -- ^ Initial state for the server -> TemperatureBundle (ConnectionId peerAddr -> STM m [req]) @@ -482,7 +482,7 @@ withBidirectionalConnectionManager name timeouts stdGen snocket makeBearer connStateIdSupply confSock socket - localAddress + localAddresses accumulatorInit nextRequests handshakeTimeLimits acceptedConnLimit k = do @@ -516,8 +516,8 @@ withBidirectionalConnectionManager name timeouts trTracer = (WithName name . fmap CM.abstractState) `contramap` trTracer, -- low level bearer tracer - ipv4Address = localAddress, - ipv6Address = Nothing, + ipv4Address = localAddresses, + ipv6Address = [], addressType = \_ -> Just IPv4Address, snocket, makeBearer, @@ -765,7 +765,7 @@ unidirectionalExperiment stdGen timeouts snocket makeBearer confSock socket clie nextReqs <- oneshotNextRequests clientAndServerData connStateIdSupply <- atomically $ CM.newConnStateIdSupply (Proxy @m) withInitiatorOnlyConnectionManager - "client" timeouts nullTracer nullTracer stdGen' snocket makeBearer connStateIdSupply Nothing nextReqs + "client" timeouts nullTracer nullTracer stdGen' snocket makeBearer connStateIdSupply [] nextReqs timeLimitsHandshake maxAcceptedConnectionsLimit $ \connectionManager -> withBidirectionalConnectionManager "server" timeouts @@ -773,7 +773,7 @@ unidirectionalExperiment stdGen timeouts snocket makeBearer confSock socket clie nullTracer Mx.nullTracers nullTracer stdGen'' snocket makeBearer connStateIdSupply - confSock socket Nothing + confSock socket [] [accumulatorInit clientAndServerData] noNextRequests timeLimitsHandshake @@ -859,7 +859,7 @@ bidirectionalExperiment nullTracer nullTracer nullTracer nullTracer Mx.nullTracers nullTracer stdGen' snocket makeBearer connStateIdSupply confSock - socket0 (Just localAddr0) + socket0 [localAddr0] [accumulatorInit clientAndServerData0] nextRequests0 noTimeLimitsHandshake @@ -869,7 +869,7 @@ bidirectionalExperiment nullTracer nullTracer nullTracer nullTracer Mx.nullTracers nullTracer stdGen'' snocket makeBearer connStateIdSupply confSock - socket1 (Just localAddr1) + socket1 [localAddr1] [accumulatorInit clientAndServerData1] nextRequests1 noTimeLimitsHandshake diff --git a/ouroboros-network/lib/Ouroboros/Network/Diffusion.hs b/ouroboros-network/lib/Ouroboros/Network/Diffusion.hs index 4ed434a2876..395d82f6078 100644 --- a/ouroboros-network/lib/Ouroboros/Network/Diffusion.hs +++ b/ouroboros-network/lib/Ouroboros/Network/Diffusion.hs @@ -17,6 +17,8 @@ module Ouroboros.Network.Diffusion , mkInterfaces , socketAddressType , module Ouroboros.Network.Diffusion.Types + -- * Utils + , readIPAndPort ) where @@ -41,9 +43,11 @@ import Data.Bits ((.|.)) import System.Posix.Files qualified as Unix #endif import Data.ByteString.Lazy (ByteString) +import Data.Either (partitionEithers) import Data.Hashable (Hashable) import Data.IP qualified as IP import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NonEmpty import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (catMaybes) @@ -84,9 +88,9 @@ import Ouroboros.Network.PeerSharing (PeerSharingRegistry (..)) import Ouroboros.Network.Protocol.Handshake import Ouroboros.Network.RethrowPolicy import Ouroboros.Network.Server qualified as Server -import Ouroboros.Network.Snocket (LocalAddress (..), LocalSocket (..), - RemoteAddress, localSocketFileDescriptor, makeLocalBearer, - makeSocketBearer') +import Ouroboros.Network.Snocket (AddressFamily (..), LocalAddress (..), + LocalSocket (..), RemoteAddress, localSocketFileDescriptor, + makeLocalBearer, makeSocketBearer') import Ouroboros.Network.Snocket qualified as Snocket import Ouroboros.Network.Socket (configureSocket, configureSystemdSocket) import Ouroboros.Network.Util (PrettyShow (..)) @@ -221,8 +225,7 @@ runM Interfaces , daSRVPrefix } Configuration - { dcIPv4Address - , dcIPv6Address + { dcAddresses , dcLocalAddress , dcAcceptedConnectionsLimit , dcMode = diffusionMode @@ -369,8 +372,8 @@ runM Interfaces CM.with CM.Arguments { CM.tracer = dtLocalConnectionManagerTracer, CM.trTracer = nullTracer, -- TODO: issue #3320 - CM.ipv4Address = Nothing, - CM.ipv6Address = Nothing, + CM.ipv4Address = [], + CM.ipv6Address = [], CM.addressType = const Nothing, CM.snocket = diNtcSnocket, CM.makeBearer = diNtcBearer, @@ -424,31 +427,24 @@ runM Interfaces epErrorDelay = daRepromoteErrorDelay } - ipv4Address - <- traverse (either (Snocket.getLocalAddr diNtnSnocket) pure) - dcIPv4Address - case ipv4Address of - Just addr | Just IPv4Address <- diNtnAddressType addr - -> pure () - | otherwise - -> throwIO (UnexpectedIPv4Address addr) - Nothing -> pure () - - ipv6Address - <- traverse (either (Snocket.getLocalAddr diNtnSnocket) pure) - dcIPv6Address - case ipv6Address of - Just addr | Just IPv6Address <- diNtnAddressType addr - -> pure () - | otherwise - -> throwIO (UnexpectedIPv6Address addr) - Nothing -> pure () - - lookupReqs <- case (ipv4Address, ipv6Address) of - (Just _ , Nothing) -> return RootPeersDNS.LookupReqAOnly - (Nothing, Just _ ) -> return RootPeersDNS.LookupReqAAAAOnly - (Just _ , Just _ ) -> return RootPeersDNS.LookupReqAAndAAAA - (Nothing, Nothing) -> throwIO NoSocket + addrs <- (either (traverse $ Snocket.getLocalAddr diNtnSnocket) pure) dcAddresses + let (ipv4Addresses, ipv6Addresses) = + partitionEithers + $ catMaybes + $ map (\addr -> + case Snocket.addrFamily diNtnSnocket addr of + SocketFamily Socket.AF_INET -> Just (Left addr) + SocketFamily Socket.AF_INET6 -> Just (Right addr) + _ -> Nothing + ) + $ NonEmpty.toList + $ addrs + + lookupReqs <- case (ipv4Addresses, ipv6Addresses) of + (_:_, [] ) -> return RootPeersDNS.LookupReqAOnly + ([] , _:_) -> return RootPeersDNS.LookupReqAAAAOnly + (_:_, _:_) -> return RootPeersDNS.LookupReqAAndAAAA + ([] , [] ) -> throwIO NoSocket localRootsVar <- newTVarIO mempty @@ -493,8 +489,8 @@ runM Interfaces CM.trTracer = fmap CM.abstractState `contramap` dtConnectionManagerTransitionTracer, - CM.ipv4Address, - CM.ipv6Address, + CM.ipv4Address = ipv4Addresses, + CM.ipv6Address = ipv6Addresses, CM.addressType = diNtnAddressType, CM.snocket = diNtnSnocket, CM.makeBearer = diNtnBearer, @@ -727,11 +723,7 @@ runM Interfaces withSockets tracer diNtnSnocket (\sock addr -> diNtnConfigureSocket sock (Just addr)) (\sock addr -> diNtnConfigureSystemdSocket sock addr) - ( catMaybes - [ dcIPv4Address - , dcIPv6Address - ] - ) + dcAddresses f -- run node-to-node server diff --git a/ouroboros-network/lib/Ouroboros/Network/Diffusion/Types.hs b/ouroboros-network/lib/Ouroboros/Network/Diffusion/Types.hs index 8e81ecb13c6..0bf164c42f6 100644 --- a/ouroboros-network/lib/Ouroboros/Network/Diffusion/Types.hs +++ b/ouroboros-network/lib/Ouroboros/Network/Diffusion/Types.hs @@ -470,13 +470,13 @@ data Arguments extraState extraDebugState extraFlags extraPeers -- | Required Diffusion Arguments to run network layer -- data Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr = Configuration { - -- | an @IPv4@ socket ready to accept connections or an @IPv4@ addresses + -- | A list of IPv4, IPv6 addresses or systemd activated sockets. -- - dcIPv4Address :: Maybe (Either ntnFd ntnAddr) - - -- | an @IPv6@ socket ready to accept connections or an @IPv6@ addresses + -- The diffusion will run an inbound server on each of the + -- sockets/addresses. When creating outbound connections, a random local + -- address/interface will be used by the connection manager. -- - , dcIPv6Address :: Maybe (Either ntnFd ntnAddr) + dcAddresses :: Either (NonEmpty ntnFd) (NonEmpty ntnAddr) -- | an @AF_UNIX@ socket ready to accept connections or an @AF_UNIX@ -- socket path or name of `named-pipe` on `Windows`. diff --git a/ouroboros-network/lib/Ouroboros/Network/Diffusion/Utils.hs b/ouroboros-network/lib/Ouroboros/Network/Diffusion/Utils.hs index f4b54bd9c1c..68bb5cb604e 100644 --- a/ouroboros-network/lib/Ouroboros/Network/Diffusion/Utils.hs +++ b/ouroboros-network/lib/Ouroboros/Network/Diffusion/Utils.hs @@ -9,20 +9,73 @@ module Ouroboros.Network.Diffusion.Utils ( withSockets , withLocalSocket + , readIPAndPort ) where +import Control.Applicative ((<|>)) import Control.Monad.Class.MonadThrow import Control.Tracer (Tracer, traceWith) +import Data.Bifunctor (first) +import Data.IP (IP (..), IPv4, IPv6) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NonEmpty import Data.Typeable (Typeable) +import Network.Socket (PortNumber) +import Options.Applicative (ReadM, eitherReader) +import Text.Read (readMaybe) import Ouroboros.Network.Snocket (FileDescriptor, Snocket) import Ouroboros.Network.Snocket qualified as Snocket import Ouroboros.Network.Diffusion.Types + +-- | optparse-applictive parser for `IPv4:Port` or `IPv6:Port`. +-- +-- note: `Read` instances for `IP`, `IPv4`, `IPv6` expect no trailing characters +-- after the address, thus we need custom parser which finds the split position +-- first. +readIPAndPort :: ReadM (IP, PortNumber) +readIPAndPort = (first IPv4 <$> readIPv4AndPort) + <|> (first IPv6 <$> readIPv6AndPort) + where + readIPv4AndPort :: ReadM (IPv4, PortNumber) + readIPv4AndPort = + eitherReader $ \s -> do + case splitWith ':' s of + Nothing -> Left s + Just (addrStr, portStr) -> + maybe (Left s) Right $ + (,) <$> readMaybe addrStr + <*> readMaybe portStr + + + -- parse IPv6 address and port in a form `[::1]:3001` or a UNIX file path + readIPv6AndPort :: ReadM (IPv6, PortNumber) + readIPv6AndPort = + eitherReader $ \s -> + case s of + ('[':s') -> + case splitWith ']' s' of + Just (addrStr, ':' : portStr) -> + maybe (Left s) Right $ + (,) <$> readMaybe addrStr + <*> readMaybe portStr + _ -> Left s + _ -> Left s + + splitWith :: Char -> String -> Maybe (String, String) + splitWith c = go "" + where + go _ [] + = Nothing + go !acc (a:as) + | a == c + = Just (reverse acc, as) + go !acc (a:as) + = go (a:acc) as + -- -- Socket utility functions -- @@ -36,13 +89,18 @@ withSockets :: forall m ntnFd ntnAddr ntcAddr a. -> Snocket m ntnFd ntnAddr -> (ntnFd -> ntnAddr -> m ()) -- ^ configure a socket -> (ntnFd -> ntnAddr -> m ()) -- ^ configure a systemd socket - -> [Either ntnFd ntnAddr] + -> Either (NonEmpty ntnFd) (NonEmpty ntnAddr) -> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a) -> m a -withSockets tracer sn + +-- create a socket for each address +withSockets tracer + sn configureSocket - configureSystemdSocket - addresses k = go [] addresses + _configureSystemdSocket + (Right addresses) k + = + go [] (NonEmpty.toList addresses) where go !acc (a : as) = withSocket a (\sa -> go (sa : acc) as) go [] [] = throwIO NoSocket @@ -50,15 +108,10 @@ withSockets tracer sn let acc' = NonEmpty.fromList (reverse acc) in (k $! (fst <$> acc')) $! (snd <$> acc') - withSocket :: Either ntnFd ntnAddr + withSocket :: ntnAddr -> ((ntnFd, ntnAddr) -> m a) -> m a - withSocket (Left sock) f = - do !addr <- Snocket.getLocalAddr sn sock - configureSystemdSocket sock addr - f (sock, addr) - `onException` Snocket.close sn sock - withSocket (Right addr) f = + withSocket addr f = bracket (do traceWith tracer (CreatingServerSocket addr) Snocket.open sn (Snocket.addrFamily sn addr)) @@ -72,6 +125,30 @@ withSockets tracer sn traceWith tracer $ ServerSocketUp addr f (sock, addr) +-- systemd activated socket +withSockets _tracer + sn + _configureSocket + configureSystemdSocket + (Left addresses) k + = + go [] (NonEmpty.toList addresses) + where + go !acc (a : as) = withSocket a (\sa -> go (sa : acc) as) + go [] [] = throwIO NoSocket + go !acc [] = + let acc' = NonEmpty.fromList (reverse acc) + in (k $! (fst <$> acc')) $! (snd <$> acc') + + withSocket :: ntnFd + -> ((ntnFd, ntnAddr) -> m a) + -> m a + withSocket sock f = + do !addr <- Snocket.getLocalAddr sn sock + configureSystemdSocket sock addr + f (sock, addr) + `onException` Snocket.close sn sock + withLocalSocket :: forall ntnAddr ntcFd ntcAddr m a. ( MonadThrow m diff --git a/ouroboros-network/ouroboros-network.cabal b/ouroboros-network/ouroboros-network.cabal index 40c057d1f61..47d95c54d9c 100644 --- a/ouroboros-network/ouroboros-network.cabal +++ b/ouroboros-network/ouroboros-network.cabal @@ -31,6 +31,11 @@ flag nightly manual: False default: False +flag optparse-applicative-fork + description: Use optparse-applicative-fork + manual: True + default: False + source-repository head type: git location: https://github.com/intersectmbo/ouroboros-network @@ -335,6 +340,15 @@ library directory, unix, + -- Until https://github.com/IntersectMBO/cardano-cli/pull/1390 is merged we + -- need to allow for `optparse-applicative-fork` + if flag(optparse-applicative-fork) + build-depends: + optparse-applicative-fork + else + build-depends: + optparse-applicative + library framework import: ghc-options visibility: public diff --git a/ouroboros-network/tests/lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/tests/lib/Test/Ouroboros/Network/Diffusion/Node.hs index 30d7823744f..22348b312a9 100644 --- a/ouroboros-network/tests/lib/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/tests/lib/Test/Ouroboros/Network/Diffusion/Node.hs @@ -52,6 +52,7 @@ import Control.Tracer (Tracer (..), nullTracer) import Codec.CBOR.Term qualified as CBOR import Data.Foldable as Foldable (foldl') import Data.IP (IP (..)) +import Data.List.NonEmpty qualified as NonEmpty import Data.Map (Map) import Data.Set (Set) import Data.Set qualified as Set @@ -458,8 +459,9 @@ run blockGeneratorArgs ni na mkArgs :: StrictTVar m (PublicPeerSelectionState NtNAddr) -> Diffusion.Configuration extraFlags m (NtNFD m) NtNAddr (NtCFD m) NtCAddr mkArgs dcPublicPeerSelectionVar = Diffusion.Configuration - { Diffusion.dcIPv4Address = Right <$> (ntnToIPv4 . aIPAddress) na - , Diffusion.dcIPv6Address = Right <$> (ntnToIPv6 . aIPAddress) na + { Diffusion.dcAddresses = Right $ NonEmpty.fromList $ + (ntnToIPv4 . aIPAddress $ na) + ++ (ntnToIPv6 . aIPAddress $ na) , Diffusion.dcLocalAddress = Nothing , Diffusion.dcAcceptedConnectionsLimit = aAcceptedLimits na @@ -482,15 +484,15 @@ run blockGeneratorArgs ni na --- Utils -ntnToIPv4 :: NtNAddr -> Maybe NtNAddr -ntnToIPv4 ntnAddr@(TestAddress (Node.EphemeralIPv4Addr _)) = Just ntnAddr -ntnToIPv4 ntnAddr@(TestAddress (Node.IPAddr (IPv4 _) _)) = Just ntnAddr -ntnToIPv4 (TestAddress _) = Nothing +ntnToIPv4 :: NtNAddr -> [NtNAddr] +ntnToIPv4 ntnAddr@(TestAddress (Node.EphemeralIPv4Addr _)) = [ntnAddr] +ntnToIPv4 ntnAddr@(TestAddress (Node.IPAddr (IPv4 _) _)) = [ntnAddr] +ntnToIPv4 (TestAddress _) = [] -ntnToIPv6 :: NtNAddr -> Maybe NtNAddr -ntnToIPv6 ntnAddr@(TestAddress (Node.EphemeralIPv6Addr _)) = Just ntnAddr -ntnToIPv6 ntnAddr@(TestAddress (Node.IPAddr (IPv6 _) _)) = Just ntnAddr -ntnToIPv6 (TestAddress _) = Nothing +ntnToIPv6 :: NtNAddr -> [NtNAddr] +ntnToIPv6 ntnAddr@(TestAddress (Node.EphemeralIPv6Addr _)) = [ntnAddr] +ntnToIPv6 ntnAddr@(TestAddress (Node.IPAddr (IPv6 _) _)) = [ntnAddr] +ntnToIPv6 (TestAddress _) = [] -- -- Constants