diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion.hs index 3710c9872c1..023f4762e21 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} module Ouroboros.Network.Diffusion ( DiffusionTracers (..) @@ -15,12 +16,13 @@ module Ouroboros.Network.Diffusion , IPSubscriptionTarget (..) , DnsSubscriptionTarget (..) , ConnectionId (..) + , DiffusionInitializationTracer(..) ) where import qualified Control.Concurrent.Async as Async import Control.Exception -import Control.Tracer (Tracer) +import Control.Tracer (Tracer, traceWith) import Data.Functor (void) import Data.Maybe (maybeToList) import Data.Void (Void) @@ -60,9 +62,22 @@ import Ouroboros.Network.Subscription.Dns import Ouroboros.Network.Subscription.Worker (LocalAddresses (..)) import Ouroboros.Network.Tracers +data DiffusionInitializationTracer + = RunServer + | RunLocalServer + | CreatingSystemdSocketForUnixPath !FilePath + | CreateSystemdSocketForSnocketPath !FilePath + | CreatedSystemdSocketForSnocketPath !FilePath + | BindingLocalSocket !FilePath !String + | ListeningLocalSocket !FilePath !String + | CreatingServerSocket !SockAddr + | BindingServerSocket !SockAddr + | UnsupportedSystemdSocket !SockAddr + deriving (Eq, Show) + data DiffusionTracers = DiffusionTracers { dtIpSubscriptionTracer :: Tracer IO (WithIPList (SubscriptionTrace SockAddr)) - -- ^ IP subscription tracer + -- ^ IP subscription tracer , dtDnsSubscriptionTracer :: Tracer IO (WithDomainName (SubscriptionTrace SockAddr)) -- ^ DNS subscription tracer , dtDnsResolverTracer :: Tracer IO (WithDomainName DnsTrace) @@ -79,6 +94,7 @@ data DiffusionTracers = DiffusionTracers { , dtLocalErrorPolicyTracer :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace) , dtAcceptPolicyTracer :: Tracer IO AcceptConnectionsPolicyTrace -- ^ Trace rate limiting of accepted connections + , dtDiffusionInitializationTracer :: Tracer IO DiffusionInitializationTracer } @@ -139,7 +155,7 @@ instance Exception DiffusionFailure runDataDiffusion :: DiffusionTracers - -> DiffusionArguments + -> DiffusionArguments -> DiffusionApplications RemoteAddress LocalAddress NodeToNodeVersionData NodeToClientVersionData @@ -156,7 +172,6 @@ runDataDiffusion tracers } applications@DiffusionApplications { daErrorPolicies } = withIOManager $ \iocp -> do - let -- snocket for remote communication. snocket :: SocketSnocket snocket = Snocket.socketSnocket iocp @@ -215,6 +230,7 @@ runDataDiffusion tracers , dtErrorPolicyTracer , dtLocalErrorPolicyTracer , dtAcceptPolicyTracer + , dtDiffusionInitializationTracer } = tracers -- @@ -291,7 +307,7 @@ runDataDiffusion tracers runLocalServer :: IOManager -> NetworkMutableState LocalAddress -> IO () - runLocalServer iocp networkLocalState = + runLocalServer iocp networkLocalState = do bracket ( case daLocalAddress of @@ -302,15 +318,18 @@ runDataDiffusion tracers Left sd -> do a <- Socket.getSocketName sd case a of - (Socket.SockAddrUnix path) -> + (Socket.SockAddrUnix path) -> do + traceWith dtDiffusionInitializationTracer $ CreatingSystemdSocketForUnixPath path return (sd, Snocket.localSnocket iocp path) - _ -> - -- TODO: This should be logged. - throwIO UnsupportedLocalSocketType + unsupportedAddr -> do + traceWith dtDiffusionInitializationTracer $ UnsupportedSystemdSocket unsupportedAddr + throwIO UnsupportedLocalSocketType #endif - Right a -> do - let sn = Snocket.localSnocket iocp a - sd <- Snocket.open sn (Snocket.addrFamily sn $ Snocket.localAddressFromPath a) + Right addr -> do + let sn = Snocket.localSnocket iocp addr + traceWith dtDiffusionInitializationTracer $ CreateSystemdSocketForSnocketPath addr + sd <- Snocket.open sn (Snocket.addrFamily sn $ Snocket.localAddressFromPath addr) + traceWith dtDiffusionInitializationTracer $ CreatedSystemdSocketForSnocketPath addr return (sd, sn) ) (\(sd,sn) -> Snocket.close sn sd) -- We close the socket here, even if it was provided for us. @@ -318,10 +337,13 @@ runDataDiffusion tracers case daLocalAddress of Left _ -> pure () -- If a socket was provided it should be ready to accept - Right a -> do - Snocket.bind sn sd $ Snocket.localAddressFromPath a + Right path -> do + traceWith dtDiffusionInitializationTracer $ BindingLocalSocket path (show sd) + Snocket.bind sn sd $ Snocket.localAddressFromPath path + traceWith dtDiffusionInitializationTracer $ ListeningLocalSocket path (show sd) Snocket.listen sn sd + traceWith dtDiffusionInitializationTracer RunLocalServer void $ NodeToClient.withServer sn (NetworkServerTracers @@ -336,22 +358,26 @@ runDataDiffusion tracers ) runServer :: SocketSnocket -> NetworkMutableState SockAddr -> Either Socket.Socket SockAddr -> IO () - runServer sn networkState address = + runServer sn networkState address = do bracket ( case address of Left sd -> return sd - Right a -> Snocket.open sn (Snocket.addrFamily sn a) + Right addr -> do + traceWith dtDiffusionInitializationTracer $ CreatingServerSocket addr + Snocket.open sn (Snocket.addrFamily sn addr) ) (Snocket.close sn) -- We close the socket here, even if it was provided for us. (\sd -> do case address of Left _ -> pure () -- If a socket was provided it should be ready to accept - Right a -> do - Snocket.bind sn sd a + Right addr -> do + traceWith dtDiffusionInitializationTracer $ BindingServerSocket addr + Snocket.bind sn sd addr Snocket.listen sn sd + traceWith dtDiffusionInitializationTracer RunServer void $ NodeToNode.withServer sn (NetworkServerTracers