Merge Interface module types into Types module

On the other hand, these do belong together.

network-mux/network-mux.cabal

@@ -51,7 +51,6 @@ library
                        Network.Mux.Codec
                        Network.Mux.Egress
                        Network.Mux.Ingress
-                       Network.Mux.Interface
                        Network.Mux.Time
                        Network.Mux.Types
                        Network.Mux.Trace
@@ -73,7 +72,6 @@ test-suite test-network-mux
                        Network.Mux.Codec
                        Network.Mux.Egress
                        Network.Mux.Ingress
-                       Network.Mux.Interface
                        Network.Mux.Time
                        Network.Mux.Types
                        Network.Mux.Trace

network-mux/src/Network/Mux.hs

@@ -48,7 +48,6 @@ import           GHC.Stack
 import           Text.Printf
 
 import           Network.Mux.Channel
-import           Network.Mux.Interface
 import           Network.Mux.Egress  as Egress
 import           Network.Mux.Ingress as Ingress
 import           Network.Mux.Types

network-mux/src/Network/Mux/Types.hs

@@ -1,9 +1,21 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving#-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Network.Mux.Types (
       MiniProtocolLimits (..)
     , MiniProtocolNum (..)
     , MiniProtocolMode (..)
+
+    , AppType (..)
+    , HasInitiator
+    , HasResponder
+    , MuxApplication (..)
+    , MuxMiniProtocol (..)
+    , RunMiniProtocol (..)
+
     , MuxBearer (..)
     , muxBearerAsControlChannel
     , MuxSDU (..)
@@ -13,16 +25,17 @@ module Network.Mux.Types (
 
 import           Prelude hiding (read)
 
-import qualified Data.ByteString.Lazy as BL
+import           Data.Void (Void)
 import           Data.Functor (void)
 import           Data.Int
 import           Data.Ix (Ix (..))
 import           Data.Word
+import qualified Data.ByteString.Lazy as BL
 
 import           Control.Monad.Class.MonadTime
 
-import           Network.TypedProtocol.Channel (Channel(Channel))
-import qualified Network.TypedProtocol.Channel as Channel
+import           Network.Mux.Channel (Channel)
+import qualified Network.TypedProtocol.Channel as TypedProtocol
 
 newtype RemoteClockModel
   = RemoteClockModel { unRemoteClockModel :: Word32 }
@@ -64,6 +77,76 @@ data MiniProtocolLimits =
      }
 
 
+-- $interface
+--
+-- To run a node you will also need a bearer and a way to run a server, see
+--
+-- * @'Ouroboros.Network.Socket'@ module provides a socket based bearer and
+--   a server that accepts connections and allows to connect to remote peers.
+--
+-- * @'Ouroboros.Network.Pipe'@ module provides a pipe based bearer with
+--   a function that runs the mux layer on it.
+--
+
+data AppType where
+    InitiatorApp             :: AppType
+    ResponderApp             :: AppType
+    InitiatorAndResponderApp :: AppType
+
+type family HasInitiator (appType :: AppType) :: Bool where
+    HasInitiator InitiatorApp             = True
+    HasInitiator ResponderApp             = False
+    HasInitiator InitiatorAndResponderApp = True
+
+type family HasResponder (appType :: AppType) :: Bool where
+    HasResponder InitiatorApp             = False
+    HasResponder ResponderApp             = True
+    HasResponder InitiatorAndResponderApp = True
+
+-- | Application run by mux layer.
+--
+-- * enumeration of client application, e.g. a wallet application communicating
+--   with a node using ChainSync and TxSubmission protocols; this only requires
+--   to run client side of each protocol.
+--
+-- * enumeration of server applications: this application type is mostly useful
+--   tests.
+--
+-- * enumeration of both client and server applications, e.g. a full node
+--   serving downstream peers using server side of each protocol and getting
+--   updates from upstream peers using client side of each of the protocols.
+--
+newtype MuxApplication (appType :: AppType) peerid m a b =
+        MuxApplication [MuxMiniProtocol appType peerid m a b]
+
+data MuxMiniProtocol (appType :: AppType) peerid m a b =
+     MuxMiniProtocol {
+       miniProtocolNum    :: !MiniProtocolNum,
+       miniProtocolLimits :: !MiniProtocolLimits,
+       miniProtocolRun    :: !(RunMiniProtocol appType peerid m a b)
+     }
+
+data RunMiniProtocol (appType :: AppType) peerid m a b where
+  InitiatorProtocolOnly
+    -- Initiator application; most simple application will be @'runPeer'@ or
+    -- @'runPipelinedPeer'@ supplied with a codec and a @'Peer'@ for each
+    -- @ptcl@.  But it allows to handle resources if just application of
+    -- @'runPeer'@ is not enough.  It will be run as @'ModeInitiator'@.
+    :: (peerid -> Channel m -> m a)
+    -> RunMiniProtocol InitiatorApp peerid m a Void
+
+  ResponderProtocolOnly
+    -- Responder application; similarly to the @'MuxInitiatorApplication'@ but it
+    -- will be run using @'ModeResponder'@.
+    :: (peerid -> Channel m -> m a)
+    -> RunMiniProtocol ResponderApp peerid m Void a
+
+  InitiatorAndResponderProtocol
+    -- Initiator and server applications.
+    :: (peerid -> Channel m -> m a)
+    -> (peerid -> Channel m -> m b)
+    -> RunMiniProtocol InitiatorAndResponderApp peerid m a b
+
 --
 -- Mux internal types
 --
@@ -103,10 +186,11 @@ data MuxBearer m = MuxBearer {
 muxBearerAsControlChannel
   :: MuxBearer IO
   -> MiniProtocolMode
-  -> Channel IO BL.ByteString
-muxBearerAsControlChannel bearer mode = Channel {
-        Channel.send = send,
-        Channel.recv = recv
+  -> TypedProtocol.Channel IO BL.ByteString
+muxBearerAsControlChannel bearer mode =
+      TypedProtocol.Channel {
+        TypedProtocol.send = send,
+        TypedProtocol.recv = recv
       }
     where
       send blob = void $ write bearer (wrap blob)

network-mux/test/Test/Mux.hs

@@ -50,7 +50,7 @@ import           Test.Mux.ReqResp
 import qualified Network.Mux as Mx
 import qualified Network.Mux.Codec as Mx
 import qualified Network.Mux.Channel as Mx
-import qualified Network.Mux.Interface as Mx
+import qualified Network.Mux.Types as Mx
 import qualified Network.Mux.Bearer.Queues as Mx
 
 tests :: TestTree

ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs

@@ -36,7 +36,7 @@ import           Data.Void (Void)
 import           Control.Monad.Class.MonadThrow
 import           Control.Tracer
 
-import           Network.Mux.Interface
+import           Network.Mux
 import           Network.TypedProtocol.Channel
 import           Network.TypedProtocol.Codec.Cbor hiding (decode, encode)
 import           Network.TypedProtocol.Driver

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

@@ -31,8 +31,7 @@ import           Network.TypedProtocol.Channel
 import           Network.TypedProtocol.Driver
 import           Network.TypedProtocol.Pipelined
 
-import           Network.Mux.Interface hiding (MiniProtocolLimits(..))
-import           Network.Mux.Types     hiding (MiniProtocolLimits(..))
+import           Network.Mux.Types hiding (MiniProtocolLimits(..))
 import qualified Network.Mux.Types as Mux
 
 import           Ouroboros.Network.Channel

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

@@ -78,7 +78,6 @@ import           Network.TypedProtocol.Driver (TraceSendRecv)
 import qualified Network.Mux as Mx
 import Network.Mux.DeltaQ.TraceTransformer
 import qualified Network.Mux.Types as Mx
-import           Network.Mux.Interface hiding (MiniProtocolLimits(..))
 import qualified Network.Mux.Bearer.Socket as Mx
 
 import           Ouroboros.Network.ErrorPolicy
@@ -159,7 +158,7 @@ connectToNode
      , Show vNumber
      , Show ptcl
      , MiniProtocolLimits ptcl
-     , HasInitiator appType ~ True
+     , Mx.HasInitiator appType ~ True
      )
   => VersionDataCodec extra CBOR.Term
   -> NetworkConnectTracers ptcl vNumber
@@ -212,7 +211,7 @@ connectToNode'
      , Show vNumber
      , Show ptcl
      , MiniProtocolLimits ptcl
-     , HasInitiator appType ~ True
+     , Mx.HasInitiator appType ~ True
      )
   => VersionDataCodec extra CBOR.Term
   -> NetworkConnectTracers ptcl vNumber
@@ -260,7 +259,7 @@ data AcceptConnection st vNumber extra peerid ptcl m bytes where
 
     AcceptConnection
       :: forall appType st vNumber extra peerid ptcl m bytes a b.
-         HasResponder appType ~ True
+         Mx.HasResponder appType ~ True
       => !st
       -> !peerid
       -> Versions vNumber extra (OuroborosApplication appType peerid ptcl m bytes a b)
@@ -426,7 +425,7 @@ cleanNetworkMutableState NetworkMutableState {nmsPeerStates} =
 --
 runServerThread
     :: forall appType ptcl vNumber extra a b.
-       ( HasResponder appType ~ True
+       ( Mx.HasResponder appType ~ True
        , ProtocolEnum ptcl
        , Ord ptcl
        , Enum ptcl
@@ -520,7 +519,7 @@ runServerThread NetworkServerTracers { nstMuxTracer
 -- need to guarantee that a socket is open before we try to connect to it.
 withServerNode
     :: forall appType ptcl vNumber extra t a b.
-       ( HasResponder appType ~ True
+       ( Mx.HasResponder appType ~ True
        , ProtocolEnum ptcl
        , Ord ptcl
        , Enum ptcl

ouroboros-network/test/Test/Subscription.hs

@@ -40,7 +40,6 @@ import           Text.Show.Functions ()
 
 import           Test.Tasty.QuickCheck (shuffle, testProperty)
 
-import           Network.Mux.Interface hiding (MiniProtocolLimits(..))
 import           Network.Mux.Time (microsecondsToDiffTime)
 
 import           Network.TypedProtocol.Driver