{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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 Data.ByteString.Lazy qualified 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
(RemoteClockModel -> RemoteClockModel -> Bool)
-> (RemoteClockModel -> RemoteClockModel -> Bool)
-> Eq RemoteClockModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteClockModel -> RemoteClockModel -> Bool
== :: RemoteClockModel -> RemoteClockModel -> Bool
$c/= :: RemoteClockModel -> RemoteClockModel -> Bool
/= :: RemoteClockModel -> RemoteClockModel -> Bool
Eq, RemoteClockModel
RemoteClockModel -> RemoteClockModel -> Bounded RemoteClockModel
forall a. a -> a -> Bounded a
$cminBound :: RemoteClockModel
minBound :: RemoteClockModel
$cmaxBound :: RemoteClockModel
maxBound :: 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
$c== :: MiniProtocolNum -> MiniProtocolNum -> Bool
== :: MiniProtocolNum -> MiniProtocolNum -> Bool
$c/= :: MiniProtocolNum -> MiniProtocolNum -> Bool
/= :: 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
$ccompare :: MiniProtocolNum -> MiniProtocolNum -> Ordering
compare :: MiniProtocolNum -> MiniProtocolNum -> Ordering
$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
>= :: MiniProtocolNum -> MiniProtocolNum -> Bool
$cmax :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
max :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
$cmin :: MiniProtocolNum -> MiniProtocolNum -> MiniProtocolNum
min :: MiniProtocolNum -> MiniProtocolNum -> 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
$csucc :: MiniProtocolNum -> MiniProtocolNum
succ :: MiniProtocolNum -> MiniProtocolNum
$cpred :: MiniProtocolNum -> MiniProtocolNum
pred :: MiniProtocolNum -> MiniProtocolNum
$ctoEnum :: Int -> MiniProtocolNum
toEnum :: Int -> MiniProtocolNum
$cfromEnum :: MiniProtocolNum -> Int
fromEnum :: MiniProtocolNum -> Int
$cenumFrom :: MiniProtocolNum -> [MiniProtocolNum]
enumFrom :: MiniProtocolNum -> [MiniProtocolNum]
$cenumFromThen :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
enumFromThen :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
$cenumFromTo :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
enumFromTo :: MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
$cenumFromThenTo :: MiniProtocolNum
-> MiniProtocolNum -> MiniProtocolNum -> [MiniProtocolNum]
enumFromThenTo :: MiniProtocolNum
-> MiniProtocolNum -> 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
$crange :: (MiniProtocolNum, MiniProtocolNum) -> [MiniProtocolNum]
range :: (MiniProtocolNum, MiniProtocolNum) -> [MiniProtocolNum]
$cindex :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
index :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
$cunsafeIndex :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
unsafeIndex :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Int
$cinRange :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Bool
inRange :: (MiniProtocolNum, MiniProtocolNum) -> MiniProtocolNum -> Bool
$crangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
rangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
$cunsafeRangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
unsafeRangeSize :: (MiniProtocolNum, MiniProtocolNum) -> Int
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
$cshowsPrec :: Int -> MiniProtocolNum -> ShowS
showsPrec :: Int -> MiniProtocolNum -> ShowS
$cshow :: MiniProtocolNum -> String
show :: MiniProtocolNum -> String
$cshowList :: [MiniProtocolNum] -> ShowS
showList :: [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
(MiniProtocolIx -> MiniProtocolIx -> Bool)
-> (MiniProtocolIx -> MiniProtocolIx -> Bool) -> Eq MiniProtocolIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MiniProtocolIx -> MiniProtocolIx -> Bool
== :: MiniProtocolIx -> MiniProtocolIx -> Bool
$c/= :: MiniProtocolIx -> MiniProtocolIx -> Bool
/= :: 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
$ccompare :: MiniProtocolIx -> MiniProtocolIx -> Ordering
compare :: MiniProtocolIx -> MiniProtocolIx -> Ordering
$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
>= :: MiniProtocolIx -> MiniProtocolIx -> Bool
$cmax :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
max :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$cmin :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
min :: MiniProtocolIx -> MiniProtocolIx -> 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
$c+ :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
+ :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$c- :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
- :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$c* :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
* :: MiniProtocolIx -> MiniProtocolIx -> MiniProtocolIx
$cnegate :: MiniProtocolIx -> MiniProtocolIx
negate :: MiniProtocolIx -> MiniProtocolIx
$cabs :: MiniProtocolIx -> MiniProtocolIx
abs :: MiniProtocolIx -> MiniProtocolIx
$csignum :: MiniProtocolIx -> MiniProtocolIx
signum :: MiniProtocolIx -> MiniProtocolIx
$cfromInteger :: Integer -> MiniProtocolIx
fromInteger :: Integer -> 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
$csucc :: MiniProtocolIx -> MiniProtocolIx
succ :: MiniProtocolIx -> MiniProtocolIx
$cpred :: MiniProtocolIx -> MiniProtocolIx
pred :: MiniProtocolIx -> MiniProtocolIx
$ctoEnum :: Int -> MiniProtocolIx
toEnum :: Int -> MiniProtocolIx
$cfromEnum :: MiniProtocolIx -> Int
fromEnum :: MiniProtocolIx -> Int
$cenumFrom :: MiniProtocolIx -> [MiniProtocolIx]
enumFrom :: MiniProtocolIx -> [MiniProtocolIx]
$cenumFromThen :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
enumFromThen :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
$cenumFromTo :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
enumFromTo :: MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
$cenumFromThenTo :: MiniProtocolIx
-> MiniProtocolIx -> MiniProtocolIx -> [MiniProtocolIx]
enumFromThenTo :: MiniProtocolIx
-> MiniProtocolIx -> 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
$crange :: (MiniProtocolIx, MiniProtocolIx) -> [MiniProtocolIx]
range :: (MiniProtocolIx, MiniProtocolIx) -> [MiniProtocolIx]
$cindex :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
index :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
$cunsafeIndex :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
unsafeIndex :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Int
$cinRange :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Bool
inRange :: (MiniProtocolIx, MiniProtocolIx) -> MiniProtocolIx -> Bool
$crangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
rangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
$cunsafeRangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
unsafeRangeSize :: (MiniProtocolIx, MiniProtocolIx) -> Int
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
$cshowsPrec :: Int -> MiniProtocolIx -> ShowS
showsPrec :: Int -> MiniProtocolIx -> ShowS
$cshow :: MiniProtocolIx -> String
show :: MiniProtocolIx -> String
$cshowList :: [MiniProtocolIx] -> ShowS
showList :: [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
$c== :: MiniProtocolDir -> MiniProtocolDir -> Bool
== :: MiniProtocolDir -> MiniProtocolDir -> Bool
$c/= :: MiniProtocolDir -> MiniProtocolDir -> Bool
/= :: 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
$ccompare :: MiniProtocolDir -> MiniProtocolDir -> Ordering
compare :: MiniProtocolDir -> MiniProtocolDir -> Ordering
$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
>= :: MiniProtocolDir -> MiniProtocolDir -> Bool
$cmax :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
max :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
$cmin :: MiniProtocolDir -> MiniProtocolDir -> MiniProtocolDir
min :: MiniProtocolDir -> MiniProtocolDir -> 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
$crange :: (MiniProtocolDir, MiniProtocolDir) -> [MiniProtocolDir]
range :: (MiniProtocolDir, MiniProtocolDir) -> [MiniProtocolDir]
$cindex :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
index :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
$cunsafeIndex :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
unsafeIndex :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Int
$cinRange :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Bool
inRange :: (MiniProtocolDir, MiniProtocolDir) -> MiniProtocolDir -> Bool
$crangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
rangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
$cunsafeRangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
unsafeRangeSize :: (MiniProtocolDir, MiniProtocolDir) -> Int
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
$csucc :: MiniProtocolDir -> MiniProtocolDir
succ :: MiniProtocolDir -> MiniProtocolDir
$cpred :: MiniProtocolDir -> MiniProtocolDir
pred :: MiniProtocolDir -> MiniProtocolDir
$ctoEnum :: Int -> MiniProtocolDir
toEnum :: Int -> MiniProtocolDir
$cfromEnum :: MiniProtocolDir -> Int
fromEnum :: MiniProtocolDir -> Int
$cenumFrom :: MiniProtocolDir -> [MiniProtocolDir]
enumFrom :: MiniProtocolDir -> [MiniProtocolDir]
$cenumFromThen :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
enumFromThen :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
$cenumFromTo :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
enumFromTo :: MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
$cenumFromThenTo :: MiniProtocolDir
-> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
enumFromThenTo :: MiniProtocolDir
-> MiniProtocolDir -> MiniProtocolDir -> [MiniProtocolDir]
Enum, MiniProtocolDir
MiniProtocolDir -> MiniProtocolDir -> Bounded MiniProtocolDir
forall a. a -> a -> Bounded a
$cminBound :: MiniProtocolDir
minBound :: MiniProtocolDir
$cmaxBound :: MiniProtocolDir
maxBound :: 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
$cshowsPrec :: Int -> MiniProtocolDir -> ShowS
showsPrec :: Int -> MiniProtocolDir -> ShowS
$cshow :: MiniProtocolDir -> String
show :: MiniProtocolDir -> String
$cshowList :: [MiniProtocolDir] -> ShowS
showList :: [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
(MiniProtocolStatus -> MiniProtocolStatus -> Bool)
-> (MiniProtocolStatus -> MiniProtocolStatus -> Bool)
-> Eq MiniProtocolStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
== :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
$c/= :: MiniProtocolStatus -> MiniProtocolStatus -> Bool
/= :: 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
$cshowsPrec :: Int -> MiniProtocolStatus -> ShowS
showsPrec :: Int -> MiniProtocolStatus -> ShowS
$cshow :: MiniProtocolStatus -> String
show :: MiniProtocolStatus -> String
$cshowList :: [MiniProtocolStatus] -> ShowS
showList :: [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 :: MuxSDU -> MuxSDUHeader
msHeader :: MuxSDUHeader
msHeader } RemoteClockModel
mhTimestamp =
    MuxSDU
sdu { msHeader = msHeader { 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.
      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. 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
$cfrom :: forall x. SDUSize -> Rep SDUSize x
from :: forall x. SDUSize -> Rep SDUSize x
$cto :: forall x. Rep SDUSize x -> SDUSize
to :: forall x. Rep SDUSize x -> SDUSize
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
$cshowsPrec :: Int -> SDUSize -> ShowS
showsPrec :: Int -> SDUSize -> ShowS
$cshow :: SDUSize -> String
show :: SDUSize -> String
$cshowList :: [SDUSize] -> ShowS
showList :: [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 -> 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 DiffTime -> m a -> m (Maybe a)
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 DiffTime -> m a -> m (Maybe a)
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    = 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 :: TimeoutFn m
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
$cshowsPrec :: Int -> MuxRuntimeError -> ShowS
showsPrec :: Int -> MuxRuntimeError -> ShowS
$cshow :: MuxRuntimeError -> String
show :: MuxRuntimeError -> String
$cshowList :: [MuxRuntimeError] -> ShowS
showList :: [MuxRuntimeError] -> ShowS
Show

instance Exception MuxRuntimeError