{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}


-- | A view of the chain synchronisation protocol from the point of view of the
-- client.
--
-- This provides a view that uses less complex types and should be easier to
-- use than the underlying typed protocol itself.
--
-- For execution, a conversion into the typed protocol is provided.
--
module Ouroboros.Network.Protocol.ChainSync.Client
  ( -- * Protocol type for the client
    -- | The protocol states from the point of view of the client.
    ChainSyncClient (..)
  , ClientStIdle (..)
  , ClientStNext (..)
  , ClientStIntersect (..)
    -- * Execution as a typed protocol
  , chainSyncClientPeer
    -- * Null chain sync client
  , chainSyncClientNull
    -- * Utilities
  , mapChainSyncClient
  ) where

import           Control.Monad (forever)
import           Control.Monad.Class.MonadTimer

import           Network.TypedProtocol.Core

import           Ouroboros.Network.Protocol.ChainSync.Type


-- | A chain sync protocol client, on top of some effect 'm'.
-- The first choice of request is within that 'm'.
newtype ChainSyncClient header point tip m a = ChainSyncClient {
    ChainSyncClient header point tip m a
-> m (ClientStIdle header point tip m a)
runChainSyncClient :: m (ClientStIdle header point tip m a)
  }

-- | A chain sync client which never sends any message.
--
chainSyncClientNull :: MonadTimer m => ChainSyncClient header point tip m a
chainSyncClientNull :: ChainSyncClient header point tip m a
chainSyncClientNull = m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (m (ClientStIdle header point tip m a)
 -> ChainSyncClient header point tip m a)
-> m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
forall a b. (a -> b) -> a -> b
$ m () -> m (ClientStIdle header point tip m a)
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m (ClientStIdle header point tip m a))
-> m () -> m (ClientStIdle header point tip m a)
forall a b. (a -> b) -> a -> b
$ DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
43200 {- one day in seconds -}

{-# DEPRECATED chainSyncClientNull "Use Ouroboros.Network.NodeToClient.chainSyncPeerNull" #-}

-- | In the 'StIdle' protocol state, the server does not have agency and can choose to
-- send a request next, or a find intersection message.
--
data ClientStIdle header point tip m a where

  -- | Send the 'MsgRequestNext', with handlers for the replies.
  --
  -- The handlers for this message are more complicated than most RPCs because
  -- the server can either send us a reply immediately or it can send us a
  -- 'MsgAwaitReply' to indicate that the server itself has to block for a
  -- state change before it can send us the reply.
  --
  -- In the waiting case, the client gets the chance to take a local action.
  --
  SendMsgRequestNext
    ::    ClientStNext header point tip m a
    -> m (ClientStNext header point tip m a) -- after MsgAwaitReply
    -> ClientStIdle header point tip m a

  -- | Send the 'MsgFindIntersect', with handlers for the replies.
  --
  SendMsgFindIntersect
    :: [point]
    -> ClientStIntersect header point tip m a
    -> ClientStIdle header point tip m a

  -- | The client decided to end the protocol.
  --
  SendMsgDone
    :: a
    -> ClientStIdle header point tip m a

-- | In the 'StNext' protocol state, the client does not have agency and is
-- waiting to receive either
--
--  * a roll forward,
--  * roll back message,
--
-- It must be prepared to handle any of these.
--
data ClientStNext header point tip m a =
     ClientStNext {
       ClientStNext header point tip m a
-> header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward  :: header -- header to add to the chain
                           -> tip    -- information about tip of the chain
                           -> ChainSyncClient header point tip m a,

       ClientStNext header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: point        -- rollback point
                           -> tip          -- information about tip of the chain
                           -> ChainSyncClient header point tip m a
     }

-- | In the 'StIntersect' protocol state, the client does not have agency and
-- is waiting to receive:
--
--  * an intersection improved,
--  * unchanged message,
--  * the termination message.
--
-- It must be prepared to handle any of these.
--
data ClientStIntersect header point tip m a =
     ClientStIntersect {
       ClientStIntersect header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound    :: point        -- found intersection point
                                -> tip          -- information about tip of the chain
                                -> ChainSyncClient header point tip m a,

       ClientStIntersect header point tip m a
-> tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound :: tip          -- information about tip of the chain
                                -> ChainSyncClient header point tip m a
     }


-- | Transform a 'ChainSyncClient' by mapping over the tx header and the
-- chain tip values.
--
-- Note the direction of the individual mapping functions corresponds to
-- whether the types are used as protocol inputs or outputs (or both, as is
-- the case for points).
--
mapChainSyncClient :: forall header header' point point' tip tip' m a.
                      Functor m
                   => (point  -> point')
                   -> (point' -> point)
                   -> (header' -> header)
                   -> (tip' -> tip)
                   -> ChainSyncClient header  point  tip  m a
                   -> ChainSyncClient header' point' tip' m a
mapChainSyncClient :: (point -> point')
-> (point' -> point)
-> (header' -> header)
-> (tip' -> tip)
-> ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
mapChainSyncClient point -> point'
fpoint point' -> point
fpoint' header' -> header
fheader tip' -> tip
ftip =
    ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
goClient
  where
    goClient :: ChainSyncClient header  point  tip  m a
             -> ChainSyncClient header' point' tip' m a
    goClient :: ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
goClient (ChainSyncClient m (ClientStIdle header point tip m a)
c) = m (ClientStIdle header' point' tip' m a)
-> ChainSyncClient header' point' tip' m a
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient ((ClientStIdle header point tip m a
 -> ClientStIdle header' point' tip' m a)
-> m (ClientStIdle header point tip m a)
-> m (ClientStIdle header' point' tip' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientStIdle header point tip m a
-> ClientStIdle header' point' tip' m a
goIdle m (ClientStIdle header point tip m a)
c)

    goIdle :: ClientStIdle header  point  tip  m a
           -> ClientStIdle header' point' tip' m a
    goIdle :: ClientStIdle header point tip m a
-> ClientStIdle header' point' tip' m a
goIdle (SendMsgRequestNext ClientStNext header point tip m a
stNext m (ClientStNext header point tip m a)
stAwait) =
      ClientStNext header' point' tip' m a
-> m (ClientStNext header' point' tip' m a)
-> ClientStIdle header' point' tip' m a
forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> m (ClientStNext header point tip m a)
-> ClientStIdle header point tip m a
SendMsgRequestNext (ClientStNext header point tip m a
-> ClientStNext header' point' tip' m a
goNext ClientStNext header point tip m a
stNext) ((ClientStNext header point tip m a
 -> ClientStNext header' point' tip' m a)
-> m (ClientStNext header point tip m a)
-> m (ClientStNext header' point' tip' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientStNext header point tip m a
-> ClientStNext header' point' tip' m a
goNext m (ClientStNext header point tip m a)
stAwait)

    goIdle (SendMsgFindIntersect [point]
points ClientStIntersect header point tip m a
stIntersect) =
      [point']
-> ClientStIntersect header' point' tip' m a
-> ClientStIdle header' point' tip' m a
forall point header tip (m :: * -> *) a.
[point]
-> ClientStIntersect header point tip m a
-> ClientStIdle header point tip m a
SendMsgFindIntersect ((point -> point') -> [point] -> [point']
forall a b. (a -> b) -> [a] -> [b]
map point -> point'
fpoint [point]
points) (ClientStIntersect header point tip m a
-> ClientStIntersect header' point' tip' m a
goIntersect ClientStIntersect header point tip m a
stIntersect)

    goIdle (SendMsgDone a
a) = a -> ClientStIdle header' point' tip' m a
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
SendMsgDone a
a

    goNext :: ClientStNext header  point  tip  m a
           -> ClientStNext header' point' tip' m a
    goNext :: ClientStNext header point tip m a
-> ClientStNext header' point' tip' m a
goNext ClientStNext{header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward :: header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward :: forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward, point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward} =
      ClientStNext :: forall header point tip (m :: * -> *) a.
(header -> tip -> ChainSyncClient header point tip m a)
-> (point -> tip -> ChainSyncClient header point tip m a)
-> ClientStNext header point tip m a
ClientStNext {
        recvMsgRollForward :: header' -> tip' -> ChainSyncClient header' point' tip' m a
recvMsgRollForward  = \header'
hdr tip'
tip ->
          ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
goClient (header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward (header' -> header
fheader header'
hdr) (tip' -> tip
ftip tip'
tip)),

        recvMsgRollBackward :: point' -> tip' -> ChainSyncClient header' point' tip' m a
recvMsgRollBackward = \point'
pt  tip'
tip ->
          ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
goClient (point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward (point' -> point
fpoint' point'
pt) (tip' -> tip
ftip tip'
tip))
      }

    goIntersect :: ClientStIntersect header  point  tip  m a
                -> ClientStIntersect header' point' tip' m a
    goIntersect :: ClientStIntersect header point tip m a
-> ClientStIntersect header' point' tip' m a
goIntersect ClientStIntersect { point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound :: point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound :: forall header point tip (m :: * -> *) a.
ClientStIntersect header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound,
                                    tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound :: tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound :: forall header point tip (m :: * -> *) a.
ClientStIntersect header point tip m a
-> tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound } =
      ClientStIntersect :: forall header point tip (m :: * -> *) a.
(point -> tip -> ChainSyncClient header point tip m a)
-> (tip -> ChainSyncClient header point tip m a)
-> ClientStIntersect header point tip m a
ClientStIntersect {
        recvMsgIntersectFound :: point' -> tip' -> ChainSyncClient header' point' tip' m a
recvMsgIntersectFound = \point'
pt tip'
tip ->
          ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
goClient (point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound (point' -> point
fpoint' point'
pt) (tip' -> tip
ftip tip'
tip)),

        recvMsgIntersectNotFound :: tip' -> ChainSyncClient header' point' tip' m a
recvMsgIntersectNotFound = \tip'
tip ->
          ChainSyncClient header point tip m a
-> ChainSyncClient header' point' tip' m a
goClient (tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound (tip' -> tip
ftip tip'
tip))
      }


-- | Interpret a 'ChainSyncClient' action sequence as a 'Peer' on the client
-- side of the 'ChainSyncProtocol'.
--
chainSyncClientPeer
  :: forall header point tip m a .
     Monad m
  => ChainSyncClient header point tip m a
  -> Peer (ChainSync header point tip) AsClient StIdle m a
chainSyncClientPeer :: ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (ChainSyncClient m (ClientStIdle header point tip m a)
mclient) =
    m (Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
-> Peer (ChainSync header point tip) 'AsClient 'StIdle 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 (ChainSync header point tip) 'AsClient 'StIdle m a)
 -> Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
-> m (Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$ (ClientStIdle header point tip m a
 -> Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
-> m (ClientStIdle header point tip m a)
-> m (Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientStIdle header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer_ m (ClientStIdle header point tip m a)
mclient
  where
    chainSyncClientPeer_
      :: ClientStIdle header point tip m a
      -> Peer (ChainSync header point tip) AsClient StIdle m a
    chainSyncClientPeer_ :: ClientStIdle header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer_ (SendMsgRequestNext ClientStNext header point tip m a
stNext m (ClientStNext header point tip m a)
stAwait) =
        WeHaveAgency 'AsClient 'StIdle
-> Message
     (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StCanAwait) m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle 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 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k k (header :: k) (point :: k) (tip :: k).
ClientHasAgency 'StIdle
TokIdle) Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
forall k k k (header :: k) (point :: k) (tip :: k).
Message (ChainSync header point tip) 'StIdle ('StNext 'StCanAwait)
MsgRequestNext (Peer
   (ChainSync header point tip) 'AsClient ('StNext 'StCanAwait) m a
 -> Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StCanAwait) m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$
        TheyHaveAgency 'AsClient ('StNext 'StCanAwait)
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) ('StNext 'StCanAwait) st'
    -> Peer (ChainSync header point tip) 'AsClient st' m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StCanAwait) 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 ('StNext 'StCanAwait)
-> PeerHasAgency 'AsServer ('StNext 'StCanAwait)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokNextKind 'StCanAwait -> ServerHasAgency ('StNext 'StCanAwait)
forall k k k (header :: k) (point :: k) (tip :: k)
       (k :: StNextKind).
TokNextKind k -> ServerHasAgency ('StNext k)
TokNext TokNextKind 'StCanAwait
TokCanAwait)) ((forall (st' :: ChainSync header point tip).
  Message (ChainSync header point tip) ('StNext 'StCanAwait) st'
  -> Peer (ChainSync header point tip) 'AsClient st' m a)
 -> Peer
      (ChainSync header point tip) 'AsClient ('StNext 'StCanAwait) m a)
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) ('StNext 'StCanAwait) st'
    -> Peer (ChainSync header point tip) 'AsClient st' m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StCanAwait) m a
forall a b. (a -> b) -> a -> b
$ \Message (ChainSync header point tip) ('StNext 'StCanAwait) st'
resp ->
        case Message (ChainSync header point tip) ('StNext 'StCanAwait) st'
resp of
          MsgRollForward header tip ->
              ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward header
header
header tip
tip
tip)
            where
              ClientStNext{header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward :: header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward :: forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward} = ClientStNext header point tip m a
stNext

          MsgRollBackward pRollback tip ->
              ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward point
point
pRollback tip
tip
tip)
            where
              ClientStNext{point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward} = ClientStNext header point tip m a
stNext

          -- This code could be factored more easily by changing the protocol type
          -- to put both roll forward and back under a single constructor.
          Message (ChainSync header point tip) ('StNext 'StCanAwait) st'
MsgAwaitReply ->
            m (Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) 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
      (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
 -> Peer
      (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
-> m (Peer
        (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a
forall a b. (a -> b) -> a -> b
$ do
              ClientStNext{header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward :: header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward :: forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward, point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward :: forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward} <- m (ClientStNext header point tip m a)
stAwait
              Peer
  (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a
-> m (Peer
        (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer
   (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a
 -> m (Peer
         (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a))
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a
-> m (Peer
        (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
forall a b. (a -> b) -> a -> b
$ TheyHaveAgency 'AsClient ('StNext 'StMustReply)
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) ('StNext 'StMustReply) st'
    -> Peer (ChainSync header point tip) 'AsClient st' m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) 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 ('StNext 'StMustReply)
-> PeerHasAgency 'AsServer ('StNext 'StMustReply)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokNextKind 'StMustReply -> ServerHasAgency ('StNext 'StMustReply)
forall k k k (header :: k) (point :: k) (tip :: k)
       (k :: StNextKind).
TokNextKind k -> ServerHasAgency ('StNext k)
TokNext TokNextKind 'StMustReply
TokMustReply)) ((forall (st' :: ChainSync header point tip).
  Message (ChainSync header point tip) ('StNext 'StMustReply) st'
  -> Peer (ChainSync header point tip) 'AsClient st' m a)
 -> Peer
      (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a)
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) ('StNext 'StMustReply) st'
    -> Peer (ChainSync header point tip) 'AsClient st' m a)
-> Peer
     (ChainSync header point tip) 'AsClient ('StNext 'StMustReply) m a
forall a b. (a -> b) -> a -> b
$ \Message (ChainSync header point tip) ('StNext 'StMustReply) st'
resp' ->
                case Message (ChainSync header point tip) ('StNext 'StMustReply) st'
resp' of
                  MsgRollForward header tip ->
                    ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (header -> tip -> ChainSyncClient header point tip m a
recvMsgRollForward header
header
header tip
tip
tip)
                  MsgRollBackward pRollback tip ->
                    ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (point -> tip -> ChainSyncClient header point tip m a
recvMsgRollBackward point
point
pRollback tip
tip
tip)

    chainSyncClientPeer_ (SendMsgFindIntersect [point]
points ClientStIntersect header point tip m a
stIntersect) =
        WeHaveAgency 'AsClient 'StIdle
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
-> Peer (ChainSync header point tip) 'AsClient 'StIntersect m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle 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 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k k (header :: k) (point :: k) (tip :: k).
ClientHasAgency 'StIdle
TokIdle) ([point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
forall k k point (header :: k) (tip :: k).
[point]
-> Message (ChainSync header point tip) 'StIdle 'StIntersect
MsgFindIntersect [point]
points) (Peer (ChainSync header point tip) 'AsClient 'StIntersect m a
 -> Peer (ChainSync header point tip) 'AsClient 'StIdle m a)
-> Peer (ChainSync header point tip) 'AsClient 'StIntersect m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$
        TheyHaveAgency 'AsClient 'StIntersect
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) 'StIntersect st'
    -> Peer (ChainSync header point tip) 'AsClient st' m a)
-> Peer (ChainSync header point tip) 'AsClient 'StIntersect 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 'StIntersect
-> PeerHasAgency 'AsServer 'StIntersect
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StIntersect
forall k k k (header :: k) (point :: k) (tip :: k).
ServerHasAgency 'StIntersect
TokIntersect) ((forall (st' :: ChainSync header point tip).
  Message (ChainSync header point tip) 'StIntersect st'
  -> Peer (ChainSync header point tip) 'AsClient st' m a)
 -> Peer (ChainSync header point tip) 'AsClient 'StIntersect m a)
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) 'StIntersect st'
    -> Peer (ChainSync header point tip) 'AsClient st' m a)
-> Peer (ChainSync header point tip) 'AsClient 'StIntersect m a
forall a b. (a -> b) -> a -> b
$ \Message (ChainSync header point tip) 'StIntersect st'
resp ->
        case Message (ChainSync header point tip) 'StIntersect st'
resp of
          MsgIntersectFound pIntersect tip ->
            ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound point
point
pIntersect tip
tip
tip)

          MsgIntersectNotFound tip ->
            ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClient header point tip m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle m a
chainSyncClientPeer (tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound tip
tip
tip)
      where
        ClientStIntersect {
          point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound :: point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound :: forall header point tip (m :: * -> *) a.
ClientStIntersect header point tip m a
-> point -> tip -> ChainSyncClient header point tip m a
recvMsgIntersectFound,
          tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound :: tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound :: forall header point tip (m :: * -> *) a.
ClientStIntersect header point tip m a
-> tip -> ChainSyncClient header point tip m a
recvMsgIntersectNotFound
        } = ClientStIntersect header point tip m a
stIntersect

    chainSyncClientPeer_ (SendMsgDone a
a) =
      WeHaveAgency 'AsClient 'StIdle
-> Message (ChainSync header point tip) 'StIdle 'StDone
-> Peer (ChainSync header point tip) 'AsClient 'StDone m a
-> Peer (ChainSync header point tip) 'AsClient 'StIdle 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 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k k (header :: k) (point :: k) (tip :: k).
ClientHasAgency 'StIdle
TokIdle) Message (ChainSync header point tip) 'StIdle 'StDone
forall k k k (header :: k) (point :: k) (tip :: k).
Message (ChainSync header point tip) 'StIdle 'StDone
MsgDone (NobodyHasAgency 'StDone
-> a -> Peer (ChainSync header point tip) 'AsClient 'StDone m a
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency 'StDone
forall k k k (header :: k) (point :: k) (tip :: k).
NobodyHasAgency 'StDone
TokDone a
a)