{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeInType            #-}
{-# LANGUAGE UndecidableInstances  #-}

-- | Drivers for running 'Peer's.
--
module Ouroboros.Network.Driver.Limits
  ( -- * Limits
    ProtocolSizeLimits (..)
  , ProtocolTimeLimits (..)
  , ProtocolLimitFailure (..)
    -- * Normal peers
  , runPeerWithLimits
  , TraceSendRecv (..)
    -- * Pipelined peers
  , runPipelinedPeerWithLimits
    -- * Driver utilities
  , driverWithLimits
  ) where

import           Data.Maybe (fromMaybe)

import           Control.Monad.Class.MonadAsync
import           Control.Monad.Class.MonadFork
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Class.MonadTime
import           Control.Monad.Class.MonadTimer
import           Control.Tracer (Tracer (..), traceWith)

import           Network.Mux.Timeout
import           Network.TypedProtocol.Codec
import           Network.TypedProtocol.Core
import           Network.TypedProtocol.Driver
import           Network.TypedProtocol.Pipelined

import           Ouroboros.Network.Channel
import           Ouroboros.Network.Driver.Simple (DecoderFailure (..),
                     TraceSendRecv (..))
import           Ouroboros.Network.Util.ShowProxy


data ProtocolSizeLimits ps bytes = ProtocolSizeLimits {
       ProtocolSizeLimits ps bytes
-> forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word
sizeLimitForState :: forall (pr :: PeerRole) (st :: ps).
                            PeerHasAgency pr st -> Word,

       ProtocolSizeLimits ps bytes -> bytes -> Word
dataSize          :: bytes -> Word
     }

data ProtocolTimeLimits ps = ProtocolTimeLimits {
       ProtocolTimeLimits ps
-> forall (pr :: PeerRole) (st :: ps).
   PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState :: forall (pr :: PeerRole) (st :: ps).
                            PeerHasAgency pr st -> Maybe DiffTime
     }

data ProtocolLimitFailure where
    ExceededSizeLimit :: forall (pr :: PeerRole) ps (st :: ps).
                         ( forall (st' :: ps). Show (ClientHasAgency st')
                         , forall (st' :: ps). Show (ServerHasAgency st')
                         , ShowProxy ps
                         )
                      => PeerHasAgency pr st
                      -> ProtocolLimitFailure
    ExceededTimeLimit :: forall (pr :: PeerRole) ps (st :: ps).
                         ( forall (st' :: ps). Show (ClientHasAgency st')
                         , forall (st' :: ps). Show (ServerHasAgency st')
                         , ShowProxy ps
                         )
                      => PeerHasAgency pr st
                      -> ProtocolLimitFailure

instance Show ProtocolLimitFailure where
    show :: ProtocolLimitFailure -> String
show (ExceededSizeLimit (PeerHasAgency pr st
stok :: PeerHasAgency pr (st :: ps))) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ExceededSizeLimit ("
        , Proxy ps -> String
forall k (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy ps
forall k (t :: k). Proxy t
Proxy :: Proxy ps)
        , String
") ("
        , PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok
        , String
")"
        ]
    show (ExceededTimeLimit (PeerHasAgency pr st
stok :: PeerHasAgency pr (st :: ps))) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ExceededTimeLimit ("
        , Proxy ps -> String
forall k (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy ps
forall k (t :: k). Proxy t
Proxy :: Proxy ps)
        , String
") ("
        , PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok
        , String
")"
        ]

instance Exception ProtocolLimitFailure where


driverWithLimits :: forall ps failure bytes m.
                    ( MonadThrow m
                    , Show failure
                    , ShowProxy ps
                    , forall (st' :: ps). Show (ClientHasAgency st')
                    , forall (st' :: ps). Show (ServerHasAgency st')
                    )
                 => Tracer m (TraceSendRecv ps)
                 -> TimeoutFn m
                 -> Codec ps failure m bytes
                 -> ProtocolSizeLimits ps bytes
                 -> ProtocolTimeLimits ps
                 -> Channel m bytes
                 -> Driver ps (Maybe bytes) m
driverWithLimits :: Tracer m (TraceSendRecv ps)
-> TimeoutFn m
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Driver ps (Maybe bytes) m
driverWithLimits Tracer m (TraceSendRecv ps)
tracer TimeoutFn m
timeoutFn
                 Codec{forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> bytes
encode :: forall ps failure (m :: * -> *) bytes.
Codec ps failure m bytes
-> forall (pr :: PeerRole) (st :: ps) (st' :: ps).
   PeerHasAgency pr st -> Message ps st st' -> bytes
encode :: forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> bytes
encode, forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> m (DecodeStep bytes failure m (SomeMessage st))
decode :: forall ps failure (m :: * -> *) bytes.
Codec ps failure m bytes
-> forall (pr :: PeerRole) (st :: ps).
   PeerHasAgency pr st
   -> m (DecodeStep bytes failure m (SomeMessage st))
decode :: forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> m (DecodeStep bytes failure m (SomeMessage st))
decode}
                 ProtocolSizeLimits{forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word
sizeLimitForState :: forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word
sizeLimitForState :: forall ps bytes.
ProtocolSizeLimits ps bytes
-> forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word
sizeLimitForState, bytes -> Word
dataSize :: bytes -> Word
dataSize :: forall ps bytes. ProtocolSizeLimits ps bytes -> bytes -> Word
dataSize}
                 ProtocolTimeLimits{forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState :: forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState :: forall ps.
ProtocolTimeLimits ps
-> forall (pr :: PeerRole) (st :: ps).
   PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState}
                 channel :: Channel m bytes
channel@Channel{bytes -> m ()
send :: forall (m :: * -> *) a. Channel m a -> a -> m ()
send :: bytes -> m ()
send} =
    Driver :: forall ps dstate (m :: * -> *).
(forall (pr :: PeerRole) (st :: ps) (st' :: ps).
 PeerHasAgency pr st -> Message ps st st' -> m ())
-> (forall (pr :: PeerRole) (st :: ps).
    PeerHasAgency pr st -> dstate -> m (SomeMessage st, dstate))
-> dstate
-> Driver ps dstate m
Driver { forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> m ()
sendMessage :: forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> m ()
sendMessage :: forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> m ()
sendMessage, forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> Maybe bytes -> m (SomeMessage st, Maybe bytes)
recvMessage :: forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> Maybe bytes -> m (SomeMessage st, Maybe bytes)
recvMessage :: forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> Maybe bytes -> m (SomeMessage st, Maybe bytes)
recvMessage, startDState :: Maybe bytes
startDState = Maybe bytes
forall a. Maybe a
Nothing }
  where
    sendMessage :: forall (pr :: PeerRole) (st :: ps) (st' :: ps).
                   PeerHasAgency pr st
                -> Message ps st st'
                -> m ()
    sendMessage :: PeerHasAgency pr st -> Message ps st st' -> m ()
sendMessage PeerHasAgency pr st
stok Message ps st st'
msg = do
      bytes -> m ()
send (PeerHasAgency pr st -> Message ps st st' -> bytes
forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> bytes
encode PeerHasAgency pr st
stok Message ps st st'
msg)
      Tracer m (TraceSendRecv ps) -> TraceSendRecv ps -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceSendRecv ps)
tracer (AnyMessageAndAgency ps -> TraceSendRecv ps
forall ps. AnyMessageAndAgency ps -> TraceSendRecv ps
TraceSendMsg (PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency PeerHasAgency pr st
stok Message ps st st'
msg))

    recvMessage :: forall (pr :: PeerRole) (st :: ps).
                   PeerHasAgency pr st
                -> Maybe bytes
                -> m (SomeMessage st, Maybe bytes)
    recvMessage :: PeerHasAgency pr st
-> Maybe bytes -> m (SomeMessage st, Maybe bytes)
recvMessage PeerHasAgency pr st
stok Maybe bytes
trailing = do
      DecodeStep bytes failure m (SomeMessage st)
decoder <- PeerHasAgency pr st
-> m (DecodeStep bytes failure m (SomeMessage st))
forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> m (DecodeStep bytes failure m (SomeMessage st))
decode PeerHasAgency pr st
stok
      let sizeLimit :: Word
sizeLimit = PeerHasAgency pr st -> Word
forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word
sizeLimitForState PeerHasAgency pr st
stok
          timeLimit :: DiffTime
timeLimit = DiffTime -> Maybe DiffTime -> DiffTime
forall a. a -> Maybe a -> a
fromMaybe (-DiffTime
1) (PeerHasAgency pr st -> Maybe DiffTime
forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st -> Maybe DiffTime
timeLimitForState PeerHasAgency pr st
stok)
      Maybe (Either (Maybe failure) (SomeMessage st, Maybe bytes))
result  <- DiffTime
-> m (Either (Maybe failure) (SomeMessage st, Maybe bytes))
-> m (Maybe (Either (Maybe failure) (SomeMessage st, Maybe bytes)))
TimeoutFn m
timeoutFn DiffTime
timeLimit (m (Either (Maybe failure) (SomeMessage st, Maybe bytes))
 -> m (Maybe
         (Either (Maybe failure) (SomeMessage st, Maybe bytes))))
-> m (Either (Maybe failure) (SomeMessage st, Maybe bytes))
-> m (Maybe (Either (Maybe failure) (SomeMessage st, Maybe bytes)))
forall a b. (a -> b) -> a -> b
$
                   Word
-> (bytes -> Word)
-> Channel m bytes
-> Maybe bytes
-> DecodeStep bytes failure m (SomeMessage st)
-> m (Either (Maybe failure) (SomeMessage st, Maybe bytes))
forall (m :: * -> *) bytes failure a.
Monad m =>
Word
-> (bytes -> Word)
-> Channel m bytes
-> Maybe bytes
-> DecodeStep bytes failure m a
-> m (Either (Maybe failure) (a, Maybe bytes))
runDecoderWithLimit Word
sizeLimit bytes -> Word
dataSize
                                       Channel m bytes
channel Maybe bytes
trailing DecodeStep bytes failure m (SomeMessage st)
decoder
      case Maybe (Either (Maybe failure) (SomeMessage st, Maybe bytes))
result of
        Just (Right x :: (SomeMessage st, Maybe bytes)
x@(SomeMessage Message ps st st'
msg, Maybe bytes
_trailing')) -> do
          Tracer m (TraceSendRecv ps) -> TraceSendRecv ps -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceSendRecv ps)
tracer (AnyMessageAndAgency ps -> TraceSendRecv ps
forall ps. AnyMessageAndAgency ps -> TraceSendRecv ps
TraceRecvMsg (PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency PeerHasAgency pr st
stok Message ps st st'
msg))
          (SomeMessage st, Maybe bytes) -> m (SomeMessage st, Maybe bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st, Maybe bytes)
x
        Just (Left (Just failure
failure)) -> DecoderFailure -> m (SomeMessage st, Maybe bytes)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (PeerHasAgency pr st -> failure -> DecoderFailure
forall (pr :: PeerRole) ps (st :: ps) failure.
(forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 Show failure) =>
PeerHasAgency pr st -> failure -> DecoderFailure
DecoderFailure PeerHasAgency pr st
stok failure
failure)
        Just (Left Maybe failure
Nothing)        -> ProtocolLimitFailure -> m (SomeMessage st, Maybe bytes)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (PeerHasAgency pr st -> ProtocolLimitFailure
forall (pr :: PeerRole) ps (st :: ps).
(forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
PeerHasAgency pr st -> ProtocolLimitFailure
ExceededSizeLimit PeerHasAgency pr st
stok)
        Maybe (Either (Maybe failure) (SomeMessage st, Maybe bytes))
Nothing                    -> ProtocolLimitFailure -> m (SomeMessage st, Maybe bytes)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (PeerHasAgency pr st -> ProtocolLimitFailure
forall (pr :: PeerRole) ps (st :: ps).
(forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
PeerHasAgency pr st -> ProtocolLimitFailure
ExceededTimeLimit PeerHasAgency pr st
stok)

runDecoderWithLimit
    :: forall m bytes failure a. Monad m
    => Word
    -- ^ message size limit
    -> (bytes -> Word)
    -- ^ byte size
    -> Channel m bytes
    -> Maybe bytes
    -> DecodeStep bytes failure m a
    -> m (Either (Maybe failure) (a, Maybe bytes))
runDecoderWithLimit :: Word
-> (bytes -> Word)
-> Channel m bytes
-> Maybe bytes
-> DecodeStep bytes failure m a
-> m (Either (Maybe failure) (a, Maybe bytes))
runDecoderWithLimit Word
limit bytes -> Word
size Channel{m (Maybe bytes)
recv :: forall (m :: * -> *) a. Channel m a -> m (Maybe a)
recv :: m (Maybe bytes)
recv} =
    Word
-> Maybe bytes
-> DecodeStep bytes failure m a
-> m (Either (Maybe failure) (a, Maybe bytes))
go Word
0
  where
    -- Our strategy here is as follows...
    --
    -- We of course want to enforce the maximum data limit, but we also want to
    -- detect and report when we exceed the limit rather than having it be
    -- misclassified as a generic decode error. For example if we simply limited
    -- the decoder input to the maximum size then the failure would be reported
    -- as an unexpected end of input, rather than that the size limit was
    -- exceeded.
    --
    -- So our strategy is to allow the last chunk of input to exceed the limit.
    -- This leaves just one special case: if the decoder finishes with that
    -- final chunk, we must check if it consumed too much of the final chunk.
    --
    go :: Word        -- ^ size of consumed input so far
       -> Maybe bytes -- ^ any trailing data
       -> DecodeStep bytes failure m a
       -> m (Either (Maybe failure) (a, Maybe bytes))

    go :: Word
-> Maybe bytes
-> DecodeStep bytes failure m a
-> m (Either (Maybe failure) (a, Maybe bytes))
go !Word
sz Maybe bytes
_ (DecodeDone a
x Maybe bytes
trailing)
      | let sz' :: Word
sz' = Word
sz Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word -> (bytes -> Word) -> Maybe bytes -> Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word
0 bytes -> Word
size Maybe bytes
trailing
      , Word
sz' Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
limit = Either (Maybe failure) (a, Maybe bytes)
-> m (Either (Maybe failure) (a, Maybe bytes))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe failure -> Either (Maybe failure) (a, Maybe bytes)
forall a b. a -> Either a b
Left Maybe failure
forall a. Maybe a
Nothing)
      | Bool
otherwise   = Either (Maybe failure) (a, Maybe bytes)
-> m (Either (Maybe failure) (a, Maybe bytes))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Maybe bytes) -> Either (Maybe failure) (a, Maybe bytes)
forall a b. b -> Either a b
Right (a
x, Maybe bytes
trailing))

    go !Word
_ Maybe bytes
_  (DecodeFail failure
failure) = Either (Maybe failure) (a, Maybe bytes)
-> m (Either (Maybe failure) (a, Maybe bytes))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe failure -> Either (Maybe failure) (a, Maybe bytes)
forall a b. a -> Either a b
Left (failure -> Maybe failure
forall a. a -> Maybe a
Just failure
failure))

    go !Word
sz Maybe bytes
trailing (DecodePartial Maybe bytes -> m (DecodeStep bytes failure m a)
k)
      | Word
sz Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
limit = Either (Maybe failure) (a, Maybe bytes)
-> m (Either (Maybe failure) (a, Maybe bytes))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe failure -> Either (Maybe failure) (a, Maybe bytes)
forall a b. a -> Either a b
Left Maybe failure
forall a. Maybe a
Nothing)
      | Bool
otherwise  = case Maybe bytes
trailing of
                       Maybe bytes
Nothing -> do Maybe bytes
mbs <- m (Maybe bytes)
recv
                                     let !sz' :: Word
sz' = Word
sz Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word -> (bytes -> Word) -> Maybe bytes -> Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word
0 bytes -> Word
size Maybe bytes
mbs
                                     Word
-> Maybe bytes
-> DecodeStep bytes failure m a
-> m (Either (Maybe failure) (a, Maybe bytes))
go Word
sz' Maybe bytes
forall a. Maybe a
Nothing (DecodeStep bytes failure m a
 -> m (Either (Maybe failure) (a, Maybe bytes)))
-> m (DecodeStep bytes failure m a)
-> m (Either (Maybe failure) (a, Maybe bytes))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe bytes -> m (DecodeStep bytes failure m a)
k Maybe bytes
mbs
                       Just bytes
bs -> do let sz' :: Word
sz' = Word
sz Word -> Word -> Word
forall a. Num a => a -> a -> a
+ bytes -> Word
size bytes
bs
                                     Word
-> Maybe bytes
-> DecodeStep bytes failure m a
-> m (Either (Maybe failure) (a, Maybe bytes))
go Word
sz' Maybe bytes
forall a. Maybe a
Nothing (DecodeStep bytes failure m a
 -> m (Either (Maybe failure) (a, Maybe bytes)))
-> m (DecodeStep bytes failure m a)
-> m (Either (Maybe failure) (a, Maybe bytes))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe bytes -> m (DecodeStep bytes failure m a)
k (bytes -> Maybe bytes
forall a. a -> Maybe a
Just bytes
bs)


runPeerWithLimits
  :: forall ps (st :: ps) pr failure bytes m a .
     ( MonadAsync m
     , MonadFork m
     , MonadMask m
     , MonadThrow (STM m)
     , MonadMonotonicTime m
     , MonadTimer m
     , forall (st' :: ps). Show (ClientHasAgency st')
     , forall (st' :: ps). Show (ServerHasAgency st')
     , ShowProxy ps
     , Show failure
     )
  => Tracer m (TraceSendRecv ps)
  -> Codec ps failure m bytes
  -> ProtocolSizeLimits ps bytes
  -> ProtocolTimeLimits ps
  -> Channel m bytes
  -> Peer ps pr st m a
  -> m (a, Maybe bytes)
runPeerWithLimits :: Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeerWithLimits Tracer m (TraceSendRecv ps)
tracer Codec ps failure m bytes
codec ProtocolSizeLimits ps bytes
slimits ProtocolTimeLimits ps
tlimits Channel m bytes
channel Peer ps pr st m a
peer =
    (TimeoutFn m -> m (a, Maybe bytes)) -> m (a, Maybe bytes)
forall (m :: * -> *) b.
(MonadAsync m, MonadFork m, MonadMonotonicTime m, MonadTimer m,
 MonadMask m, MonadThrow (STM m)) =>
(TimeoutFn m -> m b) -> m b
withTimeoutSerial ((TimeoutFn m -> m (a, Maybe bytes)) -> m (a, Maybe bytes))
-> (TimeoutFn m -> m (a, Maybe bytes)) -> m (a, Maybe bytes)
forall a b. (a -> b) -> a -> b
$ \TimeoutFn m
timeoutFn ->
      let driver :: Driver ps (Maybe bytes) m
driver = Tracer m (TraceSendRecv ps)
-> TimeoutFn m
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Driver ps (Maybe bytes) m
forall ps failure bytes (m :: * -> *).
(MonadThrow m, Show failure, ShowProxy ps,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st')) =>
Tracer m (TraceSendRecv ps)
-> TimeoutFn m
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Driver ps (Maybe bytes) m
driverWithLimits Tracer m (TraceSendRecv ps)
tracer TimeoutFn m
timeoutFn Codec ps failure m bytes
codec ProtocolSizeLimits ps bytes
slimits ProtocolTimeLimits ps
tlimits Channel m bytes
channel
      in Driver ps (Maybe bytes) m
-> Peer ps pr st m a -> Maybe bytes -> m (a, Maybe bytes)
forall ps (st :: ps) (pr :: PeerRole) dstate (m :: * -> *) a.
Monad m =>
Driver ps dstate m -> Peer ps pr st m a -> dstate -> m (a, dstate)
runPeerWithDriver Driver ps (Maybe bytes) m
driver Peer ps pr st m a
peer (Driver ps (Maybe bytes) m -> Maybe bytes
forall ps dstate (m :: * -> *). Driver ps dstate m -> dstate
startDState Driver ps (Maybe bytes) m
driver)


-- | Run a pipelined peer with the given channel via the given codec.
--
-- This runs the peer to completion (if the protocol allows for termination).
--
-- Unlike normal peers, running pipelined peers rely on concurrency, hence the
-- 'MonadSTM' constraint.
--
runPipelinedPeerWithLimits
  :: forall ps (st :: ps) pr failure bytes m a.
     ( MonadAsync m
     , MonadFork m
     , MonadMask m
     , MonadThrow (STM m)
     , MonadMonotonicTime m
     , MonadTimer m
     , forall (st' :: ps). Show (ClientHasAgency st')
     , forall (st' :: ps). Show (ServerHasAgency st')
     , ShowProxy ps
     , Show failure
     )
  => Tracer m (TraceSendRecv ps)
  -> Codec ps failure m bytes
  -> ProtocolSizeLimits ps bytes
  -> ProtocolTimeLimits ps
  -> Channel m bytes
  -> PeerPipelined ps pr st m a
  -> m (a, Maybe bytes)
runPipelinedPeerWithLimits :: Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits Tracer m (TraceSendRecv ps)
tracer Codec ps failure m bytes
codec ProtocolSizeLimits ps bytes
slimits ProtocolTimeLimits ps
tlimits Channel m bytes
channel PeerPipelined ps pr st m a
peer =
    (TimeoutFn m -> m (a, Maybe bytes)) -> m (a, Maybe bytes)
forall (m :: * -> *) b.
(MonadAsync m, MonadFork m, MonadMonotonicTime m, MonadTimer m,
 MonadMask m, MonadThrow (STM m)) =>
(TimeoutFn m -> m b) -> m b
withTimeoutSerial ((TimeoutFn m -> m (a, Maybe bytes)) -> m (a, Maybe bytes))
-> (TimeoutFn m -> m (a, Maybe bytes)) -> m (a, Maybe bytes)
forall a b. (a -> b) -> a -> b
$ \TimeoutFn m
timeoutFn ->
      let driver :: Driver ps (Maybe bytes) m
driver = Tracer m (TraceSendRecv ps)
-> TimeoutFn m
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Driver ps (Maybe bytes) m
forall ps failure bytes (m :: * -> *).
(MonadThrow m, Show failure, ShowProxy ps,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st')) =>
Tracer m (TraceSendRecv ps)
-> TimeoutFn m
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Driver ps (Maybe bytes) m
driverWithLimits Tracer m (TraceSendRecv ps)
tracer TimeoutFn m
timeoutFn Codec ps failure m bytes
codec ProtocolSizeLimits ps bytes
slimits ProtocolTimeLimits ps
tlimits Channel m bytes
channel
      in Driver ps (Maybe bytes) m
-> PeerPipelined ps pr st m a -> Maybe bytes -> m (a, Maybe bytes)
forall ps (st :: ps) (pr :: PeerRole) dstate (m :: * -> *) a.
MonadAsync m =>
Driver ps dstate m
-> PeerPipelined ps pr st m a -> dstate -> m (a, dstate)
runPipelinedPeerWithDriver Driver ps (Maybe bytes) m
driver PeerPipelined ps pr st m a
peer (Driver ps (Maybe bytes) m -> Maybe bytes
forall ps dstate (m :: * -> *). Driver ps dstate m -> dstate
startDState Driver ps (Maybe bytes) m
driver)