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

module Ouroboros.Network.Protocol.PeerSharing.Server where

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

data 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 ((forall (st' :: PeerSharing peerAddress).
  Message (PeerSharing peerAddress) 'StIdle st'
  -> Server (PeerSharing peerAddress) 'NonPipelined st' m ())
 -> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ())
-> (forall (st' :: PeerSharing peerAddress).
    Message (PeerSharing peerAddress) 'StIdle st'
    -> Server (PeerSharing peerAddress) 'NonPipelined st' m ())
-> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ()
forall a b. (a -> b) -> a -> b
$ \Message (PeerSharing peerAddress) 'StIdle st'
msg ->
    -- Can be either 'MsgShareRequest' or 'MsgDone'
    case Message (PeerSharing peerAddress) 'StIdle st'
msg of
      -- Compute the response and send 'MsgSharePeers' message
      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 (m (Server (PeerSharing peerAddress) 'NonPipelined st' m ())
 -> Server (PeerSharing peerAddress) 'NonPipelined st' m ())
-> m (Server (PeerSharing peerAddress) 'NonPipelined st' m ())
-> Server (PeerSharing peerAddress) 'NonPipelined st' m ()
forall a b. (a -> b) -> a -> b
$ do
        (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 ()