diffusion: generalise to an abstract peer address

ouroboros-network/src/Ouroboros/Network/Diffusion.hs

@@ -24,6 +24,19 @@ module Ouroboros.Network.Diffusion
 
 import           Data.Functor (void)
 
+import           Ouroboros.Network.NodeToNode
+                  ( RemoteAddress
+                  , Socket
+                  , NodeToNodeVersionData
+                  , NodeToNodeVersion
+                  )
+import           Ouroboros.Network.NodeToClient
+                  ( LocalAddress
+                  , LocalSocket
+                  , NodeToClientVersionData
+                  , NodeToClientVersion
+                  )
+
 import           Ouroboros.Network.Diffusion.Common as Common
 import qualified Ouroboros.Network.Diffusion.P2P    as P2P
 import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P
@@ -38,6 +51,8 @@ data P2P = P2P | NonP2P
 data ExtraTracers (p2p :: P2P) where
   P2PTracers
     :: P2P.TracersExtra
+           RemoteAddress  NodeToNodeVersion   NodeToNodeVersionData
+           LocalAddress   NodeToClientVersion NodeToClientVersionData
     -> ExtraTracers 'P2P
 
   NonP2PTracers
@@ -59,25 +74,31 @@ data ExtraArguments (p2p :: P2P) where
 
 -- | Application data which depend on p2p mode.
 --
-data ExtraApplications (p2p :: P2P) where
+data ExtraApplications (p2p :: P2P) n2nAddr where
   P2PApplications
-    :: P2P.ApplicationsExtra
-    -> ExtraApplications 'P2P
+    :: P2P.ApplicationsExtra ntnAddr
+    -> ExtraApplications 'P2P ntnAddr
 
   NonP2PApplications
     :: NonP2P.ApplicationsExtra
-    -> ExtraApplications 'NonP2P
+    -> ExtraApplications 'NonP2P ntnAddr
 
 
 -- | Run data diffusion in either 'P2P' or 'NonP2P' mode.
 --
 run :: forall (p2p :: P2P).
        Tracers
+         RemoteAddress NodeToNodeVersion
+         LocalAddress  NodeToClientVersion
     -> ExtraTracers p2p
     -> Arguments
+         Socket      RemoteAddress 
+         LocalSocket LocalAddress
     -> ExtraArguments p2p
     -> Applications
-    -> ExtraApplications p2p
+         RemoteAddress  NodeToNodeVersion   NodeToNodeVersionData
+         LocalAddress   NodeToClientVersion NodeToClientVersionData
+    -> ExtraApplications p2p RemoteAddress
     -> IO ()
 run tracers (P2PTracers tracersExtra)
             args (P2PArguments argsExtra)
@@ -92,4 +113,3 @@ run tracers (NonP2PTracers tracersExtra)
     NonP2P.run tracers tracersExtra
                args argsExtra
                apps appsExtra
-

ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs

@@ -12,16 +12,12 @@ module Ouroboros.Network.Diffusion.Common
 
 import           Data.List.NonEmpty (NonEmpty)
 import           Data.ByteString.Lazy (ByteString)
+import           Data.Typeable (Typeable)
 import           Data.Void (Void)
 
 import           Control.Exception (SomeException, Exception)
 import           Control.Tracer (Tracer, nullTracer)
 
-import           Network.Socket
-                  ( SockAddr
-                  , AddrInfo
-                  , Socket
-                  )
 import           Network.Mux
                   ( WithMuxBearer
                   , MuxTrace
@@ -39,88 +35,83 @@ import           Ouroboros.Network.PeerSelection.LedgerPeers
                   )
 import           Ouroboros.Network.NodeToNode
                   ( ConnectionId
-                  , NodeToNodeVersion
-                  , NodeToNodeVersionData
                   , AcceptedConnectionsLimit
                   , DiffusionMode
                   )
 import qualified Ouroboros.Network.NodeToNode as NodeToNode
 import           Ouroboros.Network.NodeToClient
-                  ( LocalAddress
-                  , Versions
-                  , NodeToClientVersion
-                  , NodeToClientVersionData
+                  ( Versions
                   )
 import qualified Ouroboros.Network.NodeToClient as NodeToClient
 
 -- TODO: use LocalAddress where appropriate rather than 'path'.
 --
-data InitializationTracer
-  = RunServer !(NonEmpty SockAddr)
-  | RunLocalServer !LocalAddress
-  | UsingSystemdSocket !FilePath
+data InitializationTracer ntnAddr ntcAddr
+  = RunServer !(NonEmpty ntnAddr)
+  | RunLocalServer !ntcAddr
+  | UsingSystemdSocket !ntcAddr
   -- Rename as 'CreateLocalSocket'
-  | CreateSystemdSocketForSnocketPath !FilePath
-  | CreatedLocalSocket !FilePath
-  | ConfiguringLocalSocket !FilePath !FileDescriptor
-  | ListeningLocalSocket !FilePath !FileDescriptor
-  | LocalSocketUp  !FilePath !FileDescriptor
+  | CreateSystemdSocketForSnocketPath !ntcAddr
+  | CreatedLocalSocket !ntcAddr
+  | ConfiguringLocalSocket !ntcAddr !FileDescriptor
+  | ListeningLocalSocket !ntcAddr !FileDescriptor
+  | LocalSocketUp  !ntcAddr !FileDescriptor
   -- Rename as 'CreateServerSocket'
-  | CreatingServerSocket !SockAddr
-  | ConfiguringServerSocket !SockAddr
-  | ListeningServerSocket !SockAddr
-  | ServerSocketUp !SockAddr
+  | CreatingServerSocket !ntnAddr
+  | ConfiguringServerSocket !ntnAddr
+  | ListeningServerSocket !ntnAddr
+  | ServerSocketUp !ntnAddr
   -- Rename as 'UnsupportedLocalSocketType'
-  | UnsupportedLocalSystemdSocket !SockAddr
+  | UnsupportedLocalSystemdSocket !ntnAddr
   -- Remove (this is impossible case), there's no systemd on Windows
   | UnsupportedReadySocketCase
   | DiffusionErrored SomeException
     deriving Show
 
 -- TODO: add a tracer for these misconfiguration
-data Failure = UnsupportedLocalSocketType
-             | UnsupportedReadySocket -- Windows only
-             | UnexpectedIPv4Address
-             | UnexpectedIPv6Address
-             | UnexpectedUnixAddress
-             | NoSocket
+data Failure ntnAddr = UnsupportedReadySocket -- Windows only
+                     | UnexpectedIPv4Address ntnAddr
+                     | UnexpectedIPv6Address ntnAddr
+                     | NoSocket
   deriving (Eq, Show)
 
-instance Exception Failure
+instance (Typeable ntnAddr, Show ntnAddr) => Exception (Failure ntnAddr)
 
 -- | Common DiffusionTracers interface between P2P and NonP2P
 --
-data Tracers = Tracers {
+data Tracers ntnAddr ntnVersion ntcAddr ntcVersion = Tracers {
       -- | Mux tracer
       dtMuxTracer
-        :: Tracer IO (WithMuxBearer (ConnectionId SockAddr) MuxTrace)
+        :: Tracer IO (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
 
       -- | Handshake protocol tracer
     , dtHandshakeTracer
-        :: Tracer IO NodeToNode.HandshakeTr
+        :: Tracer IO (NodeToNode.HandshakeTr ntnAddr ntnVersion)
 
       --
       -- NodeToClient tracers
       --
 
       -- | Mux tracer for local clients
     , dtLocalMuxTracer
-        :: Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
+        :: Tracer IO (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
 
       -- | Handshake protocol tracer for local clients
     , dtLocalHandshakeTracer
-        :: Tracer IO NodeToClient.HandshakeTr
+        :: Tracer IO (NodeToClient.HandshakeTr ntcAddr ntcVersion)
 
       -- | Diffusion initialisation tracer
     , dtDiffusionInitializationTracer
-        :: Tracer IO InitializationTracer
+        :: Tracer IO (InitializationTracer ntnAddr ntcAddr)
 
       -- | Ledger Peers tracer
     , dtLedgerPeersTracer
         :: Tracer IO TraceLedgerPeers
     }
 
-nullTracers :: Tracers
+
+nullTracers :: Tracers ntnAddr ntnVersion
+                       ntcAddr ntcVersion
 nullTracers = Tracers {
     dtMuxTracer                     = nullTracer
   , dtHandshakeTracer               = nullTracer
@@ -132,18 +123,18 @@ nullTracers = Tracers {
 
 -- | Common DiffusionArguments interface between P2P and NonP2P
 --
-data Arguments = Arguments {
+data Arguments ntnFd ntnAddr ntcFd ntcAddr = Arguments {
       -- | an @IPv4@ socket ready to accept connections or an @IPv4@ addresses
       --
-      daIPv4Address  :: Maybe (Either Socket AddrInfo)
+      daIPv4Address  :: Maybe (Either ntnFd ntnAddr)
 
       -- | an @IPV4@ socket ready to accept connections or an @IPv6@ addresses
       --
-    , daIPv6Address  :: Maybe (Either Socket AddrInfo)
+    , daIPv6Address  :: Maybe (Either ntnFd ntnAddr)
 
       -- | an @AF_UNIX@ socket ready to accept connections or an @AF_UNIX@
       -- socket path
-    , daLocalAddress :: Maybe (Either Socket FilePath)
+    , daLocalAddress :: Maybe (Either ntcFd ntcAddr)
 
       -- | parameters for limiting number of accepted connections
       --
@@ -156,36 +147,41 @@ data Arguments = Arguments {
 
 -- | Common DiffusionArguments interface between P2P and NonP2P
 --
-data Applications =
+-- TODO: we need initiator only mode for Daedalus, there's no reason why we
+-- should run a node-to-node server for it.
+--
+data Applications ntnAddr ntnVersion ntnVersionData
+                  ntcAddr ntcVersion ntcVersionData
+                  =
   Applications {
       -- | NodeToNode initiator applications for initiator only mode.
       --
       -- TODO: we should accept one or the other, but not both:
       -- 'daApplicationInitiatorMode', 'daApplicationInitiatorResponderMode'.
       --
       daApplicationInitiatorMode
-        :: Versions NodeToNodeVersion
-                    NodeToNodeVersionData
+        :: Versions ntnVersion
+                    ntnVersionData
                     (OuroborosBundle
-                      InitiatorMode SockAddr
+                      InitiatorMode ntnAddr
                       ByteString IO () Void)
 
       -- | NodeToNode initiator & responder applications for bidirectional mode.
       --
     , daApplicationInitiatorResponderMode
-        :: Versions NodeToNodeVersion
-                    NodeToNodeVersionData
+        :: Versions ntnVersion
+                    ntnVersionData
                     (OuroborosBundle
-                      InitiatorResponderMode SockAddr
+                      InitiatorResponderMode ntnAddr
                       ByteString IO () ())
 
       -- | NodeToClient responder application (server role)
       --
     , daLocalResponderApplication
-        :: Versions NodeToClientVersion
-                    NodeToClientVersionData
+        :: Versions ntcVersion
+                    ntcVersionData
                     (OuroborosApplication
-                      ResponderMode LocalAddress
+                      ResponderMode ntcAddr
                       ByteString IO Void ())
 
       -- | Interface used to get peers from the current ledger.