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

module Ouroboros.Network.Protocol.PeerSharing.Server where

import Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..), PeerRole (..))
import Ouroboros.Network.Protocol.PeerSharing.Type (ClientHasAgency (..),
           Message (..), NobodyHasAgency (..), PeerSharing (..),
           PeerSharingAmount, ServerHasAgency (..))

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
                      -> Peer (PeerSharing peerAddress) AsServer StIdle m ()
peerSharingServerPeer :: forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Peer (PeerSharing peerAddress) 'AsServer '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 receival of a message from the client
  TheyHaveAgency 'AsServer 'StIdle
-> (forall {st' :: PeerSharing peerAddress}.
    Message (PeerSharing peerAddress) 'StIdle st'
    -> Peer (PeerSharing peerAddress) 'AsServer st' m ())
-> Peer (PeerSharing peerAddress) 'AsServer 'StIdle m ()
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 (ClientHasAgency 'StIdle -> PeerHasAgency 'AsClient 'StIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall {k} {peerAddress :: k}. ClientHasAgency 'StIdle
TokIdle) ((forall {st' :: PeerSharing peerAddress}.
  Message (PeerSharing peerAddress) 'StIdle st'
  -> Peer (PeerSharing peerAddress) 'AsServer st' m ())
 -> Peer (PeerSharing peerAddress) 'AsServer 'StIdle m ())
-> (forall {st' :: PeerSharing peerAddress}.
    Message (PeerSharing peerAddress) 'StIdle st'
    -> Peer (PeerSharing peerAddress) 'AsServer st' m ())
-> Peer (PeerSharing peerAddress) 'AsServer '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 (Peer (PeerSharing peerAddress) 'AsServer st' m ())
-> Peer (PeerSharing peerAddress) 'AsServer st' m ()
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (PeerSharing peerAddress) 'AsServer st' m ())
 -> Peer (PeerSharing peerAddress) 'AsServer st' m ())
-> m (Peer (PeerSharing peerAddress) 'AsServer st' m ())
-> Peer (PeerSharing peerAddress) 'AsServer st' m ()
forall a b. (a -> b) -> a -> b
$ do
        ([peerAddress]
resp, PeerSharingServer peerAddress m
server) <- PeerSharingAmount
-> m ([peerAddress], PeerSharingServer peerAddress m)
recvMsgShareRequest PeerSharingAmount
amount
        Peer (PeerSharing peerAddress) 'AsServer st' m ()
-> m (Peer (PeerSharing peerAddress) 'AsServer st' m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Peer (PeerSharing peerAddress) 'AsServer st' m ()
 -> m (Peer (PeerSharing peerAddress) 'AsServer st' m ()))
-> Peer (PeerSharing peerAddress) 'AsServer st' m ()
-> m (Peer (PeerSharing peerAddress) 'AsServer st' m ())
forall a b. (a -> b) -> a -> b
$
          WeHaveAgency 'AsServer st'
-> Message (PeerSharing peerAddress) st' 'StIdle
-> Peer (PeerSharing peerAddress) 'AsServer 'StIdle m ()
-> Peer (PeerSharing peerAddress) 'AsServer st' m ()
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 (ServerHasAgency st' -> WeHaveAgency 'AsServer st'
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency st'
ServerHasAgency 'StBusy
forall {k} {peerAddress :: k}. ServerHasAgency 'StBusy
TokBusy)
                ([peerAddress] -> Message (PeerSharing peerAddress) 'StBusy 'StIdle
forall peerAddress1.
[peerAddress1]
-> Message (PeerSharing peerAddress1) 'StBusy 'StIdle
MsgSharePeers [peerAddress]
resp)
                (PeerSharingServer peerAddress m
-> Peer (PeerSharing peerAddress) 'AsServer 'StIdle m ()
forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Peer (PeerSharing peerAddress) 'AsServer 'StIdle m ()
peerSharingServerPeer PeerSharingServer peerAddress m
server)
      -- Nothing to do.
      Message (PeerSharing peerAddress) 'StIdle st'
R:MessagePeerSharingfromto (*) peerAddress 'StIdle st'
MsgDone -> NobodyHasAgency st'
-> () -> Peer (PeerSharing peerAddress) 'AsServer st' m ()
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency st'
NobodyHasAgency 'StDone
forall {k} {peerAddress :: k}. NobodyHasAgency 'StDone
TokDone ()