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

module Ouroboros.Network.Protocol.PeerSharing.Client where

import Network.TypedProtocol.Peer.Client

import Ouroboros.Network.Protocol.PeerSharing.Type

data PeerSharingClient peerAddress m a where
  SendMsgShareRequest
    :: PeerSharingAmount
    -> ([peerAddress] -> m (PeerSharingClient peerAddress m a))
    -> PeerSharingClient peerAddress m a

  SendMsgDone
    :: m a -> PeerSharingClient peerAddress m a

-- | Interpret a particular client action sequence into the client side of the
-- 'PeerSharing' protocol.
--
peerSharingClientPeer :: Monad m
                      => PeerSharingClient peerAddress m a
                      -> Client (PeerSharing peerAddress) NonPipelined StIdle m a
peerSharingClientPeer :: forall (m :: * -> *) peerAddress a.
Monad m =>
PeerSharingClient peerAddress m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
peerSharingClientPeer (SendMsgShareRequest PeerSharingAmount
amount [peerAddress] -> m (PeerSharingClient peerAddress m a)
k) =
  -- Send MsgShareRequest message
  Message (PeerSharing peerAddress) 'StIdle 'StBusy
-> Client (PeerSharing peerAddress) 'NonPipelined 'StBusy m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield (PeerSharingAmount
-> Message (PeerSharing peerAddress) 'StIdle 'StBusy
forall {k} (peerAddress :: k).
PeerSharingAmount
-> Message (PeerSharing peerAddress) 'StIdle 'StBusy
MsgShareRequest PeerSharingAmount
amount) (Client (PeerSharing peerAddress) 'NonPipelined 'StBusy m a
 -> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
-> Client (PeerSharing peerAddress) 'NonPipelined 'StBusy m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$
    -- Wait for the reply (notice the agency proofs)
    (forall (st' :: PeerSharing peerAddress).
 Message (PeerSharing peerAddress) 'StBusy st'
 -> Client (PeerSharing peerAddress) 'NonPipelined st' m a)
-> Client (PeerSharing peerAddress) 'NonPipelined 'StBusy m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Client ps pl st' m a)
-> Client ps pl st m a
Await ((forall (st' :: PeerSharing peerAddress).
  Message (PeerSharing peerAddress) 'StBusy st'
  -> Client (PeerSharing peerAddress) 'NonPipelined st' m a)
 -> Client (PeerSharing peerAddress) 'NonPipelined 'StBusy m a)
-> (forall (st' :: PeerSharing peerAddress).
    Message (PeerSharing peerAddress) 'StBusy st'
    -> Client (PeerSharing peerAddress) 'NonPipelined st' m a)
-> Client (PeerSharing peerAddress) 'NonPipelined 'StBusy m a
forall a b. (a -> b) -> a -> b
$ \(MsgSharePeers [peerAddress1]
resp) ->
      -- We have our reply. We might want to perform some action with it so we
      -- run the continuation to handle t he response.
      m (Client (PeerSharing peerAddress) 'NonPipelined st' m a)
-> Client (PeerSharing peerAddress) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (PeerSharing peerAddress) 'NonPipelined st' m a)
 -> Client (PeerSharing peerAddress) 'NonPipelined st' m a)
-> m (Client (PeerSharing peerAddress) 'NonPipelined st' m a)
-> Client (PeerSharing peerAddress) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ PeerSharingClient peerAddress m a
-> Client (PeerSharing peerAddress) 'NonPipelined st' m a
PeerSharingClient peerAddress m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall (m :: * -> *) peerAddress a.
Monad m =>
PeerSharingClient peerAddress m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
peerSharingClientPeer (PeerSharingClient peerAddress m a
 -> Client (PeerSharing peerAddress) 'NonPipelined st' m a)
-> m (PeerSharingClient peerAddress m a)
-> m (Client (PeerSharing peerAddress) 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [peerAddress] -> m (PeerSharingClient peerAddress m a)
k [peerAddress]
[peerAddress1]
resp
peerSharingClientPeer (SendMsgDone m a
result) =
    -- Perform some finishing action
    -- Perform a transition to the 'StDone' state
    m (Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
 -> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
-> m (Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$ Message (PeerSharing peerAddress) 'StIdle 'StDone
-> Client (PeerSharing peerAddress) 'NonPipelined 'StDone m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield Message (PeerSharing peerAddress) 'StIdle 'StDone
forall {k} (peerAddress :: k).
Message (PeerSharing peerAddress) 'StIdle 'StDone
MsgDone (Client (PeerSharing peerAddress) 'NonPipelined 'StDone m a
 -> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
-> (a
    -> Client (PeerSharing peerAddress) 'NonPipelined 'StDone m a)
-> a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Client (PeerSharing peerAddress) 'NonPipelined 'StDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Client ps pl st m a
Done (a -> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
-> m a
-> m (Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
result