{-# 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.Monad.Class.MonadSTM.Strict (StrictTVar)
import           Control.Monad.Class.MonadTime

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


newtype RemoteClockModel
  = RemoteClockModel { RemoteClockModel -> Word32
unRemoteClockModel :: Word32 }
  deriving (RemoteClockModel -> RemoteClockModel -> Bool
(RemoteClockModel -> RemoteClockModel -> Bool)
-> (RemoteClockModel -> RemoteClockModel -> Bool)
-> Eq RemoteClockModel
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
RemoteClockModel -> RemoteClockModel -> Bounded 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
(MiniProtocolNum -> MiniProtocolNum -> Bool)
-> (MiniProtocolNum -> MiniProtocolNum -> Bool)
-> Eq MiniProtocolNum
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
Eq MiniProtocolNum
-> (MiniProtocolNum -> MiniProtocolNum -> Ordering)
-> (MiniProtocolNum -> MiniProtocolNum -> Bool)
-> (MiniProtocolNum -> MiniProtocolNum -> Bool)
-> (MiniProtocolNum -> MiniProtocolNum -> Bool)
-> (MiniProtocolNum -> MiniProtocolNum -> Bool)
-> (MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum)
-> (MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum)
-> Ord 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
$cp1Ord :: Eq MiniProtocolNum
Ord, Int -> MiniProtocolNum
MiniProtocolNum -> Int
MiniProtocolNum -> [MiniProtocolNum]
MiniProtocolNum -> MiniProtocolNum
MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
MiniProtocolNum
-> MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
(MiniProtocolNum -> MiniProtocolNum)
-> (MiniProtocolNum -> MiniProtocolNum)
-> (Int -> MiniProtocolNum)
-> (MiniProtocolNum -> Int)
-> (MiniProtocolNum -> [MiniProtocolNum])
-> (MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum])
-> (MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum])
-> (MiniProtocolNum
    -> MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum])
-> Enum 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
Ord MiniProtocolNum
-> ((MiniProtocolNum, MiniProtocolNum) -> [MiniProtocolNum])
-> ((MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int)
-> ((MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int)
-> ((MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Bool)
-> ((MiniProtocolNum, MiniProtocolNum) -> Int)
-> ((MiniProtocolNum, MiniProtocolNum) -> Int)
-> Ix 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]
$cp1Ix :: Ord MiniProtocolNum
Ix, Int -> MiniProtocolNum -> ShowS
[MiniProtocolNum] -> ShowS
MiniProtocolNum -> String
(Int -> MiniProtocolNum -> ShowS)
-> (MiniProtocolNum -> String)
-> ([MiniProtocolNum] -> ShowS)
-> Show MiniProtocolNum
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
data 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 {
       MiniProtocolInfo mode -> MiniProtocolNum
miniProtocolNum    :: !MiniProtocolNum,
       MiniProtocolInfo mode -> MiniProtocolDirection mode
miniProtocolDir    :: !(MiniProtocolDirection mode),
       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
(MiniProtocolIx -> MiniProtocolIx -> Bool)
-> (MiniProtocolIx -> MiniProtocolIx -> Bool) -> Eq MiniProtocolIx
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
Eq MiniProtocolIx
-> (MiniProtocolIx -> MiniProtocolIx -> Ordering)
-> (MiniProtocolIx -> MiniProtocolIx -> Bool)
-> (MiniProtocolIx -> MiniProtocolIx -> Bool)
-> (MiniProtocolIx -> MiniProtocolIx -> Bool)
-> (MiniProtocolIx -> MiniProtocolIx -> Bool)
-> (MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx)
-> Ord 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
$cp1Ord :: Eq MiniProtocolIx
Ord, Integer -> MiniProtocolIx
MiniProtocolIx -> MiniProtocolIx
MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
(MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx)
-> (Integer -> MiniProtocolIx)
-> Num 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]
(MiniProtocolIx -> MiniProtocolIx)
-> (MiniProtocolIx -> MiniProtocolIx)
-> (Int -> MiniProtocolIx)
-> (MiniProtocolIx -> Int)
-> (MiniProtocolIx -> [MiniProtocolIx])
-> (MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx])
-> (MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx])
-> (MiniProtocolIx
    -> MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx])
-> Enum 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
Ord MiniProtocolIx
-> ((MiniProtocolIx, MiniProtocolIx) -> [MiniProtocolIx])
-> ((MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int)
-> ((MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int)
-> ((MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Bool)
-> ((MiniProtocolIx, MiniProtocolIx) -> Int)
-> ((MiniProtocolIx, MiniProtocolIx) -> Int)
-> Ix 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]
$cp1Ix :: Ord MiniProtocolIx
Ix, Int -> MiniProtocolIx -> ShowS
[MiniProtocolIx] -> ShowS
MiniProtocolIx -> String
(Int -> MiniProtocolIx -> ShowS)
-> (MiniProtocolIx -> String)
-> ([MiniProtocolIx] -> ShowS)
-> Show MiniProtocolIx
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
(MiniProtocolDir -> MiniProtocolDir -> Bool)
-> (MiniProtocolDir -> MiniProtocolDir -> Bool)
-> Eq MiniProtocolDir
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
Eq MiniProtocolDir
-> (MiniProtocolDir -> MiniProtocolDir -> Ordering)
-> (MiniProtocolDir -> MiniProtocolDir -> Bool)
-> (MiniProtocolDir -> MiniProtocolDir -> Bool)
-> (MiniProtocolDir -> MiniProtocolDir -> Bool)
-> (MiniProtocolDir -> MiniProtocolDir -> Bool)
-> (MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir)
-> (MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir)
-> Ord 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
$cp1Ord :: Eq MiniProtocolDir
Ord, Ord MiniProtocolDir
Ord MiniProtocolDir
-> ((MiniProtocolDir, MiniProtocolDir) -> [MiniProtocolDir])
-> ((MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int)
-> ((MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int)
-> ((MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Bool)
-> ((MiniProtocolDir, MiniProtocolDir) -> Int)
-> ((MiniProtocolDir, MiniProtocolDir) -> Int)
-> Ix 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]
$cp1Ix :: Ord MiniProtocolDir
Ix, Int -> MiniProtocolDir
MiniProtocolDir -> Int
MiniProtocolDir -> [MiniProtocolDir]
MiniProtocolDir -> MiniProtocolDir
MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
MiniProtocolDir
-> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
(MiniProtocolDir -> MiniProtocolDir)
-> (MiniProtocolDir -> MiniProtocolDir)
-> (Int -> MiniProtocolDir)
-> (MiniProtocolDir -> Int)
-> (MiniProtocolDir -> [MiniProtocolDir])
-> (MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir])
-> (MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir])
-> (MiniProtocolDir
    -> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir])
-> Enum 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
MiniProtocolDir -> MiniProtocolDir -> Bounded MiniProtocolDir
forall a. a -> a -> Bounded a
maxBound :: MiniProtocolDir
$cmaxBound :: MiniProtocolDir
minBound :: MiniProtocolDir
$cminBound :: MiniProtocolDir
Bounded, Int -> MiniProtocolDir -> ShowS
[MiniProtocolDir] -> ShowS
MiniProtocolDir -> String
(Int -> MiniProtocolDir -> ShowS)
-> (MiniProtocolDir -> String)
-> ([MiniProtocolDir] -> ShowS)
-> Show MiniProtocolDir
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 :: 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 {
       MiniProtocolState mode m -> MiniProtocolInfo mode
miniProtocolInfo         :: MiniProtocolInfo mode,
       MiniProtocolState mode m -> IngressQueue m
miniProtocolIngressQueue :: IngressQueue m,
       MiniProtocolState mode m -> StrictTVar m MiniProtocolStatus
miniProtocolStatusVar    :: StrictTVar m MiniProtocolStatus
     }

data MiniProtocolStatus = StatusIdle | StatusStartOnDemand | StatusRunning
  deriving (MiniProtocolStatus -> MiniProtocolStatus -> Bool
(MiniProtocolStatus -> MiniProtocolStatus -> Bool)
-> (MiniProtocolStatus -> MiniProtocolStatus -> Bool)
-> Eq MiniProtocolStatus
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
(Int -> MiniProtocolStatus -> ShowS)
-> (MiniProtocolStatus -> String)
-> ([MiniProtocolStatus] -> ShowS)
-> Show MiniProtocolStatus
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 (MuxSDUHeader -> RemoteClockModel)
-> (MuxSDU -> MuxSDUHeader) -> MuxSDU -> RemoteClockModel
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 (MuxSDUHeader -> MiniProtocolNum)
-> (MuxSDU -> MuxSDUHeader) -> MuxSDU -> MiniProtocolNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> MuxSDUHeader
msHeader

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

msLength :: MuxSDU -> Word16
msLength :: MuxSDU -> Word16
msLength = MuxSDUHeader -> Word16
mhLength (MuxSDUHeader -> Word16)
-> (MuxSDU -> MuxSDUHeader) -> MuxSDU -> Word16
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.
      MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
write   :: TimeoutFn m -> MuxSDU -> m Time
    -- | Read a MuxSDU
    , MuxBearer m -> TimeoutFn m -> m (MuxSDU, Time)
read    :: TimeoutFn m -> m (MuxSDU, Time)
    -- | Return a suitable MuxSDU payload size.
    , MuxBearer m -> SDUSize
sduSize :: SDUSize
    }

newtype SDUSize = SDUSize { SDUSize -> Word16
getSDUSize :: Word16 }
  deriving (forall x. SDUSize -> Rep SDUSize x)
-> (forall x. Rep SDUSize x -> SDUSize) -> Generic SDUSize
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
(Int -> SDUSize -> ShowS)
-> (SDUSize -> String) -> ([SDUSize] -> ShowS) -> Show SDUSize
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 :: MuxBearer m -> MiniProtocolNum -> MiniProtocolDir -> Channel m
muxBearerAsChannel MuxBearer m
bearer MiniProtocolNum
ptclNum MiniProtocolDir
ptclDir =
      Channel :: forall (m :: * -> *).
(ByteString -> m ()) -> m (Maybe ByteString) -> Channel m
Channel {
        send :: ByteString -> m ()
send = \ByteString
blob -> m Time -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Time -> m ()) -> m Time -> m ()
forall a b. (a -> b) -> a -> b
$ MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
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 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ((MuxSDU, Time) -> ByteString)
-> (MuxSDU, Time)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MuxSDU -> ByteString
msBlob (MuxSDU -> ByteString)
-> ((MuxSDU, Time) -> MuxSDU) -> (MuxSDU, Time) -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MuxSDU, Time) -> MuxSDU
forall a b. (a, b) -> a
fst ((MuxSDU, Time) -> Maybe ByteString)
-> m (MuxSDU, Time) -> m (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MuxBearer m -> TimeoutFn m -> m (MuxSDU, Time)
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 :: MuxSDUHeader -> ByteString -> MuxSDU
MuxSDU {
            -- it will be filled when the 'MuxSDU' is send by the 'bearer'
            msHeader :: MuxSDUHeader
msHeader = MuxSDUHeader :: RemoteClockModel
-> MiniProtocolNum -> MiniProtocolDir -> Word16 -> MuxSDUHeader
MuxSDUHeader {
                mhTimestamp :: RemoteClockModel
mhTimestamp = Word32 -> RemoteClockModel
RemoteClockModel Word32
0,
                mhNum :: MiniProtocolNum
mhNum       = MiniProtocolNum
ptclNum,
                mhDir :: MiniProtocolDir
mhDir       = MiniProtocolDir
ptclDir,
                mhLength :: Word16
mhLength    = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
blob
              },
            msBlob :: ByteString
msBlob = ByteString
blob
          }

      noTimeout :: TimeoutFn m
      noTimeout :: DiffTime -> m a -> m (Maybe a)
noTimeout DiffTime
_ m a
r = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
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
(Int -> MuxRuntimeError -> ShowS)
-> (MuxRuntimeError -> String)
-> ([MuxRuntimeError] -> ShowS)
-> Show MuxRuntimeError
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