-
Notifications
You must be signed in to change notification settings - Fork 86
/
Client.hs
41 lines (32 loc) · 1.2 KB
/
Client.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
{-# 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 (SendMsgDone mresult) =
Yield (ClientAgency TokClient) MsgDone $
Effect (Done TokDone <$> mresult)
keepAliveClientPeer (SendMsgKeepAlive cookieReq next) =
Yield (ClientAgency TokClient) (MsgKeepAlive cookieReq) $
Await (ServerAgency TokServer) $ \(MsgKeepAliveResponse cookieRsp) ->
if cookieReq == cookieRsp then Effect $ keepAliveClientPeer <$> next
else Effect $ throwM $ KeepAliveCookieMissmatch cookieReq cookieRsp