{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Network.Protocol.BlockFetch.Client where

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

import           Ouroboros.Network.Protocol.BlockFetch.Type


-- | Block fetch client type for requesting ranges of blocks and handling
-- responses.
--
newtype BlockFetchClient block point m a = BlockFetchClient {
    BlockFetchClient block point m a
-> m (BlockFetchRequest block point m a)
runBlockFetchClient :: m (BlockFetchRequest block point m a)
  }

data BlockFetchRequest block point m a where
  -- | Request a chain range, supply handler for incoming blocks and
  -- a continuation.
  --
  SendMsgRequestRange
    :: ChainRange point
    -> BlockFetchResponse block m a
    -> BlockFetchClient   block point m a
    -> BlockFetchRequest  block point m a

  -- | Client terminating the block-fetch protocol.
  SendMsgClientDone
    :: a
    -> BlockFetchRequest block point m a

data BlockFetchResponse block m a = BlockFetchResponse {
    BlockFetchResponse block m a -> m (BlockFetchReceiver block m)
handleStartBatch :: m (BlockFetchReceiver block m),
    BlockFetchResponse block m a -> m ()
handleNoBlocks   :: m ()
  }

-- | Blocks are streamed and block receiver will handle each one when it comes,
-- it also needs to handle errors sent back from the server.
--
data BlockFetchReceiver block m = BlockFetchReceiver {
    BlockFetchReceiver block m
-> block -> m (BlockFetchReceiver block m)
handleBlock     :: block -> m (BlockFetchReceiver block m),
    BlockFetchReceiver block m -> m ()
handleBatchDone :: m ()
  }

blockFetchClientPeer
  :: forall block point m a.
     Monad m
  => BlockFetchClient block point m a
  -> Peer (BlockFetch block point) AsClient BFIdle m a
blockFetchClientPeer :: BlockFetchClient block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchClientPeer (BlockFetchClient m (BlockFetchRequest block point m a)
mclient) =
  m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall a b. (a -> b) -> a -> b
$ BlockFetchRequest block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchRequestPeer (BlockFetchRequest block point m a
 -> Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (BlockFetchRequest block point m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (BlockFetchRequest block point m a)
mclient
 where
  blockFetchRequestPeer
    :: BlockFetchRequest block point m a
    -> Peer (BlockFetch block point) AsClient BFIdle m a

  blockFetchRequestPeer :: BlockFetchRequest block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchRequestPeer (SendMsgClientDone a
result) =
    WeHaveAgency 'AsClient 'BFIdle
-> Message (BlockFetch block point) 'BFIdle 'BFDone
-> Peer (BlockFetch block point) 'AsClient 'BFDone m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ClientHasAgency 'BFIdle -> WeHaveAgency 'AsClient 'BFIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall k k (block :: k) (point :: k). ClientHasAgency 'BFIdle
TokIdle) Message (BlockFetch block point) 'BFIdle 'BFDone
forall k k (block :: k) (point :: k).
Message (BlockFetch block point) 'BFIdle 'BFDone
MsgClientDone (NobodyHasAgency 'BFDone
-> a -> Peer (BlockFetch block point) 'AsClient 'BFDone m a
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency 'BFDone
forall k k (block :: k) (point :: k). NobodyHasAgency 'BFDone
TokDone a
result)

  blockFetchRequestPeer (SendMsgRequestRange ChainRange point
range BlockFetchResponse block m a
resp BlockFetchClient block point m a
next) =
    WeHaveAgency 'AsClient 'BFIdle
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
-> Peer (BlockFetch block point) 'AsClient 'BFBusy m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield
      (ClientHasAgency 'BFIdle -> WeHaveAgency 'AsClient 'BFIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall k k (block :: k) (point :: k). ClientHasAgency 'BFIdle
TokIdle)
      (ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
forall k point (block :: k).
ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
MsgRequestRange ChainRange point
range)
      (BlockFetchClient block point m a
-> BlockFetchResponse block m a
-> Peer (BlockFetch block point) 'AsClient 'BFBusy m a
blockFetchResponsePeer BlockFetchClient block point m a
next BlockFetchResponse block m a
resp)


  blockFetchResponsePeer
    :: BlockFetchClient block point m a
    -> BlockFetchResponse block m a
    -> Peer (BlockFetch block point) AsClient BFBusy m a
  blockFetchResponsePeer :: BlockFetchClient block point m a
-> BlockFetchResponse block m a
-> Peer (BlockFetch block point) 'AsClient 'BFBusy m a
blockFetchResponsePeer BlockFetchClient block point m a
next BlockFetchResponse{m ()
handleNoBlocks :: m ()
handleNoBlocks :: forall block (m :: * -> *) k (a :: k).
BlockFetchResponse block m a -> m ()
handleNoBlocks, m (BlockFetchReceiver block m)
handleStartBatch :: m (BlockFetchReceiver block m)
handleStartBatch :: forall block (m :: * -> *) k (a :: k).
BlockFetchResponse block m a -> m (BlockFetchReceiver block m)
handleStartBatch} =
    TheyHaveAgency 'AsClient 'BFBusy
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFBusy st'
    -> Peer (BlockFetch block point) 'AsClient st' m a)
-> Peer (BlockFetch block point) 'AsClient 'BFBusy m a
forall (pr :: PeerRole) ps (st :: ps) (m :: * -> *) a.
TheyHaveAgency pr st
-> (forall (st' :: ps). Message ps st st' -> Peer ps pr st' m a)
-> Peer ps pr st m a
Await (ServerHasAgency 'BFBusy -> PeerHasAgency 'AsServer 'BFBusy
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFBusy
forall k k (block :: k) (point :: k). ServerHasAgency 'BFBusy
TokBusy) ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFBusy st'
  -> Peer (BlockFetch block point) 'AsClient st' m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFBusy m a)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFBusy st'
    -> Peer (BlockFetch block point) 'AsClient st' m a)
-> Peer (BlockFetch block point) 'AsClient 'BFBusy m a
forall a b. (a -> b) -> a -> b
$ \Message (BlockFetch block point) 'BFBusy st'
msg -> case Message (BlockFetch block point) 'BFBusy st'
msg of
      Message (BlockFetch block point) 'BFBusy st'
MsgStartBatch -> m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
forall a b. (a -> b) -> a -> b
$ BlockFetchClient block point m a
-> BlockFetchReceiver block m
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
blockReceiver BlockFetchClient block point m a
next (BlockFetchReceiver block m
 -> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> m (BlockFetchReceiver block m)
-> m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (BlockFetchReceiver block m)
handleStartBatch
      Message (BlockFetch block point) 'BFBusy st'
MsgNoBlocks   -> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall a b. (a -> b) -> a -> b
$ m ()
handleNoBlocks m ()
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (BlockFetchRequest block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchRequestPeer (BlockFetchRequest block point m a
 -> Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (BlockFetchRequest block point m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockFetchClient block point m a
-> m (BlockFetchRequest block point m a)
forall block point (m :: * -> *) a.
BlockFetchClient block point m a
-> m (BlockFetchRequest block point m a)
runBlockFetchClient BlockFetchClient block point m a
next)

  blockReceiver
    :: BlockFetchClient block point m a
    -> BlockFetchReceiver block m
    -> Peer (BlockFetch block point) AsClient BFStreaming m a
  blockReceiver :: BlockFetchClient block point m a
-> BlockFetchReceiver block m
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
blockReceiver BlockFetchClient block point m a
next BlockFetchReceiver{block -> m (BlockFetchReceiver block m)
handleBlock :: block -> m (BlockFetchReceiver block m)
handleBlock :: forall block (m :: * -> *).
BlockFetchReceiver block m
-> block -> m (BlockFetchReceiver block m)
handleBlock, m ()
handleBatchDone :: m ()
handleBatchDone :: forall block (m :: * -> *). BlockFetchReceiver block m -> m ()
handleBatchDone} =
    TheyHaveAgency 'AsClient 'BFStreaming
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFStreaming st'
    -> Peer (BlockFetch block point) 'AsClient st' m a)
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
forall (pr :: PeerRole) ps (st :: ps) (m :: * -> *) a.
TheyHaveAgency pr st
-> (forall (st' :: ps). Message ps st st' -> Peer ps pr st' m a)
-> Peer ps pr st m a
Await (ServerHasAgency 'BFStreaming
-> PeerHasAgency 'AsServer 'BFStreaming
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFStreaming
forall k k (block :: k) (point :: k). ServerHasAgency 'BFStreaming
TokStreaming) ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFStreaming st'
  -> Peer (BlockFetch block point) 'AsClient st' m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFStreaming st'
    -> Peer (BlockFetch block point) 'AsClient st' m a)
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
forall a b. (a -> b) -> a -> b
$ \Message (BlockFetch block point) 'BFStreaming st'
msg -> case Message (BlockFetch block point) 'BFStreaming st'
msg of
      MsgBlock block -> m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
forall a b. (a -> b) -> a -> b
$ BlockFetchClient block point m a
-> BlockFetchReceiver block m
-> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a
blockReceiver BlockFetchClient block point m a
next (BlockFetchReceiver block m
 -> Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
-> m (BlockFetchReceiver block m)
-> m (Peer (BlockFetch block point) 'AsClient 'BFStreaming m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> block -> m (BlockFetchReceiver block m)
handleBlock block
block
block
      Message (BlockFetch block point) 'BFStreaming st'
MsgBatchDone   -> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
 -> Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
forall a b. (a -> b) -> a -> b
$ do
        m ()
handleBatchDone
        BlockFetchRequest block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchRequestPeer (BlockFetchRequest block point m a
 -> Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
-> m (BlockFetchRequest block point m a)
-> m (Peer (BlockFetch block point) 'AsClient 'BFIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockFetchClient block point m a
-> m (BlockFetchRequest block point m a)
forall block point (m :: * -> *) a.
BlockFetchClient block point m a
-> m (BlockFetchRequest block point m a)
runBlockFetchClient BlockFetchClient block point m a
next

--
-- Pipelined client
--

-- | A BlockFetch client designed for running the protcol in a pipelined way.
--
data BlockFetchClientPipelined block point m a where
   -- | A 'BlockFetchSender', but starting with zero outstanding pipelined
   -- responses, and for any internal collect type @c@.
   BlockFetchClientPipelined
     :: BlockFetchSender      Z c block point m a
     -> BlockFetchClientPipelined block point m a

-- | A 'BlockFetchSender' with @n@ outstanding stream of block bodies.
--
data BlockFetchSender n c block point m a where

  -- | Send a `MsgRequestRange` but do not wait for response.  Supply a monadic
  -- action which runs on each received block and which updates the internal
  -- received value @c@.  @c@ could be a Monoid, though it's more general this
  -- way.
  --
  SendMsgRequestRangePipelined
    :: ChainRange point
    -> c
    -> (Maybe block -> c -> m c)
    -> BlockFetchSender (S n) c block point m a
    -> BlockFetchSender    n  c block point m a

  -- | Collect the result of a previous pipelined receive action
  --
  CollectBlocksPipelined
    :: Maybe (BlockFetchSender (S n) c block point m a)
    -> (c ->  BlockFetchSender    n  c block point m a)
    ->        BlockFetchSender (S n) c block point m a

  -- | Termination of the block-fetch protocol.
  SendMsgDonePipelined
    :: a -> BlockFetchSender Z c block point m a

blockFetchClientPeerPipelined
  :: forall block point m a.
     Monad m
  => BlockFetchClientPipelined block point m a
  -> PeerPipelined (BlockFetch block point) AsClient BFIdle m a
blockFetchClientPeerPipelined :: BlockFetchClientPipelined block point m a
-> PeerPipelined (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchClientPeerPipelined (BlockFetchClientPipelined BlockFetchSender 'Z c block point m a
sender) =
  PeerSender (BlockFetch block point) 'AsClient 'BFIdle 'Z c m a
-> PeerPipelined (BlockFetch block point) 'AsClient 'BFIdle m a
forall ps (pr :: PeerRole) (st :: ps) c (m :: * -> *) a.
PeerSender ps pr st 'Z c m a -> PeerPipelined ps pr st m a
PeerPipelined (BlockFetchSender 'Z c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle 'Z c m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
blockFetchClientPeerSender BlockFetchSender 'Z c block point m a
sender)

blockFetchClientPeerSender
  :: forall n block point c m a.
     Monad m
  => BlockFetchSender n c block point m a
  -> PeerSender (BlockFetch block point) AsClient BFIdle n c m a

blockFetchClientPeerSender :: BlockFetchSender n c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
blockFetchClientPeerSender (SendMsgDonePipelined a
result) =
  -- Send `MsgClientDone` and complete the protocol
  WeHaveAgency 'AsClient 'BFIdle
-> Message (BlockFetch block point) 'BFIdle 'BFDone
-> PeerSender (BlockFetch block point) 'AsClient 'BFDone 'Z c m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle 'Z c m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) c (m :: * -> *)
       a.
WeHaveAgency pr st
-> Message ps st st'
-> PeerSender ps pr st' 'Z c m a
-> PeerSender ps pr st 'Z c m a
SenderYield
    (ClientHasAgency 'BFIdle -> WeHaveAgency 'AsClient 'BFIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall k k (block :: k) (point :: k). ClientHasAgency 'BFIdle
TokIdle)
    Message (BlockFetch block point) 'BFIdle 'BFDone
forall k k (block :: k) (point :: k).
Message (BlockFetch block point) 'BFIdle 'BFDone
MsgClientDone
      (NobodyHasAgency 'BFDone
-> a
-> PeerSender (BlockFetch block point) 'AsClient 'BFDone 'Z c m a
forall ps (st :: ps) a (pr :: PeerRole) c (m :: * -> *).
NobodyHasAgency st -> a -> PeerSender ps pr st 'Z c m a
SenderDone NobodyHasAgency 'BFDone
forall k k (block :: k) (point :: k). NobodyHasAgency 'BFDone
TokDone a
result)

blockFetchClientPeerSender (SendMsgRequestRangePipelined ChainRange point
range c
c0 Maybe block -> c -> m c
receive BlockFetchSender ('S n) c block point m a
next) =
  -- Pipelined yield: send `MsgRequestRange`, return receicer which will
  -- consume a stream of blocks.
  WeHaveAgency 'AsClient 'BFIdle
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFBusy 'BFIdle m c
-> PeerSender
     (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (st'' :: ps)
       (m :: * -> *) c (n :: N) a.
WeHaveAgency pr st
-> Message ps st st'
-> PeerReceiver ps pr st' st'' m c
-> PeerSender ps pr st'' ('S n) c m a
-> PeerSender ps pr st n c m a
SenderPipeline
    (ClientHasAgency 'BFIdle -> WeHaveAgency 'AsClient 'BFIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall k k (block :: k) (point :: k). ClientHasAgency 'BFIdle
TokIdle)
    (ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
forall k point (block :: k).
ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
MsgRequestRange ChainRange point
range)
    (TheyHaveAgency 'AsClient 'BFBusy
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFBusy st'
    -> PeerReceiver (BlockFetch block point) 'AsClient st' 'BFIdle m c)
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFBusy 'BFIdle m c
forall (pr :: PeerRole) ps (st :: ps) (stdone :: ps) (m :: * -> *)
       c.
TheyHaveAgency pr st
-> (forall (st' :: ps).
    Message ps st st' -> PeerReceiver ps pr st' stdone m c)
-> PeerReceiver ps pr st stdone m c
ReceiverAwait (ServerHasAgency 'BFBusy -> PeerHasAgency 'AsServer 'BFBusy
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFBusy
forall k k (block :: k) (point :: k). ServerHasAgency 'BFBusy
TokBusy) ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFBusy st'
  -> PeerReceiver (BlockFetch block point) 'AsClient st' 'BFIdle m c)
 -> PeerReceiver
      (BlockFetch block point) 'AsClient 'BFBusy 'BFIdle m c)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFBusy st'
    -> PeerReceiver (BlockFetch block point) 'AsClient st' 'BFIdle m c)
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFBusy 'BFIdle m c
forall a b. (a -> b) -> a -> b
$ \Message (BlockFetch block point) 'BFBusy st'
msg -> case Message (BlockFetch block point) 'BFBusy st'
msg of
      Message (BlockFetch block point) 'BFBusy st'
MsgStartBatch -> c
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
receiveBlocks c
c0
      Message (BlockFetch block point) 'BFBusy st'
MsgNoBlocks   -> c -> PeerReceiver (BlockFetch block point) 'AsClient st' st' m c
forall c ps (pr :: PeerRole) (st :: ps) (m :: * -> *).
c -> PeerReceiver ps pr st st m c
ReceiverDone c
c0)
    (BlockFetchSender ('S n) c block point m a
-> PeerSender
     (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
blockFetchClientPeerSender BlockFetchSender ('S n) c block point m a
next)
 where
  receiveBlocks
    :: c
    -> PeerReceiver (BlockFetch block point) AsClient BFStreaming BFIdle m c
  receiveBlocks :: c
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
receiveBlocks c
c = TheyHaveAgency 'AsClient 'BFStreaming
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFStreaming st'
    -> PeerReceiver (BlockFetch block point) 'AsClient st' 'BFIdle m c)
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
forall (pr :: PeerRole) ps (st :: ps) (stdone :: ps) (m :: * -> *)
       c.
TheyHaveAgency pr st
-> (forall (st' :: ps).
    Message ps st st' -> PeerReceiver ps pr st' stdone m c)
-> PeerReceiver ps pr st stdone m c
ReceiverAwait (ServerHasAgency 'BFStreaming
-> PeerHasAgency 'AsServer 'BFStreaming
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFStreaming
forall k k (block :: k) (point :: k). ServerHasAgency 'BFStreaming
TokStreaming) ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFStreaming st'
  -> PeerReceiver (BlockFetch block point) 'AsClient st' 'BFIdle m c)
 -> PeerReceiver
      (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFStreaming st'
    -> PeerReceiver (BlockFetch block point) 'AsClient st' 'BFIdle m c)
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
forall a b. (a -> b) -> a -> b
$ \Message (BlockFetch block point) 'BFStreaming st'
msg -> case Message (BlockFetch block point) 'BFStreaming st'
msg of
    -- received a block, run an acction and compute the result
    MsgBlock block -> m (PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) (stdone :: ps)
       c.
m (PeerReceiver ps pr st stdone m c)
-> PeerReceiver ps pr st stdone m c
ReceiverEffect (m (PeerReceiver
      (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
 -> PeerReceiver
      (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
-> m (PeerReceiver
        (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
forall a b. (a -> b) -> a -> b
$ do
      c
c' <- Maybe block -> c -> m c
receive (block -> Maybe block
forall a. a -> Maybe a
Just block
block) c
c
      PeerReceiver
  (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
-> m (PeerReceiver
        (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
forall (m :: * -> *) a. Monad m => a -> m a
return (PeerReceiver
   (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
 -> m (PeerReceiver
         (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c))
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
-> m (PeerReceiver
        (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c)
forall a b. (a -> b) -> a -> b
$ c
-> PeerReceiver
     (BlockFetch block point) 'AsClient 'BFStreaming 'BFIdle m c
receiveBlocks c
c'
    Message (BlockFetch block point) 'BFStreaming st'
MsgBatchDone  -> c -> PeerReceiver (BlockFetch block point) 'AsClient st' st' m c
forall c ps (pr :: PeerRole) (st :: ps) (m :: * -> *).
c -> PeerReceiver ps pr st st m c
ReceiverDone c
c

blockFetchClientPeerSender (CollectBlocksPipelined Maybe (BlockFetchSender ('S n) c block point m a)
mNone c -> BlockFetchSender n c block point m a
collect) =
  Maybe
  (PeerSender
     (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a)
-> (c
    -> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a)
-> PeerSender
     (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a
forall ps (pr :: PeerRole) (st :: ps) (n1 :: N) c (m :: * -> *) a.
Maybe (PeerSender ps pr st ('S n1) c m a)
-> (c -> PeerSender ps pr st n1 c m a)
-> PeerSender ps pr st ('S n1) c m a
SenderCollect
    ((BlockFetchSender ('S n) c block point m a
 -> PeerSender
      (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a)
-> Maybe (BlockFetchSender ('S n) c block point m a)
-> Maybe
     (PeerSender
        (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockFetchSender ('S n) c block point m a
-> PeerSender
     (BlockFetch block point) 'AsClient 'BFIdle ('S n) c m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
blockFetchClientPeerSender Maybe (BlockFetchSender ('S n) c block point m a)
mNone)
    (BlockFetchSender n c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
blockFetchClientPeerSender (BlockFetchSender n c block point m a
 -> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a)
-> (c -> BlockFetchSender n c block point m a)
-> c
-> PeerSender (BlockFetch block point) 'AsClient 'BFIdle n c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> BlockFetchSender n c block point m a
collect)