{-# LANGUAGE BlockArguments  #-}
{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE GADTs           #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}

module Ouroboros.Network.Protocol.PeerSharing.Server where

import Network.TypedProtocol.Peer.Server
import Ouroboros.Network.Protocol.PeerSharing.Type

newtype PeerSharingServer peerAddress m = PeerSharingServer {
  -- | The client sent us a 'MsgShareRequest'. We have need to compute the
  -- response.
  --
  forall peerAddress (m :: * -> *).
PeerSharingServer peerAddress m
-> PeerSharingAmount
-> m ([peerAddress], PeerSharingServer peerAddress m)
recvMsgShareRequest :: PeerSharingAmount
                      -> m ( [peerAddress]
                           , PeerSharingServer peerAddress m
                           )
  }

peerSharingServerPeer :: Monad m
                      => PeerSharingServer peerAddress m
                      -> Server (PeerSharing peerAddress) NonPipelined StIdle m ()
peerSharingServerPeer :: forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ()
peerSharingServerPeer PeerSharingServer{PeerSharingAmount
-> m ([peerAddress], PeerSharingServer peerAddress m)
recvMsgShareRequest :: forall peerAddress (m :: * -> *).
PeerSharingServer peerAddress m
-> PeerSharingAmount
-> m ([peerAddress], PeerSharingServer peerAddress m)
recvMsgShareRequest :: PeerSharingAmount
-> m ([peerAddress], PeerSharingServer peerAddress m)
..} =
  -- Await to receive a message
  (forall (st' :: PeerSharing peerAddress).
 Message (PeerSharing peerAddress) 'StIdle st'
 -> Server (PeerSharing peerAddress) 'NonPipelined st' m ())
-> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ()
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Server ps pl st' m a)
-> Server ps pl st m a
Await \case
    -- Can be either 'MsgShareRequest' or 'MsgDone'
    MsgShareRequest PeerSharingAmount
amount -> m (Server (PeerSharing peerAddress) 'NonPipelined st' m ())
-> Server (PeerSharing peerAddress) 'NonPipelined st' m ()
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect do
      -- Compute the response and send 'MsgSharePeers' message
      (resp, server) <- PeerSharingAmount
-> m ([peerAddress], PeerSharingServer peerAddress m)
recvMsgShareRequest PeerSharingAmount
amount
      return $
        Yield (MsgSharePeers resp)
              (peerSharingServerPeer server)
    -- Nothing to do.
    Message (PeerSharing peerAddress) 'StIdle st'
R:MessagePeerSharingfromto peerAddress 'StIdle st'
MsgDone -> () -> Server (PeerSharing peerAddress) 'NonPipelined st' m ()
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Server ps pl st m a
Done ()