{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}

module Network.Mux.Types
  ( MiniProtocolBundle (..)
  , MiniProtocolInfo (..)
  , MiniProtocolNum (..)
  , MiniProtocolDirection (..)
  , MiniProtocolLimits (..)
  , MuxMode (..)
  , HasInitiator
  , HasResponder
  , IngressQueue
  , MiniProtocolIx
  , MiniProtocolDir (..)
  , protocolDirEnum
  , MiniProtocolState (..)
  , MiniProtocolStatus (..)
  , MuxBearer (..)
  , muxBearerAsChannel
  , MuxSDU (..)
  , MuxSDUHeader (..)
  , SDUSize (..)
  , msTimestamp
  , setTimestamp
  , msNum
  , msDir
  , msLength
  , RemoteClockModel (..)
  , remoteClockPrecision
  , MuxRuntimeError (..)
  ) where

import           Prelude hiding (read)

import           Control.Exception (Exception)
import qualified Data.ByteString.Lazy as BL
import           Data.Functor (void)
import           Data.Ix (Ix (..))
import           Data.Word
import           Quiet

import           GHC.Generics (Generic)

import           Control.Concurrent.Class.MonadSTM.Strict (StrictTVar)
import           Control.Monad.Class.MonadTime.SI

import           Network.Mux.Channel (Channel (..))
import           Network.Mux.Timeout (TimeoutFn)


newtype RemoteClockModel
  = RemoteClockModel { RemoteClockModel -> Word32
unRemoteClockModel :: Word32 }
  deriving (RemoteClockModel -> RemoteClockModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteClockModel -> RemoteClockModel -> Bool
$c/= :: RemoteClockModel -> RemoteClockModel -> Bool
== :: RemoteClockModel -> RemoteClockModel -> Bool
$c== :: RemoteClockModel -> RemoteClockModel -> Bool
Eq, RemoteClockModel
forall a. a -> a -> Bounded a
maxBound :: RemoteClockModel
$cmaxBound :: RemoteClockModel
minBound :: RemoteClockModel
$cminBound :: RemoteClockModel
Bounded)

-- | The `DiffTime` represented by a tick in the `RemoteClockModel`
remoteClockPrecision :: DiffTime
remoteClockPrecision :: DiffTime
remoteClockPrecision = DiffTime
1e-6

--
-- Mini-protocol numbers
--

-- | The wire format includes the protocol numbers, and it's vital that these
-- are stable. They are not necessarily dense however, as new ones are added
-- and some old ones retired. So we use a dedicated class for this rather than
-- reusing 'Enum'. This also covers unrecognised protocol numbers on the
-- decoding side.
--
newtype MiniProtocolNum = MiniProtocolNum Word16
  deriving (MiniProtocolNum -> MiniProtocolNum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c/= :: MiniProtocolNum -> MiniProtocolNum -> Bool
== :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c== :: MiniProtocolNum -> MiniProtocolNum -> Bool
Eq, Eq MiniProtocolNum
MiniProtocolNum -> MiniProtocolNum -> Bool
MiniProtocolNum -> MiniProtocolNum -> Ordering
MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
$cmin :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
max :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
$cmax :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
>= :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c>= :: MiniProtocolNum -> MiniProtocolNum -> Bool
> :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c> :: MiniProtocolNum -> MiniProtocolNum -> Bool
<= :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c<= :: MiniProtocolNum -> MiniProtocolNum -> Bool
< :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c< :: MiniProtocolNum -> MiniProtocolNum -> Bool
compare :: MiniProtocolNum -> MiniProtocolNum -> Ordering
$ccompare :: MiniProtocolNum -> MiniProtocolNum -> Ordering
Ord, Int -> MiniProtocolNum
MiniProtocolNum -> Int
MiniProtocolNum -> [MiniProtocolNum]
MiniProtocolNum -> MiniProtocolNum
MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
MiniProtocolNum
-> MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MiniProtocolNum
-> MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
$cenumFromThenTo :: MiniProtocolNum
-> MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
enumFromTo :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
$cenumFromTo :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
enumFromThen :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
$cenumFromThen :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
enumFrom :: MiniProtocolNum -> [MiniProtocolNum]
$cenumFrom :: MiniProtocolNum -> [MiniProtocolNum]
fromEnum :: MiniProtocolNum -> Int
$cfromEnum :: MiniProtocolNum -> Int
toEnum :: Int -> MiniProtocolNum
$ctoEnum :: Int -> MiniProtocolNum
pred :: MiniProtocolNum -> MiniProtocolNum
$cpred :: MiniProtocolNum -> MiniProtocolNum
succ :: MiniProtocolNum -> MiniProtocolNum
$csucc :: MiniProtocolNum -> MiniProtocolNum
Enum, Ord MiniProtocolNum
(MiniProtocolNum, MiniProtocolNum) -> Int
(MiniProtocolNum, MiniProtocolNum) -> [MiniProtocolNum]
(MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Bool
(MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
$cunsafeRangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
rangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
$crangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
inRange :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Bool
$cinRange :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Bool
unsafeIndex :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
$cunsafeIndex :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
index :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
$cindex :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
range :: (MiniProtocolNum, MiniProtocolNum) -> [MiniProtocolNum]
$crange :: (MiniProtocolNum, MiniProtocolNum) -> [MiniProtocolNum]
Ix, Int -> MiniProtocolNum -> ShowS
[MiniProtocolNum] -> ShowS
MiniProtocolNum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MiniProtocolNum] -> ShowS
$cshowList :: [MiniProtocolNum] -> ShowS
show :: MiniProtocolNum -> String
$cshow :: MiniProtocolNum -> String
showsPrec :: Int -> MiniProtocolNum -> ShowS
$cshowsPrec :: Int -> MiniProtocolNum -> ShowS
Show)

-- | Per Miniprotocol limits
newtype MiniProtocolLimits =
     MiniProtocolLimits {
       -- | Limit on the maximum number of bytes that can be queued in the
       -- miniprotocol's ingress queue.
       --
       MiniProtocolLimits -> Int
maximumIngressQueue :: Int
     }

-- $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 MuxMode where
    InitiatorMode          :: MuxMode
    ResponderMode          :: MuxMode
    InitiatorResponderMode :: MuxMode

type family HasInitiator (mode :: MuxMode) :: Bool where
    HasInitiator InitiatorMode          = True
    HasInitiator ResponderMode          = False
    HasInitiator InitiatorResponderMode = True

type family HasResponder (mode :: MuxMode) :: Bool where
    HasResponder InitiatorMode          = False
    HasResponder ResponderMode          = True
    HasResponder InitiatorResponderMode = 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 MiniProtocolBundle (mode :: MuxMode) =
        MiniProtocolBundle [MiniProtocolInfo mode]

data MiniProtocolInfo (mode :: MuxMode) =
     MiniProtocolInfo {
       forall (mode :: MuxMode). MiniProtocolInfo mode -> MiniProtocolNum
miniProtocolNum    :: !MiniProtocolNum,
       forall (mode :: MuxMode).
MiniProtocolInfo mode -> MiniProtocolDirection mode
miniProtocolDir    :: !(MiniProtocolDirection mode),
       forall (mode :: MuxMode).
MiniProtocolInfo mode -> MiniProtocolLimits
miniProtocolLimits :: !MiniProtocolLimits
     }

data MiniProtocolDirection (mode :: MuxMode) where
    InitiatorDirectionOnly :: MiniProtocolDirection InitiatorMode
    ResponderDirectionOnly :: MiniProtocolDirection ResponderMode
    InitiatorDirection     :: MiniProtocolDirection InitiatorResponderMode
    ResponderDirection     :: MiniProtocolDirection InitiatorResponderMode

deriving instance Eq (MiniProtocolDirection (mode :: MuxMode))
deriving instance Ord (MiniProtocolDirection (mode :: MuxMode))

--
-- Mux internal types
--

type IngressQueue m = StrictTVar m BL.ByteString

-- | The index of a protocol in a MuxApplication, used for array indices
newtype MiniProtocolIx = MiniProtocolIx Int
  deriving (MiniProtocolIx -> MiniProtocolIx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c/= :: MiniProtocolIx -> MiniProtocolIx -> Bool
== :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c== :: MiniProtocolIx -> MiniProtocolIx -> Bool
Eq, Eq MiniProtocolIx
MiniProtocolIx -> MiniProtocolIx -> Bool
MiniProtocolIx -> MiniProtocolIx -> Ordering
MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$cmin :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
max :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$cmax :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
>= :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c>= :: MiniProtocolIx -> MiniProtocolIx -> Bool
> :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c> :: MiniProtocolIx -> MiniProtocolIx -> Bool
<= :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c<= :: MiniProtocolIx -> MiniProtocolIx -> Bool
< :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c< :: MiniProtocolIx -> MiniProtocolIx -> Bool
compare :: MiniProtocolIx -> MiniProtocolIx -> Ordering
$ccompare :: MiniProtocolIx -> MiniProtocolIx -> Ordering
Ord, Integer -> MiniProtocolIx
MiniProtocolIx -> MiniProtocolIx
MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MiniProtocolIx
$cfromInteger :: Integer -> MiniProtocolIx
signum :: MiniProtocolIx -> MiniProtocolIx
$csignum :: MiniProtocolIx -> MiniProtocolIx
abs :: MiniProtocolIx -> MiniProtocolIx
$cabs :: MiniProtocolIx -> MiniProtocolIx
negate :: MiniProtocolIx -> MiniProtocolIx
$cnegate :: MiniProtocolIx -> MiniProtocolIx
* :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$c* :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
- :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$c- :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
+ :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$c+ :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
Num, Int -> MiniProtocolIx
MiniProtocolIx -> Int
MiniProtocolIx -> [MiniProtocolIx]
MiniProtocolIx -> MiniProtocolIx
MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
MiniProtocolIx
-> MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MiniProtocolIx
-> MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
$cenumFromThenTo :: MiniProtocolIx
-> MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
enumFromTo :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
$cenumFromTo :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
enumFromThen :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
$cenumFromThen :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
enumFrom :: MiniProtocolIx -> [MiniProtocolIx]
$cenumFrom :: MiniProtocolIx -> [MiniProtocolIx]
fromEnum :: MiniProtocolIx -> Int
$cfromEnum :: MiniProtocolIx -> Int
toEnum :: Int -> MiniProtocolIx
$ctoEnum :: Int -> MiniProtocolIx
pred :: MiniProtocolIx -> MiniProtocolIx
$cpred :: MiniProtocolIx -> MiniProtocolIx
succ :: MiniProtocolIx -> MiniProtocolIx
$csucc :: MiniProtocolIx -> MiniProtocolIx
Enum, Ord MiniProtocolIx
(MiniProtocolIx, MiniProtocolIx) -> Int
(MiniProtocolIx, MiniProtocolIx) -> [MiniProtocolIx]
(MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Bool
(MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
$cunsafeRangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
rangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
$crangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
inRange :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Bool
$cinRange :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Bool
unsafeIndex :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
$cunsafeIndex :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
index :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
$cindex :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
range :: (MiniProtocolIx, MiniProtocolIx) -> [MiniProtocolIx]
$crange :: (MiniProtocolIx, MiniProtocolIx) -> [MiniProtocolIx]
Ix, Int -> MiniProtocolIx -> ShowS
[MiniProtocolIx] -> ShowS
MiniProtocolIx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MiniProtocolIx] -> ShowS
$cshowList :: [MiniProtocolIx] -> ShowS
show :: MiniProtocolIx -> String
$cshow :: MiniProtocolIx -> String
showsPrec :: Int -> MiniProtocolIx -> ShowS
$cshowsPrec :: Int -> MiniProtocolIx -> ShowS
Show)

data MiniProtocolDir = InitiatorDir | ResponderDir
  deriving (MiniProtocolDir -> MiniProtocolDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c/= :: MiniProtocolDir -> MiniProtocolDir -> Bool
== :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c== :: MiniProtocolDir -> MiniProtocolDir -> Bool
Eq, Eq MiniProtocolDir
MiniProtocolDir -> MiniProtocolDir -> Bool
MiniProtocolDir -> MiniProtocolDir -> Ordering
MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
$cmin :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
max :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
$cmax :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
>= :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c>= :: MiniProtocolDir -> MiniProtocolDir -> Bool
> :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c> :: MiniProtocolDir -> MiniProtocolDir -> Bool
<= :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c<= :: MiniProtocolDir -> MiniProtocolDir -> Bool
< :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c< :: MiniProtocolDir -> MiniProtocolDir -> Bool
compare :: MiniProtocolDir -> MiniProtocolDir -> Ordering
$ccompare :: MiniProtocolDir -> MiniProtocolDir -> Ordering
Ord, Ord MiniProtocolDir
(MiniProtocolDir, MiniProtocolDir) -> Int
(MiniProtocolDir, MiniProtocolDir) -> [MiniProtocolDir]
(MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Bool
(MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
$cunsafeRangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
rangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
$crangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
inRange :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Bool
$cinRange :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Bool
unsafeIndex :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
$cunsafeIndex :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
index :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
$cindex :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
range :: (MiniProtocolDir, MiniProtocolDir) -> [MiniProtocolDir]
$crange :: (MiniProtocolDir, MiniProtocolDir) -> [MiniProtocolDir]
Ix, Int -> MiniProtocolDir
MiniProtocolDir -> Int
MiniProtocolDir -> [MiniProtocolDir]
MiniProtocolDir -> MiniProtocolDir
MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
MiniProtocolDir
-> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MiniProtocolDir
-> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
$cenumFromThenTo :: MiniProtocolDir
-> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
enumFromTo :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
$cenumFromTo :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
enumFromThen :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
$cenumFromThen :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
enumFrom :: MiniProtocolDir -> [MiniProtocolDir]
$cenumFrom :: MiniProtocolDir -> [MiniProtocolDir]
fromEnum :: MiniProtocolDir -> Int
$cfromEnum :: MiniProtocolDir -> Int
toEnum :: Int -> MiniProtocolDir
$ctoEnum :: Int -> MiniProtocolDir
pred :: MiniProtocolDir -> MiniProtocolDir
$cpred :: MiniProtocolDir -> MiniProtocolDir
succ :: MiniProtocolDir -> MiniProtocolDir
$csucc :: MiniProtocolDir -> MiniProtocolDir
Enum, MiniProtocolDir
forall a. a -> a -> Bounded a
maxBound :: MiniProtocolDir
$cmaxBound :: MiniProtocolDir
minBound :: MiniProtocolDir
$cminBound :: MiniProtocolDir
Bounded, Int -> MiniProtocolDir -> ShowS
[MiniProtocolDir] -> ShowS
MiniProtocolDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MiniProtocolDir] -> ShowS
$cshowList :: [MiniProtocolDir] -> ShowS
show :: MiniProtocolDir -> String
$cshow :: MiniProtocolDir -> String
showsPrec :: Int -> MiniProtocolDir -> ShowS
$cshowsPrec :: Int -> MiniProtocolDir -> ShowS
Show)

protocolDirEnum :: MiniProtocolDirection mode -> MiniProtocolDir
protocolDirEnum :: forall (mode :: MuxMode).
MiniProtocolDirection mode -> MiniProtocolDir
protocolDirEnum MiniProtocolDirection mode
InitiatorDirectionOnly = MiniProtocolDir
InitiatorDir
protocolDirEnum MiniProtocolDirection mode
ResponderDirectionOnly = MiniProtocolDir
ResponderDir
protocolDirEnum MiniProtocolDirection mode
InitiatorDirection     = MiniProtocolDir
InitiatorDir
protocolDirEnum MiniProtocolDirection mode
ResponderDirection     = MiniProtocolDir
ResponderDir

data MiniProtocolState mode m = MiniProtocolState {
       forall (mode :: MuxMode) (m :: * -> *).
MiniProtocolState mode m -> MiniProtocolInfo mode
miniProtocolInfo         :: MiniProtocolInfo mode,
       forall (mode :: MuxMode) (m :: * -> *).
MiniProtocolState mode m -> IngressQueue m
miniProtocolIngressQueue :: IngressQueue m,
       forall (mode :: MuxMode) (m :: * -> *).
MiniProtocolState mode m -> StrictTVar m MiniProtocolStatus
miniProtocolStatusVar    :: StrictTVar m MiniProtocolStatus
     }

data MiniProtocolStatus = StatusIdle | StatusStartOnDemand | StatusRunning
  deriving (MiniProtocolStatus -> MiniProtocolStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
$c/= :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
== :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
$c== :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
Eq, Int -> MiniProtocolStatus -> ShowS
[MiniProtocolStatus] -> ShowS
MiniProtocolStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MiniProtocolStatus] -> ShowS
$cshowList :: [MiniProtocolStatus] -> ShowS
show :: MiniProtocolStatus -> String
$cshow :: MiniProtocolStatus -> String
showsPrec :: Int -> MiniProtocolStatus -> ShowS
$cshowsPrec :: Int -> MiniProtocolStatus -> ShowS
Show)

data MuxSDUHeader = MuxSDUHeader {
      MuxSDUHeader -> RemoteClockModel
mhTimestamp :: !RemoteClockModel
    , MuxSDUHeader -> MiniProtocolNum
mhNum       :: !MiniProtocolNum
    , MuxSDUHeader -> MiniProtocolDir
mhDir       :: !MiniProtocolDir
    , MuxSDUHeader -> Word16
mhLength    :: !Word16
    }


data MuxSDU = MuxSDU {
      MuxSDU -> MuxSDUHeader
msHeader :: !MuxSDUHeader
    , MuxSDU -> ByteString
msBlob   :: !BL.ByteString
    }

msTimestamp :: MuxSDU -> RemoteClockModel
msTimestamp :: MuxSDU -> RemoteClockModel
msTimestamp = MuxSDUHeader -> RemoteClockModel
mhTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> MuxSDUHeader
msHeader

setTimestamp :: MuxSDU -> RemoteClockModel -> MuxSDU
setTimestamp :: MuxSDU -> RemoteClockModel -> MuxSDU
setTimestamp sdu :: MuxSDU
sdu@MuxSDU { MuxSDUHeader
msHeader :: MuxSDUHeader
msHeader :: MuxSDU -> MuxSDUHeader
msHeader } RemoteClockModel
mhTimestamp =
    MuxSDU
sdu { msHeader :: MuxSDUHeader
msHeader = MuxSDUHeader
msHeader { RemoteClockModel
mhTimestamp :: RemoteClockModel
mhTimestamp :: RemoteClockModel
mhTimestamp } }

msNum :: MuxSDU -> MiniProtocolNum
msNum :: MuxSDU -> MiniProtocolNum
msNum = MuxSDUHeader -> MiniProtocolNum
mhNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> MuxSDUHeader
msHeader

msDir :: MuxSDU -> MiniProtocolDir
msDir :: MuxSDU -> MiniProtocolDir
msDir = MuxSDUHeader -> MiniProtocolDir
mhDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> MuxSDUHeader
msHeader

msLength :: MuxSDU -> Word16
msLength :: MuxSDU -> Word16
msLength = MuxSDUHeader -> Word16
mhLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> MuxSDUHeader
msHeader


-- | Low level access to underlying socket or pipe.  There are three smart
-- constructors:
--
-- * 'Network.Socket.socketAsMuxBearer'
-- * 'Network.Pipe.pipeAsMuxBearer'
-- * @Test.Mux.queuesAsMuxBearer@
--
data MuxBearer m = MuxBearer {
    -- | Timestamp and send MuxSDU.
      forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
write   :: TimeoutFn m -> MuxSDU -> m Time
    -- | Read a MuxSDU
    , forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> m (MuxSDU, Time)
read    :: TimeoutFn m -> m (MuxSDU, Time)
    -- | Return a suitable MuxSDU payload size.
    , forall (m :: * -> *). MuxBearer m -> SDUSize
sduSize :: SDUSize
    }

newtype SDUSize = SDUSize { SDUSize -> Word16
getSDUSize :: Word16 }
  deriving forall x. Rep SDUSize x -> SDUSize
forall x. SDUSize -> Rep SDUSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SDUSize x -> SDUSize
$cfrom :: forall x. SDUSize -> Rep SDUSize x
Generic
  deriving Int -> SDUSize -> ShowS
[SDUSize] -> ShowS
SDUSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SDUSize] -> ShowS
$cshowList :: [SDUSize] -> ShowS
show :: SDUSize -> String
$cshow :: SDUSize -> String
showsPrec :: Int -> SDUSize -> ShowS
$cshowsPrec :: Int -> SDUSize -> ShowS
Show via Quiet SDUSize

-- | A channel which wraps each message as an 'MuxSDU' using giving
-- 'MiniProtocolNum' and 'MiniProtocolDir'.
--
muxBearerAsChannel
  :: forall m. Functor m
  => MuxBearer m
  -> MiniProtocolNum
  -> MiniProtocolDir
  -> Channel m
muxBearerAsChannel :: forall (m :: * -> *).
Functor m =>
MuxBearer m -> MiniProtocolNum -> MiniProtocolDir -> Channel m
muxBearerAsChannel MuxBearer m
bearer MiniProtocolNum
ptclNum MiniProtocolDir
ptclDir =
      Channel {
        send :: ByteString -> m ()
send = \ByteString
blob -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
write MuxBearer m
bearer TimeoutFn m
noTimeout (ByteString -> MuxSDU
wrap ByteString
blob),
        recv :: m (Maybe ByteString)
recv = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> ByteString
msBlob forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> m (MuxSDU, Time)
read MuxBearer m
bearer TimeoutFn m
noTimeout
      }
    where
      -- wrap a 'ByteString' as 'MuxSDU'
      wrap :: BL.ByteString -> MuxSDU
      wrap :: ByteString -> MuxSDU
wrap ByteString
blob = MuxSDU {
            -- it will be filled when the 'MuxSDU' is send by the 'bearer'
            msHeader :: MuxSDUHeader
msHeader = MuxSDUHeader {
                mhTimestamp :: RemoteClockModel
mhTimestamp = Word32 -> RemoteClockModel
RemoteClockModel Word32
0,
                mhNum :: MiniProtocolNum
mhNum       = MiniProtocolNum
ptclNum,
                mhDir :: MiniProtocolDir
mhDir       = MiniProtocolDir
ptclDir,
                mhLength :: Word16
mhLength    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
blob
              },
            msBlob :: ByteString
msBlob = ByteString
blob
          }

      noTimeout :: TimeoutFn m
      noTimeout :: TimeoutFn m
noTimeout DiffTime
_ m a
r = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
r

--
-- Errors
--

data MuxRuntimeError =
    ProtocolAlreadyRunning       !MiniProtocolNum !MiniProtocolDir !MiniProtocolStatus
  | UnknownProtocolInternalError !MiniProtocolNum !MiniProtocolDir
  | MuxBlockedOnCompletionVar    !MiniProtocolNum
  deriving Int -> MuxRuntimeError -> ShowS
[MuxRuntimeError] -> ShowS
MuxRuntimeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MuxRuntimeError] -> ShowS
$cshowList :: [MuxRuntimeError] -> ShowS
show :: MuxRuntimeError -> String
$cshow :: MuxRuntimeError -> String
showsPrec :: Int -> MuxRuntimeError -> ShowS
$cshowsPrec :: Int -> MuxRuntimeError -> ShowS
Show

instance Exception MuxRuntimeError