{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

-- | The downstream side of LeiosFetch.
module Ouroboros.Consensus.MiniProtocol.LeiosFetch.Client
  ( LeiosFetchClientPeer
  , leiosFetchClientPeerIdle
  ) where

import Control.Monad.Class.MonadSTM (MonadSTM (..))
import Data.Functor ((<&>))
import Network.TypedProtocol.Codec (PeerRole (..))
import Network.TypedProtocol.Core
  ( IsPipelined (..)
  , ReflRelativeAgency (..)
  )
import Network.TypedProtocol.Peer (Peer (..))
import Ouroboros.Consensus.MiniProtocol.LeiosFetch.Type (LeiosFetch (..), Message (..))

type LeiosFetchClientPeer point eb tx m a =
  Peer (LeiosFetch point eb tx) AsClient NonPipelined StIdle m a

-- | A client that requests nothing: it waits until told to stop, then sends
-- 'MsgDone'.
--
-- TODO Replace it with a client that requests the endorser blocks and
-- transactions its peer offers over LeiosNotify.
leiosFetchClientPeerIdle ::
  MonadSTM m =>
  -- | blocks until the client should stop
  STM m a ->
  LeiosFetchClientPeer point eb tx m a
leiosFetchClientPeerIdle :: forall (m :: * -> *) a point eb tx.
MonadSTM m =>
STM m a -> LeiosFetchClientPeer point eb tx m a
leiosFetchClientPeerIdle STM m a
awaitStop =
  m (Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined ps) (st :: ps)
       (m :: * -> *) a.
m (Peer ps pr pl st m a) -> Peer ps pr pl st m a
Effect (m (Peer
      (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
 -> Peer
      (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
-> m (Peer
        (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$
    STM m a -> m a
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m a
awaitStop m a
-> (a
    -> Peer
         (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
-> m (Peer
        (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
x ->
      WeHaveAgencyProof 'AsClient 'StIdle
-> Message (LeiosFetch point eb tx) 'StIdle 'StDone
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StDone m a
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined ps) (st :: ps)
       (st' :: ps) (m :: * -> *) a.
(StateTokenI st, StateTokenI st', ActiveState st,
 Outstanding pl ~ 'Z, OutstandingSenders pl ~ 'Z) =>
WeHaveAgencyProof pr st
-> Message ps st st'
-> Peer ps pr pl st' m a
-> Peer ps pr pl st m a
Yield ReflRelativeAgency 'ClientAgency 'WeHaveAgency 'WeHaveAgency
WeHaveAgencyProof 'AsClient 'StIdle
forall (r :: RelativeAgency). ReflRelativeAgency 'ClientAgency r r
ReflClientAgency Message (LeiosFetch point eb tx) 'StIdle 'StDone
forall point eb tx.
Message (LeiosFetch point eb tx) 'StIdle 'StDone
MsgDone (Peer (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StDone m a
 -> Peer
      (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StDone m a
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$
        NobodyHasAgencyProof 'AsClient 'StDone
-> a
-> Peer
     (LeiosFetch point eb tx) 'AsClient 'NonPipelined 'StDone m a
forall ps (pr :: PeerRole) (pl :: IsPipelined ps) (st :: ps)
       (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z, OutstandingSenders pl ~ 'Z) =>
NobodyHasAgencyProof pr st -> a -> Peer ps pr pl st m a
Done ReflRelativeAgency 'NobodyAgency 'NobodyHasAgency 'NobodyHasAgency
NobodyHasAgencyProof 'AsClient 'StDone
forall (r :: RelativeAgency). ReflRelativeAgency 'NobodyAgency r r
ReflNobodyAgency a
x