{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ouroboros.Network.Protocol.KeepAlive.Client
  ( KeepAliveClient (..)
  , KeepAliveClientSt (..)
  , keepAliveClientPeer
  ) where

import Control.Monad.Class.MonadThrow
import Network.TypedProtocol.Core
import Network.TypedProtocol.Peer.Client
import Ouroboros.Network.Protocol.KeepAlive.Type


newtype KeepAliveClient m a = KeepAliveClient (m (KeepAliveClientSt m a))

data KeepAliveClientSt m a where
    SendMsgKeepAlive
      :: Cookie
      -> m (KeepAliveClientSt m a)
      -> KeepAliveClientSt m a

    SendMsgDone
      :: m a
      -> KeepAliveClientSt m a


-- | Interpret a particular client action sequence into the client side of the
-- 'KeepAlive' protocol.
--
keepAliveClientPeer
  :: forall m a. MonadThrow m
  => KeepAliveClient m a
  -> Client KeepAlive NonPipelined StClient m a
keepAliveClientPeer :: forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientPeer (KeepAliveClient m (KeepAliveClientSt m a)
client) =
   m (Client KeepAlive 'NonPipelined 'StClient m a)
-> Client KeepAlive 'NonPipelined 'StClient m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client KeepAlive 'NonPipelined 'StClient m a)
 -> Client KeepAlive 'NonPipelined 'StClient m a)
-> m (Client KeepAlive 'NonPipelined 'StClient m a)
-> Client KeepAlive 'NonPipelined 'StClient m a
forall a b. (a -> b) -> a -> b
$ KeepAliveClientSt m a
-> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientStPeer (KeepAliveClientSt m a
 -> Client KeepAlive 'NonPipelined 'StClient m a)
-> m (KeepAliveClientSt m a)
-> m (Client KeepAlive 'NonPipelined 'StClient m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (KeepAliveClientSt m a)
client
 where

   keepAliveClientStPeer
     :: KeepAliveClientSt m a
     -> Client KeepAlive NonPipelined StClient m a

   keepAliveClientStPeer :: KeepAliveClientSt m a
-> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientStPeer (SendMsgDone m a
mresult) =
     Message KeepAlive 'StClient 'StDone
-> Client KeepAlive 'NonPipelined 'StDone m a
-> Client KeepAlive 'NonPipelined 'StClient m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield Message KeepAlive 'StClient 'StDone
MsgDone (Client KeepAlive 'NonPipelined 'StDone m a
 -> Client KeepAlive 'NonPipelined 'StClient m a)
-> Client KeepAlive 'NonPipelined 'StDone m a
-> Client KeepAlive 'NonPipelined 'StClient m a
forall a b. (a -> b) -> a -> b
$
       m (Client KeepAlive 'NonPipelined 'StDone m a)
-> Client KeepAlive 'NonPipelined 'StDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (a -> Client KeepAlive 'NonPipelined 'StDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Client ps pl st m a
Done (a -> Client KeepAlive 'NonPipelined 'StDone m a)
-> m a -> m (Client KeepAlive 'NonPipelined 'StDone m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
mresult)

   keepAliveClientStPeer (SendMsgKeepAlive Cookie
cookieReq m (KeepAliveClientSt m a)
next) =
     Message KeepAlive 'StClient 'StServer
-> Client KeepAlive 'NonPipelined 'StServer m a
-> Client KeepAlive 'NonPipelined 'StClient m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield (Cookie -> Message KeepAlive 'StClient 'StServer
MsgKeepAlive Cookie
cookieReq) (Client KeepAlive 'NonPipelined 'StServer m a
 -> Client KeepAlive 'NonPipelined 'StClient m a)
-> Client KeepAlive 'NonPipelined 'StServer m a
-> Client KeepAlive 'NonPipelined 'StClient m a
forall a b. (a -> b) -> a -> b
$
       (forall (st' :: KeepAlive).
 Message KeepAlive 'StServer st'
 -> Client KeepAlive 'NonPipelined st' m a)
-> Client KeepAlive 'NonPipelined 'StServer m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Client ps pl st' m a)
-> Client ps pl st m a
Await ((forall (st' :: KeepAlive).
  Message KeepAlive 'StServer st'
  -> Client KeepAlive 'NonPipelined st' m a)
 -> Client KeepAlive 'NonPipelined 'StServer m a)
-> (forall (st' :: KeepAlive).
    Message KeepAlive 'StServer st'
    -> Client KeepAlive 'NonPipelined st' m a)
-> Client KeepAlive 'NonPipelined 'StServer m a
forall a b. (a -> b) -> a -> b
$ \(MsgKeepAliveResponse Cookie
cookieRsp) ->
         if Cookie
cookieReq Cookie -> Cookie -> Bool
forall a. Eq a => a -> a -> Bool
== Cookie
cookieRsp then m (Client KeepAlive 'NonPipelined st' m a)
-> Client KeepAlive 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client KeepAlive 'NonPipelined st' m a)
 -> Client KeepAlive 'NonPipelined st' m a)
-> m (Client KeepAlive 'NonPipelined st' m a)
-> Client KeepAlive 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ KeepAliveClientSt m a -> Client KeepAlive 'NonPipelined st' m a
KeepAliveClientSt m a
-> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientStPeer (KeepAliveClientSt m a -> Client KeepAlive 'NonPipelined st' m a)
-> m (KeepAliveClientSt m a)
-> m (Client KeepAlive 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (KeepAliveClientSt m a)
next
                                   else m (Client KeepAlive 'NonPipelined st' m a)
-> Client KeepAlive 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client KeepAlive 'NonPipelined st' m a)
 -> Client KeepAlive 'NonPipelined st' m a)
-> m (Client KeepAlive 'NonPipelined st' m a)
-> Client KeepAlive 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ KeepAliveProtocolFailure
-> m (Client KeepAlive 'NonPipelined st' m a)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (KeepAliveProtocolFailure
 -> m (Client KeepAlive 'NonPipelined st' m a))
-> KeepAliveProtocolFailure
-> m (Client KeepAlive 'NonPipelined st' m a)
forall a b. (a -> b) -> a -> b
$ Cookie -> Cookie -> KeepAliveProtocolFailure
KeepAliveCookieMissmatch Cookie
cookieReq Cookie
cookieRsp