{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes     #-}

module Ouroboros.Network.Protocol.KeepAlive.Direct where

import Ouroboros.Network.Protocol.KeepAlive.Client
import Ouroboros.Network.Protocol.KeepAlive.Server


direct :: forall a b m. Monad m
       => KeepAliveServer m a
       -> KeepAliveClient m b
       -> m (a, b)
direct :: forall a b (m :: * -> *).
Monad m =>
KeepAliveServer m a -> KeepAliveClient m b -> m (a, b)
direct KeepAliveServer m a
srv (KeepAliveClient m (KeepAliveClientSt m b)
clientM) = do
  KeepAliveServer m a -> KeepAliveClientSt m b -> m (a, b)
forall (m :: * -> *) a b.
Monad m =>
KeepAliveServer m a -> KeepAliveClientSt m b -> m (a, b)
go KeepAliveServer m a
srv (KeepAliveClientSt m b -> m (a, b))
-> m (KeepAliveClientSt m b) -> m (a, b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (KeepAliveClientSt m b)
clientM
 where
   go :: Monad m
      => KeepAliveServer m a
      -> KeepAliveClientSt m b
      -> m (a, b)
   go :: forall (m :: * -> *) a b.
Monad m =>
KeepAliveServer m a -> KeepAliveClientSt m b -> m (a, b)
go KeepAliveServer { m a
recvMsgDone :: m a
recvMsgDone :: forall (m :: * -> *) a. KeepAliveServer m a -> m a
recvMsgDone }
          (SendMsgDone m b
mdone) =
       (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone m (b -> (a, b)) -> m b -> m (a, b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b
mdone
   go KeepAliveServer { m (KeepAliveServer m a)
recvMsgKeepAlive :: m (KeepAliveServer m a)
recvMsgKeepAlive :: forall (m :: * -> *) a.
KeepAliveServer m a -> m (KeepAliveServer m a)
recvMsgKeepAlive }
          (SendMsgKeepAlive Cookie
_cookie m (KeepAliveClientSt m b)
mclient) = do
       server <- m (KeepAliveServer m a)
recvMsgKeepAlive
       client <- mclient
       go server client