{-# 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 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
  -> Peer KeepAlive AsClient StClient m a
keepAliveClientPeer :: forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientPeer (KeepAliveClient m (KeepAliveClientSt m a)
client) =
   m (Peer KeepAlive 'AsClient 'StClient m a)
-> Peer KeepAlive 'AsClient 'StClient 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 'AsClient 'StClient m a)
 -> Peer KeepAlive 'AsClient 'StClient m a)
-> m (Peer KeepAlive 'AsClient 'StClient m a)
-> Peer KeepAlive 'AsClient 'StClient m a
forall a b. (a -> b) -> a -> b
$ KeepAliveClientSt m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientStPeer (KeepAliveClientSt m a -> Peer KeepAlive 'AsClient 'StClient m a)
-> m (KeepAliveClientSt m a)
-> m (Peer KeepAlive 'AsClient '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
     -> Peer KeepAlive AsClient StClient m a

   keepAliveClientStPeer :: KeepAliveClientSt m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientStPeer (SendMsgDone m a
mresult) =
     WeHaveAgency 'AsClient 'StClient
-> Message KeepAlive 'StClient 'StDone
-> Peer KeepAlive 'AsClient 'StDone m a
-> Peer KeepAlive 'AsClient 'StClient 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 (ClientHasAgency 'StClient -> WeHaveAgency 'AsClient 'StClient
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StClient
TokClient) Message KeepAlive 'StClient 'StDone
MsgDone (Peer KeepAlive 'AsClient 'StDone m a
 -> Peer KeepAlive 'AsClient 'StClient m a)
-> Peer KeepAlive 'AsClient 'StDone m a
-> Peer KeepAlive 'AsClient 'StClient m a
forall a b. (a -> b) -> a -> b
$
       m (Peer KeepAlive 'AsClient 'StDone m a)
-> Peer KeepAlive 'AsClient 'StDone m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (NobodyHasAgency 'StDone
-> a -> Peer KeepAlive 'AsClient 'StDone m a
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency 'StDone
TokDone (a -> Peer KeepAlive 'AsClient 'StDone m a)
-> m a -> m (Peer KeepAlive 'AsClient '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) =
     WeHaveAgency 'AsClient 'StClient
-> Message KeepAlive 'StClient 'StServer
-> Peer KeepAlive 'AsClient 'StServer m a
-> Peer KeepAlive 'AsClient 'StClient 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 (ClientHasAgency 'StClient -> WeHaveAgency 'AsClient 'StClient
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StClient
TokClient) (Cookie -> Message KeepAlive 'StClient 'StServer
MsgKeepAlive Cookie
cookieReq) (Peer KeepAlive 'AsClient 'StServer m a
 -> Peer KeepAlive 'AsClient 'StClient m a)
-> Peer KeepAlive 'AsClient 'StServer m a
-> Peer KeepAlive 'AsClient 'StClient m a
forall a b. (a -> b) -> a -> b
$
       TheyHaveAgency 'AsClient 'StServer
-> (forall {st' :: KeepAlive}.
    Message KeepAlive 'StServer st'
    -> Peer KeepAlive 'AsClient st' m a)
-> Peer KeepAlive 'AsClient 'StServer 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 (ServerHasAgency 'StServer -> PeerHasAgency 'AsServer 'StServer
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StServer
TokServer) ((forall {st' :: KeepAlive}.
  Message KeepAlive 'StServer st'
  -> Peer KeepAlive 'AsClient st' m a)
 -> Peer KeepAlive 'AsClient 'StServer m a)
-> (forall {st' :: KeepAlive}.
    Message KeepAlive 'StServer st'
    -> Peer KeepAlive 'AsClient st' m a)
-> Peer KeepAlive 'AsClient '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 (Peer KeepAlive 'AsClient st' m a)
-> Peer KeepAlive 'AsClient 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 'AsClient st' m a)
 -> Peer KeepAlive 'AsClient st' m a)
-> m (Peer KeepAlive 'AsClient st' m a)
-> Peer KeepAlive 'AsClient st' m a
forall a b. (a -> b) -> a -> b
$ KeepAliveClientSt m a -> Peer KeepAlive 'AsClient st' m a
KeepAliveClientSt m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientStPeer (KeepAliveClientSt m a -> Peer KeepAlive 'AsClient st' m a)
-> m (KeepAliveClientSt m a)
-> m (Peer KeepAlive 'AsClient st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (KeepAliveClientSt m a)
next
                                   else m (Peer KeepAlive 'AsClient st' m a)
-> Peer KeepAlive 'AsClient 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 'AsClient st' m a)
 -> Peer KeepAlive 'AsClient st' m a)
-> m (Peer KeepAlive 'AsClient st' m a)
-> Peer KeepAlive 'AsClient st' m a
forall a b. (a -> b) -> a -> b
$ KeepAliveProtocolFailure -> m (Peer KeepAlive 'AsClient 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 (Peer KeepAlive 'AsClient st' m a))
-> KeepAliveProtocolFailure -> m (Peer KeepAlive 'AsClient st' m a)
forall a b. (a -> b) -> a -> b
$ Cookie -> Cookie -> KeepAliveProtocolFailure
KeepAliveCookieMissmatch Cookie
cookieReq Cookie
cookieRsp