Rudimentary diffusion logging

IntersectMBO · Nov 19, 2020 · 84a830f · 84a830f
1 parent 3dca3af
commit 84a830f
Show file tree

Hide file tree

Showing 2 changed files with 49 additions and 23 deletions.
diff --git a/cabal.project b/cabal.project
@@ -131,7 +131,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-prelude
-  tag: bec71e48b027b2022e7be1fb7dd265bbbd80490b
+  tag: ed33688d3bc2283d90446cd59c0453f4cf94cb0a
   --sha256: 0jnxa9m84ka799a3i863sqvlygzf18941pi00d88ar45qdmzkagm
   subdir:
     cardano-prelude

diff --git 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
+  | BindingToSocket !FilePath !String
+  | ListeningToSocket !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,26 +318,32 @@ 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.
         (\(sd,sn) -> do
 
           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 $ BindingToSocket path (show sd)
+                 Snocket.bind sn sd $ Snocket.localAddressFromPath path
+                 traceWith dtDiffusionInitializationTracer $ ListeningToSocket 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