{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}

module Ouroboros.Network.Mux
  ( MuxMode (..)
  , OuroborosApplication (..)
  , MuxProtocolBundle
  , ProtocolTemperature (..)
  , TokProtocolTemperature (..)
  , SomeTokProtocolTemperature (..)
  , WithProtocolTemperature (..)
  , withoutProtocolTemperature
  , WithSomeProtocolTemperature (..)
  , withoutSomeProtocolTemperature
  , Bundle (..)
  , projectBundle
  , OuroborosBundle
  , MuxBundle
  , MiniProtocol (..)
  , MiniProtocolNum (..)
  , MiniProtocolLimits (..)
  , RunMiniProtocol (..)
  , MuxPeer (..)
  , runMuxPeer
  , toApplication
  , mkMuxApplicationBundle
  , mkMiniProtocolBundle
  , ControlMessage (..)
  , ControlMessageSTM
  , continueForever
  , timeoutWithControlMessage
    -- * Re-exports
    -- | from "Network.Mux"
  , MuxError (..)
  , MuxErrorType (..)
  , HasInitiator
  , HasResponder
  ) where

import           Control.Monad.Class.MonadAsync
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadThrow
import           Control.Tracer (Tracer)

import qualified Data.ByteString.Lazy as LBS
import           Data.Void (Void)

import           Network.TypedProtocol.Codec
import           Network.TypedProtocol.Core
import           Network.TypedProtocol.Pipelined

import           Network.Mux (HasInitiator, HasResponder,
                     MiniProtocolBundle (..), MiniProtocolInfo,
                     MiniProtocolLimits (..), MiniProtocolNum, MuxError (..),
                     MuxErrorType (..), MuxMode (..))
import qualified Network.Mux.Compat as Mux.Compat
import qualified Network.Mux.Types as Mux

import           Ouroboros.Network.Channel
import           Ouroboros.Network.ConnectionId
import           Ouroboros.Network.Driver
import           Ouroboros.Network.Util.ShowProxy (ShowProxy)


-- | Control signal sent to a mini-protocol.  expected to exit, on 'Continue' it
-- should continue its operation
--
data ControlMessage =
    -- | Continue operation.
      Continue

    -- | Hold on, e.g. do not sent messages until resumed.  This is not used for
    -- any hot protocol.
    --
    | Quiesce

    -- | The client is expected to terminate as soon as possible.
    --
    | Terminate
  deriving (ControlMessage -> ControlMessage -> Bool
(ControlMessage -> ControlMessage -> Bool)
-> (ControlMessage -> ControlMessage -> Bool) -> Eq ControlMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlMessage -> ControlMessage -> Bool
$c/= :: ControlMessage -> ControlMessage -> Bool
== :: ControlMessage -> ControlMessage -> Bool
$c== :: ControlMessage -> ControlMessage -> Bool
Eq, Int -> ControlMessage -> ShowS
[ControlMessage] -> ShowS
ControlMessage -> String
(Int -> ControlMessage -> ShowS)
-> (ControlMessage -> String)
-> ([ControlMessage] -> ShowS)
-> Show ControlMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlMessage] -> ShowS
$cshowList :: [ControlMessage] -> ShowS
show :: ControlMessage -> String
$cshow :: ControlMessage -> String
showsPrec :: Int -> ControlMessage -> ShowS
$cshowsPrec :: Int -> ControlMessage -> ShowS
Show)

-- |  'ControlMessageSTM' should depend on `muxMode` (we only need to shedule
-- stop for intiator side).  This is not done only because this would break
-- tests, but once the old api is removed it should be possible.
--
type ControlMessageSTM m = STM m ControlMessage

continueForever :: Applicative (STM m)
                => proxy m
                -> ControlMessageSTM m
continueForever :: proxy m -> ControlMessageSTM m
continueForever proxy m
_ = ControlMessage -> ControlMessageSTM m
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlMessage
Continue


-- | First to finish synchronisation between 'Terminate' state of
-- 'ControlMessage' and an stm action.
--
-- This should return @STM m (Maybe a)@ but 'STM' is a non-injective type
-- family, and we would need to pass @Proxy m@ to fix an ambiuous type (or use
-- 'AllowAmbiguousTypes' extension).
--
timeoutWithControlMessage :: MonadSTM m
                          => ControlMessageSTM m
                          -> STM m a
                          -> m (Maybe a)
timeoutWithControlMessage :: ControlMessageSTM m -> STM m a -> m (Maybe a)
timeoutWithControlMessage ControlMessageSTM m
controlMessageSTM STM m a
stm =
    STM m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Maybe a) -> m (Maybe a)) -> STM m (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$
      do
        ControlMessage
cntrlMsg <- ControlMessageSTM m
controlMessageSTM
        case ControlMessage
cntrlMsg of
          ControlMessage
Terminate -> Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
          ControlMessage
Continue  -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
          ControlMessage
Quiesce   -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
      STM m (Maybe a) -> STM m (Maybe a) -> STM m (Maybe a)
forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse` (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> STM m a -> STM m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m a
stm)


-- |  Like 'MuxApplication' but using a 'MuxPeer' rather than a raw
-- @Channel -> m a@ action.
--
newtype OuroborosApplication (mode :: MuxMode) addr bytes m a b =
        OuroborosApplication
          (ConnectionId addr -> ControlMessageSTM m -> [MiniProtocol mode bytes m a b])


-- |  There are three kinds of applications: warm, hot and established (ones
-- that run in for both warm and hot peers).
--
data ProtocolTemperature = Established | Warm | Hot
  deriving (ProtocolTemperature -> ProtocolTemperature -> Bool
(ProtocolTemperature -> ProtocolTemperature -> Bool)
-> (ProtocolTemperature -> ProtocolTemperature -> Bool)
-> Eq ProtocolTemperature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c/= :: ProtocolTemperature -> ProtocolTemperature -> Bool
== :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c== :: ProtocolTemperature -> ProtocolTemperature -> Bool
Eq, Eq ProtocolTemperature
Eq ProtocolTemperature
-> (ProtocolTemperature -> ProtocolTemperature -> Ordering)
-> (ProtocolTemperature -> ProtocolTemperature -> Bool)
-> (ProtocolTemperature -> ProtocolTemperature -> Bool)
-> (ProtocolTemperature -> ProtocolTemperature -> Bool)
-> (ProtocolTemperature -> ProtocolTemperature -> Bool)
-> (ProtocolTemperature
    -> ProtocolTemperature -> ProtocolTemperature)
-> (ProtocolTemperature
    -> ProtocolTemperature -> ProtocolTemperature)
-> Ord ProtocolTemperature
ProtocolTemperature -> ProtocolTemperature -> Bool
ProtocolTemperature -> ProtocolTemperature -> Ordering
ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
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 :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
$cmin :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
max :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
$cmax :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
>= :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c>= :: ProtocolTemperature -> ProtocolTemperature -> Bool
> :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c> :: ProtocolTemperature -> ProtocolTemperature -> Bool
<= :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c<= :: ProtocolTemperature -> ProtocolTemperature -> Bool
< :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c< :: ProtocolTemperature -> ProtocolTemperature -> Bool
compare :: ProtocolTemperature -> ProtocolTemperature -> Ordering
$ccompare :: ProtocolTemperature -> ProtocolTemperature -> Ordering
$cp1Ord :: Eq ProtocolTemperature
Ord, Int -> ProtocolTemperature -> ShowS
[ProtocolTemperature] -> ShowS
ProtocolTemperature -> String
(Int -> ProtocolTemperature -> ShowS)
-> (ProtocolTemperature -> String)
-> ([ProtocolTemperature] -> ShowS)
-> Show ProtocolTemperature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolTemperature] -> ShowS
$cshowList :: [ProtocolTemperature] -> ShowS
show :: ProtocolTemperature -> String
$cshow :: ProtocolTemperature -> String
showsPrec :: Int -> ProtocolTemperature -> ShowS
$cshowsPrec :: Int -> ProtocolTemperature -> ShowS
Show)


-- | Singletons for 'AppKind'
--
data TokProtocolTemperature (pt :: ProtocolTemperature) where
    TokHot         :: TokProtocolTemperature Hot
    TokWarm        :: TokProtocolTemperature Warm
    TokEstablished :: TokProtocolTemperature Established


data SomeTokProtocolTemperature where
    SomeTokProtocolTemperature :: TokProtocolTemperature pt
                               -> SomeTokProtocolTemperature


-- | We keep hot, warm and established application (or their context) distinct.
-- It's only needed for a handly 'projectBundle' map.
--
data WithProtocolTemperature (pt :: ProtocolTemperature) a where
    WithHot         :: !a -> WithProtocolTemperature Hot  a
    WithWarm        :: !a -> WithProtocolTemperature Warm a
    WithEstablished :: !a -> WithProtocolTemperature Established a

deriving instance Eq a => Eq (WithProtocolTemperature pt a)
deriving instance Show a => Show (WithProtocolTemperature pt a)
deriving instance Functor     (WithProtocolTemperature pt)
deriving instance Foldable    (WithProtocolTemperature pt)
deriving instance Traversable (WithProtocolTemperature pt)

instance Applicative (WithProtocolTemperature Hot) where
    pure :: a -> WithProtocolTemperature 'Hot a
pure = a -> WithProtocolTemperature 'Hot a
forall a. a -> WithProtocolTemperature 'Hot a
WithHot
    <*> :: WithProtocolTemperature 'Hot (a -> b)
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot b
(<*>) (WithHot a -> b
f) = (a -> b)
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
instance Applicative (WithProtocolTemperature Warm) where
    pure :: a -> WithProtocolTemperature 'Warm a
pure = a -> WithProtocolTemperature 'Warm a
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm
    <*> :: WithProtocolTemperature 'Warm (a -> b)
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm b
(<*>) (WithWarm a -> b
f) = (a -> b)
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
instance Applicative (WithProtocolTemperature Established) where
    pure :: a -> WithProtocolTemperature 'Established a
pure = a -> WithProtocolTemperature 'Established a
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished
    <*> :: WithProtocolTemperature 'Established (a -> b)
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established b
(<*>) (WithEstablished a -> b
f) = (a -> b)
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f

instance Semigroup a => Semigroup (WithProtocolTemperature pt a) where
    WithHot a
a <> :: WithProtocolTemperature pt a
-> WithProtocolTemperature pt a -> WithProtocolTemperature pt a
<> WithHot a
b                 = a -> WithProtocolTemperature 'Hot a
forall a. a -> WithProtocolTemperature 'Hot a
WithHot (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    WithWarm a
a <> WithWarm a
b               = a -> WithProtocolTemperature 'Warm a
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    WithEstablished a
a <> WithEstablished a
b = a -> WithProtocolTemperature 'Established a
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)

instance Monoid a => Monoid (WithProtocolTemperature Hot a) where
    mempty :: WithProtocolTemperature 'Hot a
mempty = a -> WithProtocolTemperature 'Hot a
forall a. a -> WithProtocolTemperature 'Hot a
WithHot a
forall a. Monoid a => a
mempty

instance Monoid a => Monoid (WithProtocolTemperature Warm a) where
    mempty :: WithProtocolTemperature 'Warm a
mempty = a -> WithProtocolTemperature 'Warm a
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm a
forall a. Monoid a => a
mempty

instance Monoid a => Monoid (WithProtocolTemperature Established a) where
    mempty :: WithProtocolTemperature 'Established a
mempty = a -> WithProtocolTemperature 'Established a
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished a
forall a. Monoid a => a
mempty


withoutProtocolTemperature :: WithProtocolTemperature pt a -> a
withoutProtocolTemperature :: WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithHot a
a)         = a
a
withoutProtocolTemperature (WithWarm a
a)        = a
a
withoutProtocolTemperature (WithEstablished a
a) = a
a


data WithSomeProtocolTemperature a where
    WithSomeProtocolTemperature :: WithProtocolTemperature pt a -> WithSomeProtocolTemperature a

deriving instance Show a => Show (WithSomeProtocolTemperature a)
deriving instance Functor WithSomeProtocolTemperature

withoutSomeProtocolTemperature :: WithSomeProtocolTemperature a -> a
withoutSomeProtocolTemperature :: WithSomeProtocolTemperature a -> a
withoutSomeProtocolTemperature (WithSomeProtocolTemperature WithProtocolTemperature pt a
a) = WithProtocolTemperature pt a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature WithProtocolTemperature pt a
a


-- | A bundle of 'HotApp', 'WarmApp' and 'EstablishedApp'.
--
data Bundle a =
      Bundle {
          -- | hot mini-protocols
          --
          Bundle a -> WithProtocolTemperature 'Hot a
withHot
            :: !(WithProtocolTemperature Hot a),

          -- | warm mini-protocols
          --
          Bundle a -> WithProtocolTemperature 'Warm a
withWarm
            :: !(WithProtocolTemperature Warm a),

          -- | established mini-protocols
          --
          Bundle a -> WithProtocolTemperature 'Established a
withEstablished
            :: !(WithProtocolTemperature Established a)
        }
  deriving (Bundle a -> Bundle a -> Bool
(Bundle a -> Bundle a -> Bool)
-> (Bundle a -> Bundle a -> Bool) -> Eq (Bundle a)
forall a. Eq a => Bundle a -> Bundle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bundle a -> Bundle a -> Bool
$c/= :: forall a. Eq a => Bundle a -> Bundle a -> Bool
== :: Bundle a -> Bundle a -> Bool
$c== :: forall a. Eq a => Bundle a -> Bundle a -> Bool
Eq, Int -> Bundle a -> ShowS
[Bundle a] -> ShowS
Bundle a -> String
(Int -> Bundle a -> ShowS)
-> (Bundle a -> String) -> ([Bundle a] -> ShowS) -> Show (Bundle a)
forall a. Show a => Int -> Bundle a -> ShowS
forall a. Show a => [Bundle a] -> ShowS
forall a. Show a => Bundle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bundle a] -> ShowS
$cshowList :: forall a. Show a => [Bundle a] -> ShowS
show :: Bundle a -> String
$cshow :: forall a. Show a => Bundle a -> String
showsPrec :: Int -> Bundle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bundle a -> ShowS
Show, a -> Bundle b -> Bundle a
(a -> b) -> Bundle a -> Bundle b
(forall a b. (a -> b) -> Bundle a -> Bundle b)
-> (forall a b. a -> Bundle b -> Bundle a) -> Functor Bundle
forall a b. a -> Bundle b -> Bundle a
forall a b. (a -> b) -> Bundle a -> Bundle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Bundle b -> Bundle a
$c<$ :: forall a b. a -> Bundle b -> Bundle a
fmap :: (a -> b) -> Bundle a -> Bundle b
$cfmap :: forall a b. (a -> b) -> Bundle a -> Bundle b
Functor, Bundle a -> Bool
(a -> m) -> Bundle a -> m
(a -> b -> b) -> b -> Bundle a -> b
(forall m. Monoid m => Bundle m -> m)
-> (forall m a. Monoid m => (a -> m) -> Bundle a -> m)
-> (forall m a. Monoid m => (a -> m) -> Bundle a -> m)
-> (forall a b. (a -> b -> b) -> b -> Bundle a -> b)
-> (forall a b. (a -> b -> b) -> b -> Bundle a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bundle a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bundle a -> b)
-> (forall a. (a -> a -> a) -> Bundle a -> a)
-> (forall a. (a -> a -> a) -> Bundle a -> a)
-> (forall a. Bundle a -> [a])
-> (forall a. Bundle a -> Bool)
-> (forall a. Bundle a -> Int)
-> (forall a. Eq a => a -> Bundle a -> Bool)
-> (forall a. Ord a => Bundle a -> a)
-> (forall a. Ord a => Bundle a -> a)
-> (forall a. Num a => Bundle a -> a)
-> (forall a. Num a => Bundle a -> a)
-> Foldable Bundle
forall a. Eq a => a -> Bundle a -> Bool
forall a. Num a => Bundle a -> a
forall a. Ord a => Bundle a -> a
forall m. Monoid m => Bundle m -> m
forall a. Bundle a -> Bool
forall a. Bundle a -> Int
forall a. Bundle a -> [a]
forall a. (a -> a -> a) -> Bundle a -> a
forall m a. Monoid m => (a -> m) -> Bundle a -> m
forall b a. (b -> a -> b) -> b -> Bundle a -> b
forall a b. (a -> b -> b) -> b -> Bundle a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Bundle a -> a
$cproduct :: forall a. Num a => Bundle a -> a
sum :: Bundle a -> a
$csum :: forall a. Num a => Bundle a -> a
minimum :: Bundle a -> a
$cminimum :: forall a. Ord a => Bundle a -> a
maximum :: Bundle a -> a
$cmaximum :: forall a. Ord a => Bundle a -> a
elem :: a -> Bundle a -> Bool
$celem :: forall a. Eq a => a -> Bundle a -> Bool
length :: Bundle a -> Int
$clength :: forall a. Bundle a -> Int
null :: Bundle a -> Bool
$cnull :: forall a. Bundle a -> Bool
toList :: Bundle a -> [a]
$ctoList :: forall a. Bundle a -> [a]
foldl1 :: (a -> a -> a) -> Bundle a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Bundle a -> a
foldr1 :: (a -> a -> a) -> Bundle a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Bundle a -> a
foldl' :: (b -> a -> b) -> b -> Bundle a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Bundle a -> b
foldl :: (b -> a -> b) -> b -> Bundle a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Bundle a -> b
foldr' :: (a -> b -> b) -> b -> Bundle a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Bundle a -> b
foldr :: (a -> b -> b) -> b -> Bundle a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Bundle a -> b
foldMap' :: (a -> m) -> Bundle a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Bundle a -> m
foldMap :: (a -> m) -> Bundle a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Bundle a -> m
fold :: Bundle m -> m
$cfold :: forall m. Monoid m => Bundle m -> m
Foldable, Functor Bundle
Foldable Bundle
Functor Bundle
-> Foldable Bundle
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Bundle a -> f (Bundle b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Bundle (f a) -> f (Bundle a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bundle a -> m (Bundle b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Bundle (m a) -> m (Bundle a))
-> Traversable Bundle
(a -> f b) -> Bundle a -> f (Bundle b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Bundle (m a) -> m (Bundle a)
forall (f :: * -> *) a.
Applicative f =>
Bundle (f a) -> f (Bundle a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bundle a -> m (Bundle b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bundle a -> f (Bundle b)
sequence :: Bundle (m a) -> m (Bundle a)
$csequence :: forall (m :: * -> *) a. Monad m => Bundle (m a) -> m (Bundle a)
mapM :: (a -> m b) -> Bundle a -> m (Bundle b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bundle a -> m (Bundle b)
sequenceA :: Bundle (f a) -> f (Bundle a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Bundle (f a) -> f (Bundle a)
traverse :: (a -> f b) -> Bundle a -> f (Bundle b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bundle a -> f (Bundle b)
$cp2Traversable :: Foldable Bundle
$cp1Traversable :: Functor Bundle
Traversable)

instance Semigroup a => Semigroup (Bundle a) where
    Bundle WithProtocolTemperature 'Hot a
hot WithProtocolTemperature 'Warm a
warm WithProtocolTemperature 'Established a
established <> :: Bundle a -> Bundle a -> Bundle a
<> Bundle WithProtocolTemperature 'Hot a
hot' WithProtocolTemperature 'Warm a
warm' WithProtocolTemperature 'Established a
established' =
      WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
Bundle (WithProtocolTemperature 'Hot a
hot WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot a
forall a. Semigroup a => a -> a -> a
<> WithProtocolTemperature 'Hot a
hot')
             (WithProtocolTemperature 'Warm a
warm WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm a
forall a. Semigroup a => a -> a -> a
<> WithProtocolTemperature 'Warm a
warm')
             (WithProtocolTemperature 'Established a
established WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established a
forall a. Semigroup a => a -> a -> a
<> WithProtocolTemperature 'Established a
established')

instance Monoid a => Monoid (Bundle a) where
    mempty :: Bundle a
mempty = WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
Bundle WithProtocolTemperature 'Hot a
forall a. Monoid a => a
mempty WithProtocolTemperature 'Warm a
forall a. Monoid a => a
mempty WithProtocolTemperature 'Established a
forall a. Monoid a => a
mempty

projectBundle :: TokProtocolTemperature pt -> Bundle a -> a
projectBundle :: TokProtocolTemperature pt -> Bundle a -> a
projectBundle TokProtocolTemperature pt
TokHot         = WithProtocolTemperature 'Hot a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithProtocolTemperature 'Hot a -> a)
-> (Bundle a -> WithProtocolTemperature 'Hot a) -> Bundle a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle a -> WithProtocolTemperature 'Hot a
forall a. Bundle a -> WithProtocolTemperature 'Hot a
withHot
projectBundle TokProtocolTemperature pt
TokWarm        = WithProtocolTemperature 'Warm a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithProtocolTemperature 'Warm a -> a)
-> (Bundle a -> WithProtocolTemperature 'Warm a) -> Bundle a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle a -> WithProtocolTemperature 'Warm a
forall a. Bundle a -> WithProtocolTemperature 'Warm a
withWarm
projectBundle TokProtocolTemperature pt
TokEstablished = WithProtocolTemperature 'Established a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithProtocolTemperature 'Established a -> a)
-> (Bundle a -> WithProtocolTemperature 'Established a)
-> Bundle a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle a -> WithProtocolTemperature 'Established a
forall a. Bundle a -> WithProtocolTemperature 'Established a
withEstablished


instance Applicative Bundle where
    pure :: a -> Bundle a
pure a
a = WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
Bundle (a -> WithProtocolTemperature 'Hot a
forall a. a -> WithProtocolTemperature 'Hot a
WithHot a
a) (a -> WithProtocolTemperature 'Warm a
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm a
a) (a -> WithProtocolTemperature 'Established a
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished a
a)
    Bundle WithProtocolTemperature 'Hot (a -> b)
hotFn
           WithProtocolTemperature 'Warm (a -> b)
warmFn
           WithProtocolTemperature 'Established (a -> b)
establishedFn
      <*> :: Bundle (a -> b) -> Bundle a -> Bundle b
<*> Bundle WithProtocolTemperature 'Hot a
hot
                 WithProtocolTemperature 'Warm a
warm
                 WithProtocolTemperature 'Established a
established =
          WithProtocolTemperature 'Hot b
-> WithProtocolTemperature 'Warm b
-> WithProtocolTemperature 'Established b
-> Bundle b
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
Bundle (WithProtocolTemperature 'Hot (a -> b)
hotFn WithProtocolTemperature 'Hot (a -> b)
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WithProtocolTemperature 'Hot a
hot)
                 (WithProtocolTemperature 'Warm (a -> b)
warmFn WithProtocolTemperature 'Warm (a -> b)
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WithProtocolTemperature 'Warm a
warm)
                 (WithProtocolTemperature 'Established (a -> b)
establishedFn WithProtocolTemperature 'Established (a -> b)
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WithProtocolTemperature 'Established a
established)

--
-- Useful type synonyms
--

type MuxProtocolBundle (mode :: MuxMode) addr bytes m a b
       = ConnectionId addr
      -> ControlMessageSTM m
      -> [MiniProtocol mode bytes m a b]

type OuroborosBundle (mode :: MuxMode) addr bytes m a b =
    Bundle (MuxProtocolBundle mode addr bytes m a b)

data MiniProtocol (mode :: MuxMode) bytes m a b =
     MiniProtocol {
       MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum    :: !MiniProtocolNum,
       MiniProtocol mode bytes m a b -> MiniProtocolLimits
miniProtocolLimits :: !MiniProtocolLimits,
       MiniProtocol mode bytes m a b -> RunMiniProtocol mode bytes m a b
miniProtocolRun    :: !(RunMiniProtocol mode bytes m a b)
     }

type MuxBundle (mode :: MuxMode) bytes m a b =
    Bundle [MiniProtocol mode bytes m a b]


data RunMiniProtocol (mode :: MuxMode) bytes m a b where
     InitiatorProtocolOnly
       :: MuxPeer bytes m a
       -> RunMiniProtocol InitiatorMode bytes m a Void

     ResponderProtocolOnly
       :: MuxPeer bytes m b
       -> RunMiniProtocol ResponderMode bytes m Void b

     InitiatorAndResponderProtocol
       :: MuxPeer bytes m a
       -> MuxPeer bytes m b
       -> RunMiniProtocol InitiatorResponderMode bytes m a b

data MuxPeer bytes m a where
    MuxPeer :: forall (pr :: PeerRole) ps (st :: ps) failure bytes m a.
               ( Show failure
               , forall (st' :: ps). Show (ClientHasAgency st')
               , forall (st' :: ps). Show (ServerHasAgency st')
               , ShowProxy ps
               )
            => Tracer m (TraceSendRecv ps)
            -> Codec ps failure m bytes
            -> Peer ps pr st m a
            -> MuxPeer bytes m a

    MuxPeerPipelined
             :: forall (pr :: PeerRole) ps (st :: ps) failure bytes m a.
               ( Show failure
               , forall (st' :: ps). Show (ClientHasAgency st')
               , forall (st' :: ps). Show (ServerHasAgency st')
               , ShowProxy ps
               )
            => Tracer m (TraceSendRecv ps)
            -> Codec ps failure m bytes
            -> PeerPipelined ps pr st m a
            -> MuxPeer bytes m a

    MuxPeerRaw
           :: (Channel m bytes -> m (a, Maybe bytes))
           -> MuxPeer bytes m a

toApplication :: (MonadCatch m, MonadAsync m)
              => ConnectionId addr
              -> ControlMessageSTM m
              -> OuroborosApplication mode addr LBS.ByteString m a b
              -> Mux.Compat.MuxApplication mode m a b
toApplication :: ConnectionId addr
-> ControlMessageSTM m
-> OuroborosApplication mode addr ByteString m a b
-> MuxApplication mode m a b
toApplication ConnectionId addr
connectionId ControlMessageSTM m
controlMessageSTM (OuroborosApplication ConnectionId addr
-> ControlMessageSTM m -> [MiniProtocol mode ByteString m a b]
ptcls) =
  [MuxMiniProtocol mode m a b] -> MuxApplication mode m a b
forall (mode :: MuxMode) (m :: * -> *) a b.
[MuxMiniProtocol mode m a b] -> MuxApplication mode m a b
Mux.Compat.MuxApplication
    [ MuxMiniProtocol :: forall (mode :: MuxMode) (m :: * -> *) a b.
MiniProtocolNum
-> MiniProtocolLimits
-> RunMiniProtocol mode m a b
-> MuxMiniProtocol mode m a b
Mux.Compat.MuxMiniProtocol {
        miniProtocolNum :: MiniProtocolNum
Mux.Compat.miniProtocolNum    = MiniProtocol mode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol mode ByteString m a b
ptcl,
        miniProtocolLimits :: MiniProtocolLimits
Mux.Compat.miniProtocolLimits = MiniProtocol mode ByteString m a b -> MiniProtocolLimits
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolLimits
miniProtocolLimits MiniProtocol mode ByteString m a b
ptcl,
        miniProtocolRun :: RunMiniProtocol mode m a b
Mux.Compat.miniProtocolRun    = RunMiniProtocol mode ByteString m a b -> RunMiniProtocol mode m a b
forall (mode :: MuxMode) (m :: * -> *) a b.
(MonadCatch m, MonadAsync m) =>
RunMiniProtocol mode ByteString m a b -> RunMiniProtocol mode m a b
toMuxRunMiniProtocol (MiniProtocol mode ByteString m a b
-> RunMiniProtocol mode ByteString m a b
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> RunMiniProtocol mode bytes m a b
miniProtocolRun MiniProtocol mode ByteString m a b
ptcl)
      }
    | MiniProtocol mode ByteString m a b
ptcl <- ConnectionId addr
-> ControlMessageSTM m -> [MiniProtocol mode ByteString m a b]
ptcls ConnectionId addr
connectionId ControlMessageSTM m
controlMessageSTM ]


mkMuxApplicationBundle
    :: forall mode addr bytes m a b.
       ConnectionId addr
    -> Bundle (ControlMessageSTM m)
    -> OuroborosBundle mode addr bytes m a b
    -> MuxBundle       mode      bytes m a b
mkMuxApplicationBundle :: ConnectionId addr
-> Bundle (ControlMessageSTM m)
-> OuroborosBundle mode addr bytes m a b
-> MuxBundle mode bytes m a b
mkMuxApplicationBundle ConnectionId addr
connectionId Bundle (ControlMessageSTM m)
controlMessageBundle OuroborosBundle mode addr bytes m a b
appBundle =
    ControlMessageSTM m
-> MuxProtocolBundle mode addr bytes m a b
-> [MiniProtocol mode bytes m a b]
mkApplication (ControlMessageSTM m
 -> MuxProtocolBundle mode addr bytes m a b
 -> [MiniProtocol mode bytes m a b])
-> Bundle (ControlMessageSTM m)
-> Bundle
     (MuxProtocolBundle mode addr bytes m a b
      -> [MiniProtocol mode bytes m a b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bundle (ControlMessageSTM m)
controlMessageBundle Bundle
  (MuxProtocolBundle mode addr bytes m a b
   -> [MiniProtocol mode bytes m a b])
-> OuroborosBundle mode addr bytes m a b
-> MuxBundle mode bytes m a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OuroborosBundle mode addr bytes m a b
appBundle
  where
    mkApplication :: (ControlMessageSTM m)
                  -> (MuxProtocolBundle mode addr bytes m a b)
                  -> [MiniProtocol mode bytes m a b]
    mkApplication :: ControlMessageSTM m
-> MuxProtocolBundle mode addr bytes m a b
-> [MiniProtocol mode bytes m a b]
mkApplication ControlMessageSTM m
controlMessageSTM MuxProtocolBundle mode addr bytes m a b
app = MuxProtocolBundle mode addr bytes m a b
app ConnectionId addr
connectionId ControlMessageSTM m
controlMessageSTM


-- | Make 'MiniProtocolBundle', which is used to create a mux interface with
-- 'newMux'.   The output of 'mkMuxApplicationBundle' can be used as input.
--
mkMiniProtocolBundle :: MuxBundle mode bytes m a b
                     -> MiniProtocolBundle mode
mkMiniProtocolBundle :: MuxBundle mode bytes m a b -> MiniProtocolBundle mode
mkMiniProtocolBundle = [MiniProtocolInfo mode] -> MiniProtocolBundle mode
forall (mode :: MuxMode).
[MiniProtocolInfo mode] -> MiniProtocolBundle mode
MiniProtocolBundle ([MiniProtocolInfo mode] -> MiniProtocolBundle mode)
-> (MuxBundle mode bytes m a b -> [MiniProtocolInfo mode])
-> MuxBundle mode bytes m a b
-> MiniProtocolBundle mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MiniProtocol mode bytes m a b] -> [MiniProtocolInfo mode])
-> MuxBundle mode bytes m a b -> [MiniProtocolInfo mode]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [MiniProtocol mode bytes m a b] -> [MiniProtocolInfo mode]
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
[MiniProtocol mode bytes m a b] -> [MiniProtocolInfo mode]
fn
  where
    fn :: [MiniProtocol mode bytes m a b] -> [MiniProtocolInfo mode]
    fn :: [MiniProtocol mode bytes m a b] -> [MiniProtocolInfo mode]
fn [MiniProtocol mode bytes m a b]
ptcls = [ MiniProtocolInfo :: forall (mode :: MuxMode).
MiniProtocolNum
-> MiniProtocolDirection mode
-> MiniProtocolLimits
-> MiniProtocolInfo mode
Mux.MiniProtocolInfo
                   { MiniProtocolNum
miniProtocolNum :: MiniProtocolNum
miniProtocolNum :: MiniProtocolNum
Mux.miniProtocolNum
                   , miniProtocolDir :: MiniProtocolDirection mode
Mux.miniProtocolDir = MiniProtocolDirection mode
dir
                   , MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
Mux.miniProtocolLimits
                   }
               | MiniProtocol { MiniProtocolNum
miniProtocolNum :: MiniProtocolNum
miniProtocolNum :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum
                              , MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolLimits
miniProtocolLimits
                              , RunMiniProtocol mode bytes m a b
miniProtocolRun :: RunMiniProtocol mode bytes m a b
miniProtocolRun :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> RunMiniProtocol mode bytes m a b
miniProtocolRun
                              }
                   <- [MiniProtocol mode bytes m a b]
ptcls
               , MiniProtocolDirection mode
dir <- case RunMiniProtocol mode bytes m a b
miniProtocolRun of
                   InitiatorProtocolOnly{}         -> [ MiniProtocolDirection mode
MiniProtocolDirection 'InitiatorMode
Mux.InitiatorDirectionOnly ]
                   ResponderProtocolOnly{}         -> [ MiniProtocolDirection mode
MiniProtocolDirection 'ResponderMode
Mux.ResponderDirectionOnly ]
                   InitiatorAndResponderProtocol{} -> [ MiniProtocolDirection mode
MiniProtocolDirection 'InitiatorResponderMode
Mux.InitiatorDirection
                                                      , MiniProtocolDirection mode
MiniProtocolDirection 'InitiatorResponderMode
Mux.ResponderDirection ]
               ]

toMuxRunMiniProtocol :: forall mode m a b.
                        (MonadCatch m, MonadAsync m)
                     => RunMiniProtocol mode LBS.ByteString m a b
                     -> Mux.Compat.RunMiniProtocol mode m a b
toMuxRunMiniProtocol :: RunMiniProtocol mode ByteString m a b -> RunMiniProtocol mode m a b
toMuxRunMiniProtocol (InitiatorProtocolOnly MuxPeer ByteString m a
i) =
  (Channel m -> m (a, Maybe ByteString))
-> RunMiniProtocol 'InitiatorMode m a Void
forall (m :: * -> *) a.
(Channel m -> m (a, Maybe ByteString))
-> RunMiniProtocol 'InitiatorMode m a Void
Mux.Compat.InitiatorProtocolOnly (MuxPeer ByteString m a
-> Channel m ByteString -> m (a, Maybe ByteString)
forall (m :: * -> *) bytes a.
(MonadCatch m, MonadAsync m) =>
MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer MuxPeer ByteString m a
i (Channel m ByteString -> m (a, Maybe ByteString))
-> (Channel m -> Channel m ByteString)
-> Channel m
-> m (a, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel)
toMuxRunMiniProtocol (ResponderProtocolOnly MuxPeer ByteString m b
r) =
  (Channel m -> m (b, Maybe ByteString))
-> RunMiniProtocol 'ResponderMode m Void b
forall (m :: * -> *) b.
(Channel m -> m (b, Maybe ByteString))
-> RunMiniProtocol 'ResponderMode m Void b
Mux.Compat.ResponderProtocolOnly (MuxPeer ByteString m b
-> Channel m ByteString -> m (b, Maybe ByteString)
forall (m :: * -> *) bytes a.
(MonadCatch m, MonadAsync m) =>
MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer MuxPeer ByteString m b
r (Channel m ByteString -> m (b, Maybe ByteString))
-> (Channel m -> Channel m ByteString)
-> Channel m
-> m (b, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel)
toMuxRunMiniProtocol (InitiatorAndResponderProtocol MuxPeer ByteString m a
i MuxPeer ByteString m b
r) =
  (Channel m -> m (a, Maybe ByteString))
-> (Channel m -> m (b, Maybe ByteString))
-> RunMiniProtocol 'InitiatorResponderMode m a b
forall (m :: * -> *) a b.
(Channel m -> m (a, Maybe ByteString))
-> (Channel m -> m (b, Maybe ByteString))
-> RunMiniProtocol 'InitiatorResponderMode m a b
Mux.Compat.InitiatorAndResponderProtocol (MuxPeer ByteString m a
-> Channel m ByteString -> m (a, Maybe ByteString)
forall (m :: * -> *) bytes a.
(MonadCatch m, MonadAsync m) =>
MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer MuxPeer ByteString m a
i (Channel m ByteString -> m (a, Maybe ByteString))
-> (Channel m -> Channel m ByteString)
-> Channel m
-> m (a, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel)
                                           (MuxPeer ByteString m b
-> Channel m ByteString -> m (b, Maybe ByteString)
forall (m :: * -> *) bytes a.
(MonadCatch m, MonadAsync m) =>
MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer MuxPeer ByteString m b
r (Channel m ByteString -> m (b, Maybe ByteString))
-> (Channel m -> Channel m ByteString)
-> Channel m
-> m (b, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel)

-- |
-- Run a @'MuxPeer'@ using either @'runPeer'@ or @'runPipelinedPeer'@.
--
runMuxPeer
  :: ( MonadCatch m
     , MonadAsync m
     )
  => MuxPeer bytes m a
  -> Channel m bytes
  -> m (a, Maybe bytes)
runMuxPeer :: MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer (MuxPeer Tracer m (TraceSendRecv ps)
tracer Codec ps failure m bytes
codec Peer ps pr st m a
peer) Channel m bytes
channel =
    Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadThrow m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer Tracer m (TraceSendRecv ps)
tracer Codec ps failure m bytes
codec Channel m bytes
channel Peer ps pr st m a
peer

runMuxPeer (MuxPeerPipelined Tracer m (TraceSendRecv ps)
tracer Codec ps failure m bytes
codec PeerPipelined ps pr st m a
peer) Channel m bytes
channel =
    Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadThrow m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeer Tracer m (TraceSendRecv ps)
tracer Codec ps failure m bytes
codec Channel m bytes
channel PeerPipelined ps pr st m a
peer

runMuxPeer (MuxPeerRaw Channel m bytes -> m (a, Maybe bytes)
action) Channel m bytes
channel =
    Channel m bytes -> m (a, Maybe bytes)
action Channel m bytes
channel