{-# 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.Peer.Client

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 {
    forall block point (m :: * -> *) a.
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 {
    forall {k} block (m :: * -> *) (a :: k).
BlockFetchResponse block m a -> m (BlockFetchReceiver block m)
handleStartBatch :: m (BlockFetchReceiver block m),
    forall {k} block (m :: * -> *) (a :: k).
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 {
    forall block (m :: * -> *).
BlockFetchReceiver block m
-> block -> m (BlockFetchReceiver block m)
handleBlock     :: block -> m (BlockFetchReceiver block m),
    forall block (m :: * -> *). BlockFetchReceiver block m -> m ()
handleBatchDone :: m ()
  }

blockFetchClientPeer
  :: forall block point m a.
     Monad m
  => BlockFetchClient block point m a
  -> Client (BlockFetch block point) NonPipelined BFIdle m a
blockFetchClientPeer :: forall block point (m :: * -> *) a.
Monad m =>
BlockFetchClient block point m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchClientPeer (BlockFetchClient m (BlockFetchRequest block point m a)
mclient) =
  m (Client (BlockFetch block point) 'NonPipelined 'BFIdle m a)
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (BlockFetch block point) 'NonPipelined 'BFIdle m a)
 -> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a)
-> m (Client (BlockFetch block point) 'NonPipelined 'BFIdle m a)
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
forall a b. (a -> b) -> a -> b
$ BlockFetchRequest block point m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchRequestPeer (BlockFetchRequest block point m a
 -> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a)
-> m (BlockFetchRequest block point m a)
-> m (Client (BlockFetch block point) 'NonPipelined '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
    -> Client (BlockFetch block point) NonPipelined BFIdle m a

  blockFetchRequestPeer :: BlockFetchRequest block point m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchRequestPeer (SendMsgClientDone a
result) =
    Message (BlockFetch block point) 'BFIdle 'BFDone
-> Client (BlockFetch block point) 'NonPipelined 'BFDone m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield Message (BlockFetch block point) 'BFIdle 'BFDone
forall block point.
Message (BlockFetch block point) 'BFIdle 'BFDone
MsgClientDone (a -> Client (BlockFetch block point) 'NonPipelined 'BFDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Client ps pl st m a
Done a
result)

  blockFetchRequestPeer (SendMsgRequestRange ChainRange point
range BlockFetchResponse block m a
resp BlockFetchClient block point m a
next) =
    Message (BlockFetch block point) 'BFIdle 'BFBusy
-> Client (BlockFetch block point) 'NonPipelined 'BFBusy m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield
      (ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
forall point block.
ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
MsgRequestRange ChainRange point
range)
      (BlockFetchClient block point m a
-> BlockFetchResponse block m a
-> Client (BlockFetch block point) 'NonPipelined '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
    -> Client (BlockFetch block point) NonPipelined BFBusy m a
  blockFetchResponsePeer :: BlockFetchClient block point m a
-> BlockFetchResponse block m a
-> Client (BlockFetch block point) 'NonPipelined 'BFBusy m a
blockFetchResponsePeer BlockFetchClient block point m a
next BlockFetchResponse{m ()
handleNoBlocks :: forall {k} block (m :: * -> *) (a :: k).
BlockFetchResponse block m a -> m ()
handleNoBlocks :: m ()
handleNoBlocks, m (BlockFetchReceiver block m)
handleStartBatch :: forall {k} block (m :: * -> *) (a :: k).
BlockFetchResponse block m a -> m (BlockFetchReceiver block m)
handleStartBatch :: m (BlockFetchReceiver block m)
handleStartBatch} =
    (forall (st' :: BlockFetch block point).
 Message (BlockFetch block point) 'BFBusy st'
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined 'BFBusy m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Client ps pl st' m a)
-> Client ps pl st m a
Await ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFBusy st'
  -> Client (BlockFetch block point) 'NonPipelined st' m a)
 -> Client (BlockFetch block point) 'NonPipelined 'BFBusy m a)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFBusy st'
    -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined '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'
R:MessageBlockFetchfromto block point 'BFBusy st'
MsgStartBatch -> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (BlockFetch block point) 'NonPipelined st' m a)
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ BlockFetchClient block point m a
-> BlockFetchReceiver block m
-> Client (BlockFetch block point) 'NonPipelined 'BFStreaming m a
blockReceiver BlockFetchClient block point m a
next (BlockFetchReceiver block m
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (BlockFetchReceiver block m)
-> m (Client (BlockFetch block point) 'NonPipelined st' 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'
R:MessageBlockFetchfromto block point 'BFBusy st'
MsgNoBlocks   -> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (BlockFetch block point) 'NonPipelined st' m a)
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ m ()
handleNoBlocks m ()
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (BlockFetchRequest block point m a
-> Client (BlockFetch block point) 'NonPipelined st' m a
BlockFetchRequest block point m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchRequestPeer (BlockFetchRequest block point m a
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (BlockFetchRequest block point m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' 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
    -> Client (BlockFetch block point) NonPipelined BFStreaming m a
  blockReceiver :: BlockFetchClient block point m a
-> BlockFetchReceiver block m
-> Client (BlockFetch block point) 'NonPipelined 'BFStreaming m a
blockReceiver BlockFetchClient block point m a
next BlockFetchReceiver{block -> m (BlockFetchReceiver block m)
handleBlock :: forall block (m :: * -> *).
BlockFetchReceiver block m
-> block -> m (BlockFetchReceiver block m)
handleBlock :: block -> m (BlockFetchReceiver block m)
handleBlock, m ()
handleBatchDone :: forall block (m :: * -> *). BlockFetchReceiver block m -> m ()
handleBatchDone :: m ()
handleBatchDone} =
    (forall (st' :: BlockFetch block point).
 Message (BlockFetch block point) 'BFStreaming st'
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined 'BFStreaming m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Client ps pl st' m a)
-> Client ps pl st m a
Await ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFStreaming st'
  -> Client (BlockFetch block point) 'NonPipelined st' m a)
 -> Client (BlockFetch block point) 'NonPipelined 'BFStreaming m a)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFStreaming st'
    -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined '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
block -> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (BlockFetch block point) 'NonPipelined st' m a)
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ BlockFetchClient block point m a
-> BlockFetchReceiver block m
-> Client (BlockFetch block point) 'NonPipelined 'BFStreaming m a
blockReceiver BlockFetchClient block point m a
next (BlockFetchReceiver block m
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (BlockFetchReceiver block m)
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> block -> m (BlockFetchReceiver block m)
handleBlock block
block
      Message (BlockFetch block point) 'BFStreaming st'
R:MessageBlockFetchfromto block point 'BFStreaming st'
MsgBatchDone   -> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (BlockFetch block point) 'NonPipelined st' m a)
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' m a)
-> Client (BlockFetch block point) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ do
        m ()
handleBatchDone
        BlockFetchRequest block point m a
-> Client (BlockFetch block point) 'NonPipelined st' m a
BlockFetchRequest block point m a
-> Client (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchRequestPeer (BlockFetchRequest block point m a
 -> Client (BlockFetch block point) 'NonPipelined st' m a)
-> m (BlockFetchRequest block point m a)
-> m (Client (BlockFetch block point) 'NonPipelined st' 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
  -> ClientPipelined (BlockFetch block point) BFIdle m a
blockFetchClientPeerPipelined :: forall block point (m :: * -> *) a.
Monad m =>
BlockFetchClientPipelined block point m a
-> ClientPipelined (BlockFetch block point) 'BFIdle m a
blockFetchClientPeerPipelined (BlockFetchClientPipelined BlockFetchSender 'Z c block point m a
sender) =
  Client (BlockFetch block point) ('Pipelined 'Z c) 'BFIdle m a
-> ClientPipelined (BlockFetch block point) 'BFIdle m a
forall ps (st :: ps) (m :: * -> *) a c.
Client ps ('Pipelined 'Z c) st m a -> ClientPipelined ps st m a
ClientPipelined (Client (BlockFetch block point) ('Pipelined 'Z c) 'BFIdle m a
 -> ClientPipelined (BlockFetch block point) 'BFIdle m a)
-> Client (BlockFetch block point) ('Pipelined 'Z c) 'BFIdle m a
-> ClientPipelined (BlockFetch block point) 'BFIdle m a
forall a b. (a -> b) -> a -> b
$ BlockFetchSender 'Z c block point m a
-> Client (BlockFetch block point) ('Pipelined 'Z c) 'BFIdle m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle 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
  -> Client (BlockFetch block point) (Pipelined n c) BFIdle m a

blockFetchClientPeerSender :: forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
blockFetchClientPeerSender (SendMsgDonePipelined a
result) =
  -- Send `MsgClientDone` and complete the protocol
  Message (BlockFetch block point) 'BFIdle 'BFDone
-> Client (BlockFetch block point) ('Pipelined n c) 'BFDone m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield Message (BlockFetch block point) 'BFIdle 'BFDone
forall block point.
Message (BlockFetch block point) 'BFIdle 'BFDone
MsgClientDone (a -> Client (BlockFetch block point) ('Pipelined n c) 'BFDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Client ps pl st m a
Done 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.
  Message (BlockFetch block point) 'BFIdle 'BFBusy
-> Receiver (BlockFetch block point) 'BFBusy 'BFIdle m c
-> Client
     (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
forall ps (st :: ps) (n :: N) c (m :: * -> *) a (st' :: ps)
       (st'' :: ps).
(StateTokenI st, StateTokenI st',
 StateAgency st ~ 'ClientAgency) =>
Message ps st st'
-> Receiver ps st' st'' m c
-> Client ps ('Pipelined ('S n) c) st'' m a
-> Client ps ('Pipelined n c) st m a
YieldPipelined
    (ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
forall point block.
ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
MsgRequestRange ChainRange point
range)
    ((forall (st' :: BlockFetch block point).
 Message (BlockFetch block point) 'BFBusy st'
 -> Receiver (BlockFetch block point) st' 'BFIdle m c)
-> Receiver (BlockFetch block point) 'BFBusy 'BFIdle m c
forall ps (st :: ps) (stdone :: ps) (m :: * -> *) c.
(StateTokenI st, ActiveState st, StateAgency st ~ 'ServerAgency) =>
(forall (st' :: ps).
 Message ps st st' -> Receiver ps st' stdone m c)
-> Receiver ps st stdone m c
ReceiverAwait ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFBusy st'
  -> Receiver (BlockFetch block point) st' 'BFIdle m c)
 -> Receiver (BlockFetch block point) 'BFBusy 'BFIdle m c)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFBusy st'
    -> Receiver (BlockFetch block point) st' 'BFIdle m c)
-> Receiver (BlockFetch block point) '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'
R:MessageBlockFetchfromto block point 'BFBusy st'
MsgStartBatch -> c -> Receiver (BlockFetch block point) 'BFStreaming 'BFIdle m c
receiveBlocks c
c0
      Message (BlockFetch block point) 'BFBusy st'
R:MessageBlockFetchfromto block point 'BFBusy st'
MsgNoBlocks   -> c -> Receiver (BlockFetch block point) st' st' m c
forall ps (stdone :: ps) (m :: * -> *) c.
c -> Receiver ps stdone stdone m c
ReceiverDone c
c0)
    (BlockFetchSender ('S n) c block point m a
-> Client
     (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
blockFetchClientPeerSender BlockFetchSender ('S n) c block point m a
next)
 where
  receiveBlocks
    :: c
    -> Receiver (BlockFetch block point) BFStreaming BFIdle m c
  receiveBlocks :: c -> Receiver (BlockFetch block point) 'BFStreaming 'BFIdle m c
receiveBlocks c
c = (forall (st' :: BlockFetch block point).
 Message (BlockFetch block point) 'BFStreaming st'
 -> Receiver (BlockFetch block point) st' 'BFIdle m c)
-> Receiver (BlockFetch block point) 'BFStreaming 'BFIdle m c
forall ps (st :: ps) (stdone :: ps) (m :: * -> *) c.
(StateTokenI st, ActiveState st, StateAgency st ~ 'ServerAgency) =>
(forall (st' :: ps).
 Message ps st st' -> Receiver ps st' stdone m c)
-> Receiver ps st stdone m c
ReceiverAwait ((forall (st' :: BlockFetch block point).
  Message (BlockFetch block point) 'BFStreaming st'
  -> Receiver (BlockFetch block point) st' 'BFIdle m c)
 -> Receiver (BlockFetch block point) 'BFStreaming 'BFIdle m c)
-> (forall (st' :: BlockFetch block point).
    Message (BlockFetch block point) 'BFStreaming st'
    -> Receiver (BlockFetch block point) st' 'BFIdle m c)
-> Receiver (BlockFetch block point) '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
block -> m (Receiver (BlockFetch block point) st' 'BFIdle m c)
-> Receiver (BlockFetch block point) st' 'BFIdle m c
forall ps (st :: ps) (stdone :: ps) (m :: * -> *) c.
m (Receiver ps st stdone m c) -> Receiver ps st stdone m c
ReceiverEffect (m (Receiver (BlockFetch block point) st' 'BFIdle m c)
 -> Receiver (BlockFetch block point) st' 'BFIdle m c)
-> m (Receiver (BlockFetch block point) st' 'BFIdle m c)
-> Receiver (BlockFetch block point) st' 'BFIdle m c
forall a b. (a -> b) -> a -> b
$ do
      c' <- Maybe block -> c -> m c
receive (block -> Maybe block
forall a. a -> Maybe a
Just block
block) c
c
      return $ receiveBlocks c'
    Message (BlockFetch block point) 'BFStreaming st'
R:MessageBlockFetchfromto block point 'BFStreaming st'
MsgBatchDone  -> c -> Receiver (BlockFetch block point) st' st' m c
forall ps (stdone :: ps) (m :: * -> *) c.
c -> Receiver ps stdone stdone 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
  (Client (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a)
-> (c
    -> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a)
-> Client
     (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a
forall ps (st :: ps) (n :: N) c (m :: * -> *) a.
(StateTokenI st, ActiveState st) =>
Maybe (Client ps ('Pipelined ('S n) c) st m a)
-> (c -> Client ps ('Pipelined n c) st m a)
-> Client ps ('Pipelined ('S n) c) st m a
Collect
    ((BlockFetchSender ('S n) c block point m a
 -> Client
      (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a)
-> Maybe (BlockFetchSender ('S n) c block point m a)
-> Maybe
     (Client (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockFetchSender ('S n) c block point m a
-> Client
     (BlockFetch block point) ('Pipelined ('S n) c) 'BFIdle m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
blockFetchClientPeerSender Maybe (BlockFetchSender ('S n) c block point m a)
mNone)
    (BlockFetchSender n c block point m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
forall (n :: N) block point c (m :: * -> *) a.
Monad m =>
BlockFetchSender n c block point m a
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
blockFetchClientPeerSender (BlockFetchSender n c block point m a
 -> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a)
-> (c -> BlockFetchSender n c block point m a)
-> c
-> Client (BlockFetch block point) ('Pipelined n c) 'BFIdle m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> BlockFetchSender n c block point m a
collect)