Merge pull request #5182 from IntersectMBO/coot/network-mux-haddocks

Improved network-mux haddocks

Author: coot

network-mux/CHANGELOG.md

@@ -6,6 +6,8 @@
 
 ### Non-breaking changes
 
+* Exposed `MakeBearerCb` to expose its haddocks.
+
 ## 0.9.0.0 -- 2025-06-28
 
 ### Breaking changes

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

@@ -8,6 +8,7 @@
 
 module Network.Mux.Bearer
   ( Bearer (..)
+  , MakeBearerCb
   , MakeBearer (..)
   , BearerTrace (..)
   , makeSocketBearer
@@ -36,35 +37,51 @@ import           Network.Mux.Bearer.Pipe
 import           Network.Mux.Bearer.Queues
 import           Network.Mux.Bearer.Socket
 import           Network.Mux.Trace
-import           Network.Mux.Types hiding (sduSize)
+import           Network.Mux.Types hiding (egressInterval)
 #if defined(mingw32_HOST_OS)
 import           Network.Mux.Bearer.NamedPipe
 #endif
 
-newtype MakeBearer m fd = MakeBearer {
-    getBearer
-      :: DiffTime
-      -- timeout for reading an SDU segment, if negative no
-      -- timeout is applied.
-      -> fd
-      -- file descriptor
-      -> Maybe (ReadBuffer m)
-      -- Optional Readbuffer
-      -> m (Bearer m)
-  }
+-- | Callback which constructs a bearer, see `MakeBearer`.
+--
+type MakeBearerCb m fd =
+       DiffTime
+    -- ^ Timeout for reading an SDU segment, if negative no timeout is
+    -- applied.  The timeout is not applied to the first SDU segment received
+    -- from the network, which allows a mini-protocol to have longer
+    -- timeouts than the one given here (or even have no timeout).
+    --
+    -- NOTE: a mini-protocol timeouts (which are not responsibility of
+    -- `network-mux` library) might include the time waiting for the response,
+    -- receiving all bytes, and the time required to parse the message.
+    -> fd
+    -- ^ file descriptor
+    -> Maybe (ReadBuffer m)
+    -- ^ optional `ReadBuffer`
+    -> m (Bearer m)
+
+
+-- | Construct a bearer using a `MakeBearerCb`.
+--
+newtype MakeBearer m fd = MakeBearer { getBearer :: MakeBearerCb m fd }
 
 pureBearer :: Applicative m
            => (DiffTime -> fd -> Maybe (ReadBuffer m) ->    Bearer m)
            ->  DiffTime -> fd -> Maybe (ReadBuffer m) -> m (Bearer m)
 pureBearer f = \sduTimeout rb fd -> pure (f sduTimeout rb fd)
 
 
+-- | `Socket` Bearer without egress interval.
+--
 makeSocketBearer :: MakeBearer IO Socket
 makeSocketBearer = makeSocketBearer' 0
 
-makeSocketBearer' :: DiffTime -> MakeBearer IO Socket
-makeSocketBearer' pt = MakeBearer $ \sduTimeout fd rb ->
-    return $ socketAsBearer size batch rb sduTimeout pt fd
+makeSocketBearer'
+  :: DiffTime
+  -- ^ egress interval
+  -> MakeBearer IO Socket
+makeSocketBearer' egressInterval = MakeBearer $ pureBearer $ \sduTimeout fd rb ->
+    socketAsBearer size batch rb sduTimeout egressInterval fd
   where
     size = SDUSize 12_288
     batch = 131_072

network-mux/src/Network/Mux/Bearer/Socket.hs

@@ -55,15 +55,15 @@ socketAsBearer
   -> DiffTime -- ^ egress poll interval
   -> Socket.Socket
   -> Bearer IO
-socketAsBearer sduSize batchSize readBuffer_m sduTimeout pollInterval sd =
+socketAsBearer sduSize batchSize readBuffer_m sduTimeout egressInterval sd =
       Mx.Bearer {
         Mx.read           = readSocket,
         Mx.write          = writeSocket,
         Mx.writeMany      = writeSocketMany,
         Mx.sduSize        = sduSize,
         Mx.batchSize      = batchSize,
         Mx.name           = "socket-bearer",
-        Mx.egressInterval = pollInterval
+        Mx.egressInterval
       }
     where
       readSocket :: Tracer IO BearerTrace -> Mx.TimeoutFn IO -> IO (Mx.SDU, Time)