minor improvements to Connections iface

ouroboros-network/demo-connections/Main.hs

@@ -1,5 +1,9 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async
@@ -42,28 +46,36 @@ import System.IO.Error (isAlreadyExistsError, isAlreadyInUseError, ioeGetErrorTy
 -- If it passes 1, throw an error. Each thread can wait until the map is
 -- 1 for every connection pair.
 
+data Request (provenance :: Provenance) where
+  Request :: Request provenance
+
 data Node = forall sockType . Node
   { address :: SockAddr sockType
-  , server  :: Server ConnectionId Socket IO
-  , client  :: SockAddr sockType -> Client ConnectionId Socket IO
+  , server  :: Server ConnectionId Socket IO Request
+  , client  :: SockAddr sockType -> Client ConnectionId Socket IO Request
   }
 
 -- | When the continuation goes, there is a socket listening.
 node :: Some SockAddr -> (Node -> IO t) -> IO t
-node addr@(Some bindAddr) k = Server.server addr $ \server -> do
-  let client = Client.client bindAddr
-  k (Node bindAddr server client)
+node (Some (bindAddr :: SockAddr sockType)) k =
+  Server.server bindAddr (const Request) $ \server -> do
+    -- Type sig is required; GHC struggles with the higher-rank type (Client
+    -- has foralls).
+    let client :: SockAddr sockType -> Client ConnectionId Socket IO Request
+        client = \remoteAddr -> Client.client bindAddr remoteAddr Request
+    k (Node bindAddr server client)
 
 -- | What a node does when a new connection comes up. It'll just print a
 -- debug trace (thread safe) and then wait for a very long time so that the
 -- connection does not close.
 withConnection
-  :: Provenance
+  :: Initiated provenance
   -> ConnectionId
   -> Socket
-  -> IO (Connection.Decision () ())
-withConnection provenance connId _socket = do
-  Debug.traceM $ mconcat [show provenance, " : ", show connId]
+  -> Request provenance
+  -> IO (Connection.Decision provenance CannotReject ())
+withConnection initiated connId _socket Request = do
+  Debug.traceM $ mconcat [show initiated, " : ", show connId]
   pure $ Connection.Accept $ \_ -> pure (Handler () (threadDelay 1000000000))
 
 -- | For each node, we want to run its accept loop, and concurrently connect
@@ -122,7 +134,7 @@ main = do
   -- Get addresses for the same host on a bunch of different consecutive ports.
   addrs <- forM range $ \port -> do
     (addrInfo : _) <- Socket.getAddrInfo Nothing (Just host) (Just (show port))
-    pure (withSockType (Socket.addrAddress addrInfo))
+    pure (someSockType (Socket.addrAddress addrInfo))
   -- For each address, create servers and clients and package them up into
   -- `Node`s. Once the continuation is called, every node's server will be
   -- listening (but accept loops not running).

ouroboros-network/src/Ouroboros/Network/Connections/Socket/Types.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Ouroboros.Network.Connections.Socket.Types
   ( SockType (..)
@@ -12,6 +13,7 @@ module Ouroboros.Network.Connections.Socket.Types
   , makeConnectionId
   , connectionIdPair
   , Some (..)
+  , someSockType
   , withSockType
   , matchSockType
   , matchSockAddr
@@ -99,12 +101,18 @@ connectionIdPair connId = case connId of
 data Some (ty :: l -> Type) where
   Some :: ty x -> Some ty
 
-withSockType :: Socket.SockAddr -> Some SockAddr
-withSockType sockAddr = case sockAddr of
+someSockType :: Socket.SockAddr -> Some SockAddr
+someSockType sockAddr = case sockAddr of
   Socket.SockAddrInet  pn ha       -> Some (SockAddrIPv4 pn ha)
   Socket.SockAddrInet6 pn fi ha si -> Some (SockAddrIPv6 pn fi ha si)
   Socket.SockAddrUnix  st          -> Some (SockAddrUnix st)
 
+-- | Use a typical `SockAddr` as a type-annotated `SockAddr`, in a continuation
+-- which doesn't care about the socket type.
+withSockType :: Socket.SockAddr -> (forall sockType . SockAddr sockType -> t) -> t
+withSockType addr k = case someSockType addr of
+  Some sockAddr -> k sockAddr
+
 -- | Gives `Just` if the second socket address is of the same type as the
 -- first one.
 matchSockType :: SockAddr sockType -> Socket.SockAddr -> Maybe (SockAddr sockType)

ouroboros-network/src/Ouroboros/Network/Connections/Types.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Ouroboros.Network.Connections.Types
   ( Provenance (..)
@@ -10,6 +11,8 @@ module Ouroboros.Network.Connections.Types
   , Connections (..)
   , Resource (..)
 
+  , CannotReject
+
   , Client
   , Server
   , runClientWith
@@ -23,11 +26,17 @@ data Initiated (provenance :: Provenance) where
   Incoming :: Initiated Remote
   Outgoing :: Initiated Local
 
+deriving instance Show (Initiated provenance)
+
 data Decision (provenance :: Provenance) reject accept where
   Rejected :: reject provenance -> Decision provenance reject accept
   Accepted :: accept provenance -> Decision provenance reject accept
   deriving (Show)
 
+-- | Useful type with kind `Provenance -> Type` to express that rejection is
+-- not possible.
+data CannotReject (provenance :: Provenance) where
+
 data Resource provenance m r where
   -- | An existing resource, with a close action.
   -- Corresponds to remotely-initiated, incoming connections.