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

module Ouroboros.Network.Protocol.KeepAlive.Server
  ( KeepAliveServer (..)
  , keepAliveServerPeer
  ) where

import Network.TypedProtocol.Core
import Ouroboros.Network.Protocol.KeepAlive.Type


data KeepAliveServer m a = KeepAliveServer {
    forall (m :: * -> *) a.
KeepAliveServer m a -> m (KeepAliveServer m a)
recvMsgKeepAlive :: m (KeepAliveServer m a),

    forall (m :: * -> *) a. KeepAliveServer m a -> m a
recvMsgDone      :: m a
  }


keepAliveServerPeer
    :: Functor m
    => KeepAliveServer m a
    -> Peer KeepAlive AsServer StClient m a
keepAliveServerPeer :: forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Peer KeepAlive 'AsServer 'StClient m a
keepAliveServerPeer KeepAliveServer { m (KeepAliveServer m a)
recvMsgKeepAlive :: forall (m :: * -> *) a.
KeepAliveServer m a -> m (KeepAliveServer m a)
recvMsgKeepAlive :: m (KeepAliveServer m a)
recvMsgKeepAlive, m a
recvMsgDone :: forall (m :: * -> *) a. KeepAliveServer m a -> m a
recvMsgDone :: m a
recvMsgDone } =
    TheyHaveAgency 'AsServer 'StClient
-> (forall (st' :: KeepAlive).
    Message KeepAlive 'StClient st'
    -> Peer KeepAlive 'AsServer st' m a)
-> Peer KeepAlive 'AsServer 'StClient 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 'StClient -> PeerHasAgency 'AsClient 'StClient
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StClient
TokClient) ((forall (st' :: KeepAlive).
  Message KeepAlive 'StClient st'
  -> Peer KeepAlive 'AsServer st' m a)
 -> Peer KeepAlive 'AsServer 'StClient m a)
-> (forall (st' :: KeepAlive).
    Message KeepAlive 'StClient st'
    -> Peer KeepAlive 'AsServer st' m a)
-> Peer KeepAlive 'AsServer 'StClient m a
forall a b. (a -> b) -> a -> b
$ \Message KeepAlive 'StClient st'
msg ->
      case Message KeepAlive 'StClient st'
msg of
        Message KeepAlive 'StClient st'
R:MessageKeepAlivefromto 'StClient st'
MsgDone -> m (Peer KeepAlive 'AsServer st' m a)
-> Peer KeepAlive '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 KeepAlive 'AsServer st' m a)
 -> Peer KeepAlive 'AsServer st' m a)
-> m (Peer KeepAlive 'AsServer st' m a)
-> Peer KeepAlive 'AsServer st' m a
forall a b. (a -> b) -> a -> b
$ NobodyHasAgency st' -> a -> Peer KeepAlive '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
TokDone (a -> Peer KeepAlive 'AsServer st' m a)
-> m a -> m (Peer KeepAlive 'AsServer st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone

        MsgKeepAlive Cookie
cookie ->
          m (Peer KeepAlive 'AsServer st' m a)
-> Peer KeepAlive '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 KeepAlive 'AsServer st' m a)
 -> Peer KeepAlive 'AsServer st' m a)
-> m (Peer KeepAlive 'AsServer st' m a)
-> Peer KeepAlive 'AsServer st' m a
forall a b. (a -> b) -> a -> b
$
            (KeepAliveServer m a -> Peer KeepAlive 'AsServer st' m a)
-> m (KeepAliveServer m a) -> m (Peer KeepAlive 'AsServer st' m a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\KeepAliveServer m a
server ->
                    WeHaveAgency 'AsServer st'
-> Message KeepAlive st' 'StClient
-> Peer KeepAlive 'AsServer 'StClient m a
-> Peer KeepAlive 'AsServer st' m a
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 'StServer
TokServer)
                          (Cookie -> Message KeepAlive 'StServer 'StClient
MsgKeepAliveResponse Cookie
cookie)
                          (KeepAliveServer m a -> Peer KeepAlive 'AsServer 'StClient m a
forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Peer KeepAlive 'AsServer 'StClient m a
keepAliveServerPeer KeepAliveServer m a
server))
                 m (KeepAliveServer m a)
recvMsgKeepAlive