module Hydra.Network.Ouroboros.Server where

import Hydra.Prelude

import Hydra.Network.Ouroboros.Type (
  ClientHasAgency (TokIdle),
  FireForget (StIdle),
  Message (MsgDone, MsgSend),
  NobodyHasAgency (TokDone),
 )
import Network.TypedProtocol (
  Peer (Await, Done, Effect),
  PeerHasAgency (ClientAgency),
  PeerRole (AsServer),
 )

data FireForgetServer msg m a = FireForgetServer
  { forall msg (m :: * -> *) a.
FireForgetServer msg m a -> msg -> m (FireForgetServer msg m a)
recvMsg :: msg -> m (FireForgetServer msg m a)
  -- ^ The client sent us a message.
  -- There is no response and we must have effects.
  , forall msg (m :: * -> *) a. FireForgetServer msg m a -> m a
recvMsgDone :: m a
  -- ^ The client terminated. Here we have a pure return value, but we
  -- could have done another action in 'm' if we wanted to.
  }

fireForgetServerPeer ::
  Monad m =>
  FireForgetServer msg m a ->
  Peer (FireForget msg) 'AsServer 'StIdle m a
fireForgetServerPeer :: forall (m :: * -> *) msg a.
Monad m =>
FireForgetServer msg m a
-> Peer (FireForget msg) 'AsServer 'StIdle m a
fireForgetServerPeer FireForgetServer{msg -> m (FireForgetServer msg m a)
$sel:recvMsg:FireForgetServer :: forall msg (m :: * -> *) a.
FireForgetServer msg m a -> msg -> m (FireForgetServer msg m a)
recvMsg :: msg -> m (FireForgetServer msg m a)
recvMsg, m a
$sel:recvMsgDone:FireForgetServer :: forall msg (m :: * -> *) a. FireForgetServer msg m a -> m a
recvMsgDone :: m a
recvMsgDone} =
  -- In the 'StIdle' the server is awaiting a request message
  TheyHaveAgency 'AsServer 'StIdle
-> (forall {st' :: FireForget msg}.
    Message (FireForget msg) 'StIdle st'
    -> Peer (FireForget msg) 'AsServer st' m a)
-> Peer (FireForget msg) 'AsServer 'StIdle m a
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} {msg :: k}. ClientHasAgency 'StIdle
TokIdle) ((forall {st' :: FireForget msg}.
  Message (FireForget msg) 'StIdle st'
  -> Peer (FireForget msg) 'AsServer st' m a)
 -> Peer (FireForget msg) 'AsServer 'StIdle m a)
-> (forall {st' :: FireForget msg}.
    Message (FireForget msg) 'StIdle st'
    -> Peer (FireForget msg) 'AsServer st' m a)
-> Peer (FireForget msg) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ \case
    -- The client got to choose between two messages and we have to handle
    -- either of them
    MsgSend msg1
payload -> m (Peer (FireForget msg) 'AsServer st' m a)
-> Peer (FireForget msg) 'AsServer st' m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (FireForget msg) 'AsServer st' m a)
 -> Peer (FireForget msg) 'AsServer st' m a)
-> m (Peer (FireForget msg) 'AsServer st' m a)
-> Peer (FireForget msg) 'AsServer st' m a
forall a b. (a -> b) -> a -> b
$ FireForgetServer msg m a -> Peer (FireForget msg) 'AsServer st' m a
FireForgetServer msg m a
-> Peer (FireForget msg) 'AsServer 'StIdle m a
forall (m :: * -> *) msg a.
Monad m =>
FireForgetServer msg m a
-> Peer (FireForget msg) 'AsServer 'StIdle m a
fireForgetServerPeer (FireForgetServer msg m a
 -> Peer (FireForget msg) 'AsServer st' m a)
-> m (FireForgetServer msg m a)
-> m (Peer (FireForget msg) 'AsServer st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> m (FireForgetServer msg m a)
recvMsg msg
msg1
payload
    Message (FireForget msg) 'StIdle st'
R:MessageFireForgetfromto (*) msg 'StIdle st'
MsgDone -> m (Peer (FireForget msg) 'AsServer st' m a)
-> Peer (FireForget msg) 'AsServer st' m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (FireForget msg) 'AsServer st' m a)
 -> Peer (FireForget msg) 'AsServer st' m a)
-> m (Peer (FireForget msg) 'AsServer st' m a)
-> Peer (FireForget msg) 'AsServer st' m a
forall a b. (a -> b) -> a -> b
$ NobodyHasAgency st' -> a -> Peer (FireForget msg) 'AsServer st' m a
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency st'
NobodyHasAgency 'StDone
forall {k} {msg :: k}. NobodyHasAgency 'StDone
TokDone (a -> Peer (FireForget msg) 'AsServer st' m a)
-> m a -> m (Peer (FireForget msg) 'AsServer st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone