{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Network.Mux.Bearer
( MakeBearer (..)
, makeSocketBearer
, makePipeChannelBearer
, makeQueueChannelBearer
#if defined(mingw32_HOST_OS)
, makeNamedPipeBearer
#endif
) where
import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Tracer (Tracer)
import Network.Socket (Socket)
#if defined(mingw32_HOST_OS)
import System.Win32 (HANDLE)
#endif
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)
#if defined(mingw32_HOST_OS)
import Network.Mux.Bearer.NamedPipe
#endif
newtype MakeBearer m fd = MakeBearer {
forall (m :: * -> *) fd.
MakeBearer m fd
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
getBearer
:: DiffTime
-> Tracer m MuxTrace
-> fd
-> m (MuxBearer m)
}
pureBearer :: Applicative m
=> (DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
pureBearer :: forall (m :: * -> *) fd.
Applicative m =>
(DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
pureBearer DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m
f = \DiffTime
sduTimeout Tracer m MuxTrace
tr fd
fd -> MuxBearer m -> m (MuxBearer m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m
f DiffTime
sduTimeout Tracer m MuxTrace
tr fd
fd)
makeSocketBearer :: MakeBearer IO Socket
makeSocketBearer :: MakeBearer IO Socket
makeSocketBearer = (DiffTime -> Tracer IO MuxTrace -> Socket -> IO (MuxBearer IO))
-> MakeBearer IO Socket
forall (m :: * -> *) fd.
(DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m))
-> MakeBearer m fd
MakeBearer ((DiffTime -> Tracer IO MuxTrace -> Socket -> IO (MuxBearer IO))
-> MakeBearer IO Socket)
-> (DiffTime -> Tracer IO MuxTrace -> Socket -> IO (MuxBearer IO))
-> MakeBearer IO Socket
forall a b. (a -> b) -> a -> b
$ (DiffTime -> Tracer IO MuxTrace -> Socket -> MuxBearer IO)
-> DiffTime -> Tracer IO MuxTrace -> Socket -> IO (MuxBearer IO)
forall (m :: * -> *) fd.
Applicative m =>
(DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
pureBearer (SDUSize -> DiffTime -> Tracer IO MuxTrace -> Socket -> MuxBearer IO
socketAsMuxBearer SDUSize
size)
where
size :: SDUSize
size = Word16 -> SDUSize
SDUSize Word16
12_288
makePipeChannelBearer :: MakeBearer IO PipeChannel
makePipeChannelBearer :: MakeBearer IO PipeChannel
makePipeChannelBearer = (DiffTime
-> Tracer IO MuxTrace -> PipeChannel -> IO (MuxBearer IO))
-> MakeBearer IO PipeChannel
forall (m :: * -> *) fd.
(DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m))
-> MakeBearer m fd
MakeBearer ((DiffTime
-> Tracer IO MuxTrace -> PipeChannel -> IO (MuxBearer IO))
-> MakeBearer IO PipeChannel)
-> (DiffTime
-> Tracer IO MuxTrace -> PipeChannel -> IO (MuxBearer IO))
-> MakeBearer IO PipeChannel
forall a b. (a -> b) -> a -> b
$ (DiffTime -> Tracer IO MuxTrace -> PipeChannel -> MuxBearer IO)
-> DiffTime
-> Tracer IO MuxTrace
-> PipeChannel
-> IO (MuxBearer IO)
forall (m :: * -> *) fd.
Applicative m =>
(DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
pureBearer (\DiffTime
_ -> SDUSize -> Tracer IO MuxTrace -> PipeChannel -> MuxBearer IO
pipeAsMuxBearer SDUSize
size)
where
size :: SDUSize
size = Word16 -> SDUSize
SDUSize Word16
32_768
makeQueueChannelBearer :: ( MonadSTM m
, MonadMonotonicTime m
, MonadThrow m
)
=> MakeBearer m (QueueChannel m)
makeQueueChannelBearer :: forall (m :: * -> *).
(MonadSTM m, MonadMonotonicTime m, MonadThrow m) =>
MakeBearer m (QueueChannel m)
makeQueueChannelBearer = (DiffTime
-> Tracer m MuxTrace -> QueueChannel m -> m (MuxBearer m))
-> MakeBearer m (QueueChannel m)
forall (m :: * -> *) fd.
(DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m))
-> MakeBearer m fd
MakeBearer ((DiffTime
-> Tracer m MuxTrace -> QueueChannel m -> m (MuxBearer m))
-> MakeBearer m (QueueChannel m))
-> (DiffTime
-> Tracer m MuxTrace -> QueueChannel m -> m (MuxBearer m))
-> MakeBearer m (QueueChannel m)
forall a b. (a -> b) -> a -> b
$ (DiffTime -> Tracer m MuxTrace -> QueueChannel m -> MuxBearer m)
-> DiffTime
-> Tracer m MuxTrace
-> QueueChannel m
-> m (MuxBearer m)
forall (m :: * -> *) fd.
Applicative m =>
(DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
pureBearer (\DiffTime
_ -> SDUSize -> Tracer m MuxTrace -> QueueChannel m -> MuxBearer m
forall (m :: * -> *).
(MonadSTM m, MonadMonotonicTime m, MonadThrow m) =>
SDUSize -> Tracer m MuxTrace -> QueueChannel m -> MuxBearer m
queueChannelAsMuxBearer SDUSize
size)
where
size :: SDUSize
size = Word16 -> SDUSize
SDUSize Word16
1_280
#if defined(mingw32_HOST_OS)
makeNamedPipeBearer :: MakeBearer IO HANDLE
makeNamedPipeBearer = MakeBearer $ pureBearer (\_ -> namedPipeAsBearer size)
where
size = SDUSize 24_576
#endif