module Hydra.Network.Ouroboros.Client where

import Hydra.Prelude

import Hydra.Network.Ouroboros.Type (
  FireForget (..),
  Message (MsgDone, MsgSend),
 )
import Network.TypedProtocol.Core (
  IsPipelined (..),
  PeerRole (..),
  ReflRelativeAgency (..),
 )
import Network.TypedProtocol.Peer (
  Peer (..),
 )

data FireForgetClient msg m a where
  Idle :: m (FireForgetClient msg m a) -> FireForgetClient msg m a
  SendMsg :: msg -> m (FireForgetClient msg m a) -> FireForgetClient msg m a
  SendDone :: m a -> FireForgetClient msg m a

fireForgetClientPeer ::
  Monad m =>
  FireForgetClient msg m a ->
  Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
fireForgetClientPeer :: forall (m :: * -> *) msg a.
Monad m =>
FireForgetClient msg m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
fireForgetClientPeer = \case
  Idle m (FireForgetClient msg m a)
next ->
    m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined) (st :: ps)
       (m :: * -> *) a.
m (Peer ps pr pl st m a) -> Peer ps pr pl st m a
Effect (m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$ FireForgetClient msg m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall (m :: * -> *) msg a.
Monad m =>
FireForgetClient msg m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
fireForgetClientPeer (FireForgetClient msg m a
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> m (FireForgetClient msg m a)
-> m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (FireForgetClient msg m a)
next
  SendMsg msg
msg m (FireForgetClient msg m a)
next ->
    WeHaveAgencyProof 'AsClient 'StIdle
-> Message (FireForget msg) 'StIdle 'StIdle
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined) (st :: ps)
       (st' :: ps) (m :: * -> *) a.
(StateTokenI st, StateTokenI st', ActiveState st,
 Outstanding pl ~ 'Z) =>
WeHaveAgencyProof pr st
-> Message ps st st'
-> Peer ps pr pl st' m a
-> Peer ps pr pl st m a
Yield WeHaveAgencyProof 'AsClient 'StIdle
ReflRelativeAgency 'ClientAgency 'WeHaveAgency 'WeHaveAgency
forall (r :: RelativeAgency). ReflRelativeAgency 'ClientAgency r r
ReflClientAgency (msg -> Message (FireForget msg) 'StIdle 'StIdle
forall msg1. msg1 -> Message (FireForget msg1) 'StIdle 'StIdle
MsgSend msg
msg) (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$
      m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined) (st :: ps)
       (m :: * -> *) a.
m (Peer ps pr pl st m a) -> Peer ps pr pl st m a
Effect (m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$
        FireForgetClient msg m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall (m :: * -> *) msg a.
Monad m =>
FireForgetClient msg m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
fireForgetClientPeer (FireForgetClient msg m a
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> m (FireForgetClient msg m a)
-> m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (FireForgetClient msg m a)
next
  SendDone m a
action ->
    m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined) (st :: ps)
       (m :: * -> *) a.
m (Peer ps pr pl st m a) -> Peer ps pr pl st m a
Effect (m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$ WeHaveAgencyProof 'AsClient 'StIdle
-> Message (FireForget msg) 'StIdle 'StDone
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StDone m a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall ps (pr :: PeerRole) (pl :: IsPipelined) (st :: ps)
       (st' :: ps) (m :: * -> *) a.
(StateTokenI st, StateTokenI st', ActiveState st,
 Outstanding pl ~ 'Z) =>
WeHaveAgencyProof pr st
-> Message ps st st'
-> Peer ps pr pl st' m a
-> Peer ps pr pl st m a
Yield WeHaveAgencyProof 'AsClient 'StIdle
ReflRelativeAgency 'ClientAgency 'WeHaveAgency 'WeHaveAgency
forall (r :: RelativeAgency). ReflRelativeAgency 'ClientAgency r r
ReflClientAgency Message (FireForget msg) 'StIdle 'StDone
forall {k} (msg :: k). Message (FireForget msg) 'StIdle 'StDone
MsgDone (Peer (FireForget msg) 'AsClient 'NonPipelined 'StDone m a
 -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> (a -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StDone m a)
-> a
-> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NobodyHasAgencyProof 'AsClient 'StDone
-> a -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StDone m a
forall ps (pr :: PeerRole) (pl :: IsPipelined) (st :: ps)
       (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
NobodyHasAgencyProof pr st -> a -> Peer ps pr pl st m a
Done NobodyHasAgencyProof 'AsClient 'StDone
ReflRelativeAgency 'NobodyAgency 'NobodyHasAgency 'NobodyHasAgency
forall (r :: RelativeAgency). ReflRelativeAgency 'NobodyAgency r r
ReflNobodyAgency (a -> Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
-> m a
-> m (Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action