{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
module Ouroboros.Network.Mux
(
MuxMode (..)
, ProtocolTemperature (..)
, SingProtocolTemperature (..)
, SomeTokProtocolTemperature (..)
, WithProtocolTemperature (..)
, withoutProtocolTemperature
, WithSomeProtocolTemperature (..)
, withoutSomeProtocolTemperature
, TemperatureBundle (..)
, projectBundle
, MiniProtocolCb (.., MuxPeerRaw)
, runMiniProtocolCb
, mkMiniProtocolCbFromPeer
, mkMiniProtocolCbFromPeerPipelined
, RunMiniProtocol (..)
, RunMiniProtocolWithExpandedCtx
, RunMiniProtocolWithMinimalCtx
, MiniProtocol (..)
, MiniProtocolWithExpandedCtx
, MiniProtocolWithMinimalCtx
, MiniProtocolNum (..)
, MiniProtocolLimits (..)
, OuroborosBundle
, OuroborosBundleWithExpandedCtx
, OuroborosApplication (..)
, OuroborosApplicationWithMinimalCtx
, toApplication
, mkMiniProtocolBundle
, fromOuroborosBundle
, contramapInitiatorCtx
, MuxError (..)
, MuxErrorType (..)
, HasInitiator
, HasResponder
, type MuxPeer
, runMuxPeer
) where
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadThrow
import Control.Tracer (Tracer)
import Data.ByteString.Lazy qualified as LBS
import Data.Foldable (fold)
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 Network.Mux.Channel qualified as Mux
import Network.Mux.Compat qualified as Mux.Compat
import Network.Mux.Types qualified as Mux
import Ouroboros.Network.Channel
import Ouroboros.Network.Context (ExpandedInitiatorContext,
MinimalInitiatorContext, ResponderContext)
import Ouroboros.Network.Driver
import Ouroboros.Network.Util.ShowProxy (ShowProxy)
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
$c== :: ProtocolTemperature -> ProtocolTemperature -> Bool
== :: ProtocolTemperature -> ProtocolTemperature -> Bool
$c/= :: ProtocolTemperature -> ProtocolTemperature -> Bool
/= :: 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
$ccompare :: ProtocolTemperature -> ProtocolTemperature -> Ordering
compare :: ProtocolTemperature -> ProtocolTemperature -> Ordering
$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
>= :: ProtocolTemperature -> ProtocolTemperature -> Bool
$cmax :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
max :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
$cmin :: ProtocolTemperature -> ProtocolTemperature -> ProtocolTemperature
min :: ProtocolTemperature -> ProtocolTemperature -> 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
$cshowsPrec :: Int -> ProtocolTemperature -> ShowS
showsPrec :: Int -> ProtocolTemperature -> ShowS
$cshow :: ProtocolTemperature -> String
show :: ProtocolTemperature -> String
$cshowList :: [ProtocolTemperature] -> ShowS
showList :: [ProtocolTemperature] -> ShowS
Show)
data SingProtocolTemperature (pt :: ProtocolTemperature) where
SingHot :: SingProtocolTemperature Hot
SingWarm :: SingProtocolTemperature Warm
SingEstablished :: SingProtocolTemperature Established
data SomeTokProtocolTemperature where
SomeTokProtocolTemperature :: SingProtocolTemperature pt
-> SomeTokProtocolTemperature
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 :: forall a. a -> WithProtocolTemperature 'Hot a
pure = a -> WithProtocolTemperature 'Hot a
forall a. a -> WithProtocolTemperature 'Hot a
WithHot
<*> :: forall a b.
WithProtocolTemperature 'Hot (a -> b)
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot b
(<*>) (WithHot a -> b
f) = (a -> b)
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot b
forall a b.
(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 :: forall a. a -> WithProtocolTemperature 'Warm a
pure = a -> WithProtocolTemperature 'Warm a
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm
<*> :: forall a b.
WithProtocolTemperature 'Warm (a -> b)
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm b
(<*>) (WithWarm a -> b
f) = (a -> b)
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm b
forall a b.
(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 :: forall a. a -> WithProtocolTemperature 'Established a
pure = a -> WithProtocolTemperature 'Established a
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished
<*> :: forall a b.
WithProtocolTemperature 'Established (a -> b)
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established b
(<*>) (WithEstablished a -> b
f) = (a -> b)
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established b
forall a b.
(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 Hot a) where
WithHot a
a <> :: WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot 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)
instance Semigroup a => Semigroup (WithProtocolTemperature Warm a) where
WithWarm a
a <> :: WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Warm 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)
instance Semigroup a => Semigroup (WithProtocolTemperature Established a) where
WithEstablished a
a <> :: WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established a
-> WithProtocolTemperature 'Established 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 :: forall (pt :: ProtocolTemperature) a.
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 :: forall a. 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
data TemperatureBundle a =
TemperatureBundle {
forall a. TemperatureBundle a -> WithProtocolTemperature 'Hot a
withHot
:: !(WithProtocolTemperature Hot a),
forall a. TemperatureBundle a -> WithProtocolTemperature 'Warm a
withWarm
:: !(WithProtocolTemperature Warm a),
forall a.
TemperatureBundle a -> WithProtocolTemperature 'Established a
withEstablished
:: !(WithProtocolTemperature Established a)
}
deriving (TemperatureBundle a -> TemperatureBundle a -> Bool
(TemperatureBundle a -> TemperatureBundle a -> Bool)
-> (TemperatureBundle a -> TemperatureBundle a -> Bool)
-> Eq (TemperatureBundle a)
forall a.
Eq a =>
TemperatureBundle a -> TemperatureBundle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
TemperatureBundle a -> TemperatureBundle a -> Bool
== :: TemperatureBundle a -> TemperatureBundle a -> Bool
$c/= :: forall a.
Eq a =>
TemperatureBundle a -> TemperatureBundle a -> Bool
/= :: TemperatureBundle a -> TemperatureBundle a -> Bool
Eq, Int -> TemperatureBundle a -> ShowS
[TemperatureBundle a] -> ShowS
TemperatureBundle a -> String
(Int -> TemperatureBundle a -> ShowS)
-> (TemperatureBundle a -> String)
-> ([TemperatureBundle a] -> ShowS)
-> Show (TemperatureBundle a)
forall a. Show a => Int -> TemperatureBundle a -> ShowS
forall a. Show a => [TemperatureBundle a] -> ShowS
forall a. Show a => TemperatureBundle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TemperatureBundle a -> ShowS
showsPrec :: Int -> TemperatureBundle a -> ShowS
$cshow :: forall a. Show a => TemperatureBundle a -> String
show :: TemperatureBundle a -> String
$cshowList :: forall a. Show a => [TemperatureBundle a] -> ShowS
showList :: [TemperatureBundle a] -> ShowS
Show, (forall a b.
(a -> b) -> TemperatureBundle a -> TemperatureBundle b)
-> (forall a b. a -> TemperatureBundle b -> TemperatureBundle a)
-> Functor TemperatureBundle
forall a b. a -> TemperatureBundle b -> TemperatureBundle a
forall a b. (a -> b) -> TemperatureBundle a -> TemperatureBundle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TemperatureBundle a -> TemperatureBundle b
fmap :: forall a b. (a -> b) -> TemperatureBundle a -> TemperatureBundle b
$c<$ :: forall a b. a -> TemperatureBundle b -> TemperatureBundle a
<$ :: forall a b. a -> TemperatureBundle b -> TemperatureBundle a
Functor, (forall m. Monoid m => TemperatureBundle m -> m)
-> (forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m)
-> (forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m)
-> (forall a b. (a -> b -> b) -> b -> TemperatureBundle a -> b)
-> (forall a b. (a -> b -> b) -> b -> TemperatureBundle a -> b)
-> (forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b)
-> (forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b)
-> (forall a. (a -> a -> a) -> TemperatureBundle a -> a)
-> (forall a. (a -> a -> a) -> TemperatureBundle a -> a)
-> (forall a. TemperatureBundle a -> [a])
-> (forall a. TemperatureBundle a -> Bool)
-> (forall a. TemperatureBundle a -> Int)
-> (forall a. Eq a => a -> TemperatureBundle a -> Bool)
-> (forall a. Ord a => TemperatureBundle a -> a)
-> (forall a. Ord a => TemperatureBundle a -> a)
-> (forall a. Num a => TemperatureBundle a -> a)
-> (forall a. Num a => TemperatureBundle a -> a)
-> Foldable TemperatureBundle
forall a. Eq a => a -> TemperatureBundle a -> Bool
forall a. Num a => TemperatureBundle a -> a
forall a. Ord a => TemperatureBundle a -> a
forall m. Monoid m => TemperatureBundle m -> m
forall a. TemperatureBundle a -> Bool
forall a. TemperatureBundle a -> Int
forall a. TemperatureBundle a -> [a]
forall a. (a -> a -> a) -> TemperatureBundle a -> a
forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m
forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b
forall a b. (a -> b -> b) -> b -> TemperatureBundle 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
$cfold :: forall m. Monoid m => TemperatureBundle m -> m
fold :: forall m. Monoid m => TemperatureBundle m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> TemperatureBundle a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TemperatureBundle a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TemperatureBundle a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TemperatureBundle a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> TemperatureBundle a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> TemperatureBundle a -> a
foldr1 :: forall a. (a -> a -> a) -> TemperatureBundle a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TemperatureBundle a -> a
foldl1 :: forall a. (a -> a -> a) -> TemperatureBundle a -> a
$ctoList :: forall a. TemperatureBundle a -> [a]
toList :: forall a. TemperatureBundle a -> [a]
$cnull :: forall a. TemperatureBundle a -> Bool
null :: forall a. TemperatureBundle a -> Bool
$clength :: forall a. TemperatureBundle a -> Int
length :: forall a. TemperatureBundle a -> Int
$celem :: forall a. Eq a => a -> TemperatureBundle a -> Bool
elem :: forall a. Eq a => a -> TemperatureBundle a -> Bool
$cmaximum :: forall a. Ord a => TemperatureBundle a -> a
maximum :: forall a. Ord a => TemperatureBundle a -> a
$cminimum :: forall a. Ord a => TemperatureBundle a -> a
minimum :: forall a. Ord a => TemperatureBundle a -> a
$csum :: forall a. Num a => TemperatureBundle a -> a
sum :: forall a. Num a => TemperatureBundle a -> a
$cproduct :: forall a. Num a => TemperatureBundle a -> a
product :: forall a. Num a => TemperatureBundle a -> a
Foldable, Functor TemperatureBundle
Foldable TemperatureBundle
(Functor TemperatureBundle, Foldable TemperatureBundle) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TemperatureBundle a -> f (TemperatureBundle b))
-> (forall (f :: * -> *) a.
Applicative f =>
TemperatureBundle (f a) -> f (TemperatureBundle a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TemperatureBundle a -> m (TemperatureBundle b))
-> (forall (m :: * -> *) a.
Monad m =>
TemperatureBundle (m a) -> m (TemperatureBundle a))
-> Traversable TemperatureBundle
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 =>
TemperatureBundle (m a) -> m (TemperatureBundle a)
forall (f :: * -> *) a.
Applicative f =>
TemperatureBundle (f a) -> f (TemperatureBundle a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TemperatureBundle a -> m (TemperatureBundle b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TemperatureBundle a -> f (TemperatureBundle b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TemperatureBundle a -> f (TemperatureBundle b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TemperatureBundle a -> f (TemperatureBundle b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TemperatureBundle (f a) -> f (TemperatureBundle a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TemperatureBundle (f a) -> f (TemperatureBundle a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TemperatureBundle a -> m (TemperatureBundle b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TemperatureBundle a -> m (TemperatureBundle b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
TemperatureBundle (m a) -> m (TemperatureBundle a)
sequence :: forall (m :: * -> *) a.
Monad m =>
TemperatureBundle (m a) -> m (TemperatureBundle a)
Traversable)
instance Semigroup a => Semigroup (TemperatureBundle a) where
TemperatureBundle WithProtocolTemperature 'Hot a
hot WithProtocolTemperature 'Warm a
warm WithProtocolTemperature 'Established a
established <> :: TemperatureBundle a -> TemperatureBundle a -> TemperatureBundle a
<> TemperatureBundle WithProtocolTemperature 'Hot a
hot' WithProtocolTemperature 'Warm a
warm' WithProtocolTemperature 'Established a
established' =
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
TemperatureBundle (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 (TemperatureBundle a) where
mempty :: TemperatureBundle a
mempty = WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
TemperatureBundle 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 :: SingProtocolTemperature pt -> TemperatureBundle a -> a
projectBundle :: forall (pt :: ProtocolTemperature) a.
SingProtocolTemperature pt -> TemperatureBundle a -> a
projectBundle SingProtocolTemperature pt
SingHot = WithProtocolTemperature 'Hot a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithProtocolTemperature 'Hot a -> a)
-> (TemperatureBundle a -> WithProtocolTemperature 'Hot a)
-> TemperatureBundle a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemperatureBundle a -> WithProtocolTemperature 'Hot a
forall a. TemperatureBundle a -> WithProtocolTemperature 'Hot a
withHot
projectBundle SingProtocolTemperature pt
SingWarm = WithProtocolTemperature 'Warm a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithProtocolTemperature 'Warm a -> a)
-> (TemperatureBundle a -> WithProtocolTemperature 'Warm a)
-> TemperatureBundle a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemperatureBundle a -> WithProtocolTemperature 'Warm a
forall a. TemperatureBundle a -> WithProtocolTemperature 'Warm a
withWarm
projectBundle SingProtocolTemperature pt
SingEstablished = WithProtocolTemperature 'Established a -> a
forall (pt :: ProtocolTemperature) a.
WithProtocolTemperature pt a -> a
withoutProtocolTemperature (WithProtocolTemperature 'Established a -> a)
-> (TemperatureBundle a -> WithProtocolTemperature 'Established a)
-> TemperatureBundle a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemperatureBundle a -> WithProtocolTemperature 'Established a
forall a.
TemperatureBundle a -> WithProtocolTemperature 'Established a
withEstablished
instance Applicative TemperatureBundle where
pure :: forall a. a -> TemperatureBundle a
pure a
a = WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
TemperatureBundle (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)
TemperatureBundle WithProtocolTemperature 'Hot (a -> b)
hotFn
WithProtocolTemperature 'Warm (a -> b)
warmFn
WithProtocolTemperature 'Established (a -> b)
establishedFn
<*> :: forall a b.
TemperatureBundle (a -> b)
-> TemperatureBundle a -> TemperatureBundle b
<*> TemperatureBundle WithProtocolTemperature 'Hot a
hot
WithProtocolTemperature 'Warm a
warm
WithProtocolTemperature 'Established a
established =
WithProtocolTemperature 'Hot b
-> WithProtocolTemperature 'Warm b
-> WithProtocolTemperature 'Established b
-> TemperatureBundle b
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
TemperatureBundle (WithProtocolTemperature 'Hot (a -> b)
hotFn WithProtocolTemperature 'Hot (a -> b)
-> WithProtocolTemperature 'Hot a -> WithProtocolTemperature 'Hot b
forall a b.
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 a b.
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 a b.
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)
type OuroborosBundle (mode :: MuxMode) initiatorCtx responderCtx bytes m a b =
TemperatureBundle [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
type OuroborosBundleWithExpandedCtx (mode :: MuxMode) peerAddr bytes m a b =
OuroborosBundle mode
(ExpandedInitiatorContext peerAddr m)
(ResponderContext peerAddr)
bytes m a b
data MiniProtocol (mode :: MuxMode) initiatorCtx responderCtx bytes m a b =
MiniProtocol {
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum :: !MiniProtocolNum,
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolLimits
miniProtocolLimits :: !MiniProtocolLimits,
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol mode initiatorCtx responderCtx bytes m a b
miniProtocolRun :: !(RunMiniProtocol mode initiatorCtx responderCtx bytes m a b)
}
type MiniProtocolWithExpandedCtx mode peerAddr bytes m a b =
MiniProtocol mode (ExpandedInitiatorContext peerAddr m)
(ResponderContext peerAddr)
bytes m a b
type MiniProtocolWithMinimalCtx mode peerAddr bytes m a b =
MiniProtocol mode (MinimalInitiatorContext peerAddr)
(ResponderContext peerAddr)
bytes m a b
data RunMiniProtocol (mode :: MuxMode) initiatorCtx responderCtx bytes m a b where
InitiatorProtocolOnly
:: (MiniProtocolCb initiatorCtx bytes m a)
-> RunMiniProtocol InitiatorMode initiatorCtx responderCtx bytes m a Void
ResponderProtocolOnly
:: (MiniProtocolCb responderCtx bytes m b)
-> RunMiniProtocol ResponderMode initiatorCtx responderCtx bytes m Void b
InitiatorAndResponderProtocol
:: (MiniProtocolCb initiatorCtx bytes m a)
-> (MiniProtocolCb responderCtx bytes m b)
-> RunMiniProtocol InitiatorResponderMode initiatorCtx responderCtx bytes m a b
type RunMiniProtocolWithExpandedCtx mode peerAddr bytes m a b =
RunMiniProtocol mode
(ExpandedInitiatorContext peerAddr m)
(ResponderContext peerAddr)
bytes m a b
type RunMiniProtocolWithMinimalCtx mode peerAddr bytes m a b =
RunMiniProtocol mode
(MinimalInitiatorContext peerAddr)
(ResponderContext peerAddr)
bytes m a b
data MiniProtocolCb ctx bytes m a where
MiniProtocolCb
:: (ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MuxPeer
:: forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes m a.
( Show failure
, forall (st' :: ps). Show (ClientHasAgency st')
, forall (st' :: ps). Show (ServerHasAgency st')
, ShowProxy ps
)
=> (ctx -> ( Tracer m (TraceSendRecv ps)
, Codec ps failure m bytes
, Peer ps pr st m a
))
-> MiniProtocolCb ctx bytes m a
MuxPeerPipelined
:: forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes m a.
( Show failure
, forall (st' :: ps). Show (ClientHasAgency st')
, forall (st' :: ps). Show (ServerHasAgency st')
, ShowProxy ps
)
=> (ctx -> ( Tracer m (TraceSendRecv ps)
, Codec ps failure m bytes
, PeerPipelined ps pr st m a
))
-> MiniProtocolCb ctx bytes m a
type MuxPeer = MiniProtocolCb
{-# DEPRECATED MuxPeer
[ "Use either `MiniProtocolCb` type instead of `MuxPeer` type, or"
, "`mkMiniProtocolCbFromPeer` instead the `MuxPeer` constructor."
]
#-}
{-# DEPRECATED MuxPeerPipelined "Use mkMiniProtocolCbFromPeer instead" #-}
pattern MuxPeerRaw :: forall ctx bytes m a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
pattern $mMuxPeerRaw :: forall {r} {ctx} {bytes} {m :: * -> *} {a}.
MiniProtocolCb ctx bytes m a
-> ((ctx -> Channel m bytes -> m (a, Maybe bytes)) -> r)
-> ((# #) -> r)
-> r
$bMuxPeerRaw :: forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MuxPeerRaw { forall ctx bytes (m :: * -> *) a.
MiniProtocolCb ctx bytes m a
-> ctx -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer } = MiniProtocolCb runMuxPeer
{-# DEPRECATED MuxPeerRaw "Use MiniProtocolCb instead" #-}
{-# DEPRECATED runMuxPeer
[ "Use runMiniProtocolCb instead"
, "Note that with runMiniProtocolCb there's no need to use Ouroboros.Network.Channel.fromChannel"
]
#-}
mkMiniProtocolCbFromPeer
:: forall (pr :: PeerRole) ps (st :: ps) failure bytes ctx m a.
( MonadThrow m
, Show failure
, forall (st' :: ps). Show (ClientHasAgency st')
, forall (st' :: ps). Show (ServerHasAgency st')
, ShowProxy ps
)
=> (ctx -> ( Tracer m (TraceSendRecv ps)
, Codec ps failure m bytes
, Peer ps pr st m a
)
)
-> MiniProtocolCb ctx bytes m a
mkMiniProtocolCbFromPeer :: forall (pr :: PeerRole) ps (st :: ps) failure bytes ctx
(m :: * -> *) a.
(MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
(ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a))
-> MiniProtocolCb ctx bytes m a
mkMiniProtocolCbFromPeer ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a)
fn =
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb ((ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a)
-> (ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
forall a b. (a -> b) -> a -> b
$ \ctx
ctx Channel m bytes
channel ->
case ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a)
fn ctx
ctx of
(Tracer m (TraceSendRecv ps)
tracer, Codec ps failure m bytes
codec, Peer ps pr st m a
peer) ->
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
mkMiniProtocolCbFromPeerPipelined
:: forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes m a.
( MonadAsync m
, MonadThrow m
, Show failure
, forall (st' :: ps). Show (ClientHasAgency st')
, forall (st' :: ps). Show (ServerHasAgency st')
, ShowProxy ps
)
=> (ctx -> ( Tracer m (TraceSendRecv ps)
, Codec ps failure m bytes
, PeerPipelined ps pr st m a
)
)
-> MiniProtocolCb ctx bytes m a
mkMiniProtocolCbFromPeerPipelined :: forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes
(m :: * -> *) a.
(MonadAsync m, MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
(ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a))
-> MiniProtocolCb ctx bytes m a
mkMiniProtocolCbFromPeerPipelined ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a)
fn =
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb ((ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a)
-> (ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
forall a b. (a -> b) -> a -> b
$ \ctx
ctx Channel m bytes
channel ->
case ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a)
fn ctx
ctx of
(Tracer m (TraceSendRecv ps)
tracer, Codec ps failure m bytes
codec, PeerPipelined ps pr st m a
peer) ->
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
runMiniProtocolCb :: ( MonadAsync m
, MonadThrow m
)
=> MiniProtocolCb ctx LBS.ByteString m a
-> ctx
-> Mux.Channel m
-> m (a, Maybe LBS.ByteString)
runMiniProtocolCb :: forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb (MiniProtocolCb ctx -> Channel m ByteString -> m (a, Maybe ByteString)
run) !ctx
ctx = ctx -> Channel m ByteString -> m (a, Maybe ByteString)
run ctx
ctx (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
runMiniProtocolCb (MuxPeer ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m ByteString,
Peer ps pr st m a)
fn) !ctx
ctx = MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb ((ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m ByteString,
Peer ps pr st m a))
-> MiniProtocolCb ctx ByteString m a
forall (pr :: PeerRole) ps (st :: ps) failure bytes ctx
(m :: * -> *) a.
(MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
(ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a))
-> MiniProtocolCb ctx bytes m a
mkMiniProtocolCbFromPeer ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m ByteString,
Peer ps pr st m a)
fn) ctx
ctx
runMiniProtocolCb (MuxPeerPipelined ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m ByteString,
PeerPipelined ps pr st m a)
fn) !ctx
ctx = MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb ((ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m ByteString,
PeerPipelined ps pr st m a))
-> MiniProtocolCb ctx ByteString m a
forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes
(m :: * -> *) a.
(MonadAsync m, MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
(ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a))
-> MiniProtocolCb ctx bytes m a
mkMiniProtocolCbFromPeerPipelined ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m ByteString,
PeerPipelined ps pr st m a)
fn) ctx
ctx
contramapMiniProtocolCbCtx :: (ctx -> ctx')
-> MiniProtocolCb ctx' bytes m a
-> MiniProtocolCb ctx bytes m a
contramapMiniProtocolCbCtx :: forall ctx ctx' bytes (m :: * -> *) a.
(ctx -> ctx')
-> MiniProtocolCb ctx' bytes m a -> MiniProtocolCb ctx bytes m a
contramapMiniProtocolCbCtx ctx -> ctx'
f (MiniProtocolCb ctx' -> Channel m bytes -> m (a, Maybe bytes)
cb) = (ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (ctx' -> Channel m bytes -> m (a, Maybe bytes)
cb (ctx' -> Channel m bytes -> m (a, Maybe bytes))
-> (ctx -> ctx') -> ctx -> Channel m bytes -> m (a, Maybe bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx -> ctx'
f)
contramapMiniProtocolCbCtx ctx -> ctx'
f (MuxPeer ctx'
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a)
cb) = (ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a))
-> MiniProtocolCb ctx bytes m a
forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes
(m :: * -> *) a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
(ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a))
-> MiniProtocolCb ctx bytes m a
MuxPeer (ctx'
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a)
cb (ctx'
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a))
-> (ctx -> ctx')
-> ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
Peer ps pr st m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx -> ctx'
f)
contramapMiniProtocolCbCtx ctx -> ctx'
f (MuxPeerPipelined ctx'
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a)
cb) = (ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a))
-> MiniProtocolCb ctx bytes m a
forall (pr :: PeerRole) ps (st :: ps) failure ctx bytes
(m :: * -> *) a.
(Show failure, forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
(ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a))
-> MiniProtocolCb ctx bytes m a
MuxPeerPipelined (ctx'
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a)
cb (ctx'
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a))
-> (ctx -> ctx')
-> ctx
-> (Tracer m (TraceSendRecv ps), Codec ps failure m bytes,
PeerPipelined ps pr st m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx -> ctx'
f)
newtype OuroborosApplication (mode :: MuxMode) initiatorCtx responderCtx bytes m a b =
OuroborosApplication [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
type OuroborosApplicationWithMinimalCtx mode peerAddr bytes m a b =
OuroborosApplication mode
(MinimalInitiatorContext peerAddr)
(ResponderContext peerAddr)
bytes m a b
fromOuroborosBundle :: OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
fromOuroborosBundle :: forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
fromOuroborosBundle = [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
[MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
OuroborosApplication ([MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b)
-> (OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> [MiniProtocol mode initiatorCtx responderCtx bytes m a b])
-> OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
forall m. Monoid m => TemperatureBundle m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
contramapInitiatorCtx :: (initiatorCtx' -> initiatorCtx)
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
-> OuroborosApplication mode initiatorCtx' responderCtx bytes m a b
contramapInitiatorCtx :: forall initiatorCtx' initiatorCtx (mode :: MuxMode) responderCtx
bytes (m :: * -> *) a b.
(initiatorCtx' -> initiatorCtx)
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
-> OuroborosApplication mode initiatorCtx' responderCtx bytes m a b
contramapInitiatorCtx initiatorCtx' -> initiatorCtx
f (OuroborosApplication [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
ptcls) = [MiniProtocol mode initiatorCtx' responderCtx bytes m a b]
-> OuroborosApplication mode initiatorCtx' responderCtx bytes m a b
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
[MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
OuroborosApplication
[ MiniProtocol mode initiatorCtx responderCtx bytes m a b
ptcl { miniProtocolRun =
case miniProtocolRun ptcl of
InitiatorProtocolOnly MiniProtocolCb initiatorCtx bytes m a
initiator ->
MiniProtocolCb initiatorCtx' bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx' responderCtx bytes m a Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((initiatorCtx' -> initiatorCtx)
-> MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb initiatorCtx' bytes m a
forall ctx ctx' bytes (m :: * -> *) a.
(ctx -> ctx')
-> MiniProtocolCb ctx' bytes m a -> MiniProtocolCb ctx bytes m a
contramapMiniProtocolCbCtx initiatorCtx' -> initiatorCtx
f MiniProtocolCb initiatorCtx bytes m a
initiator)
ResponderProtocolOnly MiniProtocolCb responderCtx bytes m b
responder ->
MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'ResponderMode initiatorCtx' responderCtx bytes m Void b
forall responderCtx bytes (m :: * -> *) b initiatorCtx.
MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'ResponderMode initiatorCtx responderCtx bytes m Void b
ResponderProtocolOnly MiniProtocolCb responderCtx bytes m b
responder
InitiatorAndResponderProtocol MiniProtocolCb initiatorCtx bytes m a
initiator MiniProtocolCb responderCtx bytes m b
responder ->
MiniProtocolCb initiatorCtx' bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx' responderCtx bytes m a b
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol ((initiatorCtx' -> initiatorCtx)
-> MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb initiatorCtx' bytes m a
forall ctx ctx' bytes (m :: * -> *) a.
(ctx -> ctx')
-> MiniProtocolCb ctx' bytes m a -> MiniProtocolCb ctx bytes m a
contramapMiniProtocolCbCtx initiatorCtx' -> initiatorCtx
f MiniProtocolCb initiatorCtx bytes m a
initiator) MiniProtocolCb responderCtx bytes m b
responder
}
| MiniProtocol mode initiatorCtx responderCtx bytes m a b
ptcl <- [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
ptcls
]
toApplication :: forall mode initiatorCtx responderCtx m a b.
(MonadAsync m, MonadThrow m)
=> initiatorCtx
-> responderCtx
-> OuroborosApplication mode initiatorCtx responderCtx LBS.ByteString m a b
-> Mux.Compat.MuxApplication mode m a b
toApplication :: forall (mode :: MuxMode) initiatorCtx responderCtx (m :: * -> *) a
b.
(MonadAsync m, MonadThrow m) =>
initiatorCtx
-> responderCtx
-> OuroborosApplication
mode initiatorCtx responderCtx ByteString m a b
-> MuxApplication mode m a b
toApplication initiatorCtx
initiatorContext responderCtx
responderContext (OuroborosApplication [MiniProtocol mode initiatorCtx responderCtx 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
[ Mux.Compat.MuxMiniProtocol {
miniProtocolNum :: MiniProtocolNum
Mux.Compat.miniProtocolNum = MiniProtocol mode initiatorCtx responderCtx ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol mode initiatorCtx responderCtx ByteString m a b
ptcl,
miniProtocolLimits :: MiniProtocolLimits
Mux.Compat.miniProtocolLimits = MiniProtocol mode initiatorCtx responderCtx ByteString m a b
-> MiniProtocolLimits
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolLimits
miniProtocolLimits MiniProtocol mode initiatorCtx responderCtx ByteString m a b
ptcl,
miniProtocolRun :: RunMiniProtocol mode m a b
Mux.Compat.miniProtocolRun = RunMiniProtocol mode initiatorCtx responderCtx ByteString m a b
-> RunMiniProtocol mode m a b
toMuxRunMiniProtocol (MiniProtocol mode initiatorCtx responderCtx ByteString m a b
-> RunMiniProtocol mode initiatorCtx responderCtx ByteString m a b
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol mode initiatorCtx responderCtx bytes m a b
miniProtocolRun MiniProtocol mode initiatorCtx responderCtx ByteString m a b
ptcl)
}
| MiniProtocol mode initiatorCtx responderCtx ByteString m a b
ptcl <- [MiniProtocol mode initiatorCtx responderCtx ByteString m a b]
ptcls ]
where
toMuxRunMiniProtocol :: RunMiniProtocol mode initiatorCtx responderCtx LBS.ByteString m a b
-> Mux.Compat.RunMiniProtocol mode m a b
toMuxRunMiniProtocol :: RunMiniProtocol mode initiatorCtx responderCtx ByteString m a b
-> RunMiniProtocol mode m a b
toMuxRunMiniProtocol (InitiatorProtocolOnly MiniProtocolCb initiatorCtx 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
(MiniProtocolCb initiatorCtx ByteString m a
-> initiatorCtx -> Channel m -> m (a, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb MiniProtocolCb initiatorCtx ByteString m a
i initiatorCtx
initiatorContext)
toMuxRunMiniProtocol (ResponderProtocolOnly MiniProtocolCb responderCtx 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
(MiniProtocolCb responderCtx ByteString m b
-> responderCtx -> Channel m -> m (b, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb MiniProtocolCb responderCtx ByteString m b
r responderCtx
responderContext)
toMuxRunMiniProtocol (InitiatorAndResponderProtocol MiniProtocolCb initiatorCtx ByteString m a
i MiniProtocolCb responderCtx 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
(MiniProtocolCb initiatorCtx ByteString m a
-> initiatorCtx -> Channel m -> m (a, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb MiniProtocolCb initiatorCtx ByteString m a
i initiatorCtx
initiatorContext)
(MiniProtocolCb responderCtx ByteString m b
-> responderCtx -> Channel m -> m (b, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> Channel m -> m (a, Maybe ByteString)
runMiniProtocolCb MiniProtocolCb responderCtx ByteString m b
r responderCtx
responderContext)
mkMiniProtocolBundle :: OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolBundle mode
mkMiniProtocolBundle :: forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolBundle mode
mkMiniProtocolBundle = [MiniProtocolInfo mode] -> MiniProtocolBundle mode
forall (mode :: MuxMode).
[MiniProtocolInfo mode] -> MiniProtocolBundle mode
MiniProtocolBundle ([MiniProtocolInfo mode] -> MiniProtocolBundle mode)
-> (OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> [MiniProtocolInfo mode])
-> OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolBundle mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> [MiniProtocolInfo mode])
-> OuroborosBundle mode initiatorCtx responderCtx bytes m a b
-> [MiniProtocolInfo mode]
forall m a. Monoid m => (a -> m) -> TemperatureBundle a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> [MiniProtocolInfo mode]
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
[MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> [MiniProtocolInfo mode]
fn
where
fn :: [MiniProtocol mode initiatorCtx responderCtx bytes m a b] -> [MiniProtocolInfo mode]
fn :: forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
[MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> [MiniProtocolInfo mode]
fn [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
ptcls = [ 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 :: forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum :: MiniProtocolNum
miniProtocolNum
, MiniProtocolLimits
miniProtocolLimits :: forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolLimits
miniProtocolLimits :: MiniProtocolLimits
miniProtocolLimits
, RunMiniProtocol mode initiatorCtx responderCtx bytes m a b
miniProtocolRun :: forall (mode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol mode initiatorCtx responderCtx bytes m a b
miniProtocolRun :: RunMiniProtocol mode initiatorCtx responderCtx bytes m a b
miniProtocolRun
}
<- [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
ptcls
, MiniProtocolDirection mode
dir <- case RunMiniProtocol mode initiatorCtx responderCtx 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 ]
]