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

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

import Network.TypedProtocol.Core
import Network.TypedProtocol.Peer.Server
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
    -> Server KeepAlive NonPipelined StClient m a
keepAliveServerPeer :: forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Server KeepAlive 'NonPipelined '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 } =
    (forall (st' :: KeepAlive).
 Message KeepAlive 'StClient st'
 -> Server KeepAlive 'NonPipelined st' m a)
-> Server KeepAlive 'NonPipelined 'StClient m a
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' :: KeepAlive).
  Message KeepAlive 'StClient st'
  -> Server KeepAlive 'NonPipelined st' m a)
 -> Server KeepAlive 'NonPipelined 'StClient m a)
-> (forall (st' :: KeepAlive).
    Message KeepAlive 'StClient st'
    -> Server KeepAlive 'NonPipelined st' m a)
-> Server KeepAlive 'NonPipelined '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 (Server KeepAlive 'NonPipelined st' m a)
-> Server KeepAlive 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server KeepAlive 'NonPipelined st' m a)
 -> Server KeepAlive 'NonPipelined st' m a)
-> m (Server KeepAlive 'NonPipelined st' m a)
-> Server KeepAlive 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ a -> Server KeepAlive 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Server ps pl st m a
Done (a -> Server KeepAlive 'NonPipelined st' m a)
-> m a -> m (Server KeepAlive 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone

        MsgKeepAlive Cookie
cookie ->
          m (Server KeepAlive 'NonPipelined st' m a)
-> Server KeepAlive 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server KeepAlive 'NonPipelined st' m a)
 -> Server KeepAlive 'NonPipelined st' m a)
-> m (Server KeepAlive 'NonPipelined st' m a)
-> Server KeepAlive 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$
            (KeepAliveServer m a -> Server KeepAlive 'NonPipelined st' m a)
-> m (KeepAliveServer m a)
-> m (Server KeepAlive 'NonPipelined 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 ->
                    Message KeepAlive st' 'StClient
-> Server KeepAlive 'NonPipelined 'StClient m a
-> Server KeepAlive 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Server ps pl st' m a -> Server ps pl st m a
Yield (Cookie -> Message KeepAlive 'StServer 'StClient
MsgKeepAliveResponse Cookie
cookie)
                          (KeepAliveServer m a -> Server KeepAlive 'NonPipelined 'StClient m a
forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Server KeepAlive 'NonPipelined 'StClient m a
keepAliveServerPeer KeepAliveServer m a
server))
                 m (KeepAliveServer m a)
recvMsgKeepAlive