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

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

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


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

    SendMsgDone
      :: m a
      -> KeepAliveClient m a


-- | Interpret a particular client action sequence into the client side of the
-- 'KeepAlive' protocol.
--
keepAliveClientPeer
  :: MonadThrow m
  => KeepAliveClient m a
  -> Peer KeepAlive AsClient StClient m a

keepAliveClientPeer :: KeepAliveClient m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientPeer (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)

keepAliveClientPeer (SendMsgKeepAlive Cookie
cookieReq m (KeepAliveClient 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 cookieRsp) ->
        if Cookie
cookieReq Cookie -> Cookie -> Bool
forall a. Eq a => a -> a -> Bool
== Cookie
cookieRsp then 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
$ KeepAliveClient m a -> Peer KeepAlive 'AsClient 'StClient m a
forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientPeer (KeepAliveClient m a -> Peer KeepAlive 'AsClient 'StClient m a)
-> m (KeepAliveClient m a)
-> m (Peer KeepAlive 'AsClient 'StClient m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (KeepAliveClient 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 (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