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

{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

-- | A view of the chain synchronisation protocol from the point of view of the
-- server.
--
-- 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.Server
  ( -- * Protocol type for the server
    -- | The protocol states from the point of view of the server.
    ChainSyncServer (..)
  , ServerStIdle (..)
  , ServerStNext (..)
  , ServerStIntersect (..)
    -- * Execution as a typed protocol
  , chainSyncServerPeer
  ) where

import           Network.TypedProtocol.Core

import           Ouroboros.Network.Protocol.ChainSync.Type


-- | A chain sync protocol server, on top of some effect 'm'.
--
newtype ChainSyncServer header point tip m a = ChainSyncServer {
    ChainSyncServer header point tip m a
-> m (ServerStIdle header point tip m a)
runChainSyncServer :: m (ServerStIdle header point tip m a)
  }


-- | In the 'StIdle' protocol state, the server does not have agency. Instead
-- it is waiting for:
--
--  * a next update request
--  * a find intersection request
--  * a termination messge
--
-- It must be prepared to handle either.
--
data ServerStIdle header point tip m a = ServerStIdle {

       ServerStIdle header point tip m a
-> m (Either
        (ServerStNext header point tip m a)
        (m (ServerStNext header point tip m a)))
recvMsgRequestNext   :: m (Either (ServerStNext header point tip m a)
                                      (m (ServerStNext header point tip m a))),

       ServerStIdle header point tip m a
-> [point] -> m (ServerStIntersect header point tip m a)
recvMsgFindIntersect :: [point]
                            -> m (ServerStIntersect header point tip m a),

       ServerStIdle header point tip m a -> m a
recvMsgDoneClient :: m a
     }

-- | In the 'StNext' protocol state, the server has agency and must send either:
--
--  * a roll forward
--  * a roll back message
--  * a termination message
--
data ServerStNext header point tip m a where
  SendMsgRollForward  :: header -> tip
                      -> ChainSyncServer header point tip m a
                      -> ServerStNext header point tip m a

  SendMsgRollBackward :: point -> tip
                      -> ChainSyncServer header point tip m a
                      -> ServerStNext header point tip m a

-- | In the 'StIntersect' protocol state, the server has agency and must send
-- either:
--
--  * an intersection improved,
--  * unchanged message,
--  * termination message
--
data ServerStIntersect header point tip m a where
  SendMsgIntersectFound     :: point -> tip
                            -> ChainSyncServer header point tip m a
                            -> ServerStIntersect header point tip m a

  SendMsgIntersectNotFound  :: tip
                            -> ChainSyncServer header point tip m a
                            -> ServerStIntersect header point tip m a


-- | Interpret a 'ChainSyncServer' action sequence as a 'Peer' on the server
-- side of the 'ChainSyncProtocol'.
--
chainSyncServerPeer
  :: forall header point tip m a.
     Monad m
  => ChainSyncServer header point tip m a
  -> Peer (ChainSync header point tip) AsServer StIdle m a
chainSyncServerPeer :: ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer (ChainSyncServer m (ServerStIdle header point tip m a)
mterm) = m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
-> Peer (ChainSync header point tip) 'AsServer '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) 'AsServer 'StIdle m a)
 -> Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
-> m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ m (ServerStIdle header point tip m a)
mterm m (ServerStIdle header point tip m a)
-> (ServerStIdle header point tip m a
    -> m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a))
-> m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \(ServerStIdle{m (Either
     (ServerStNext header point tip m a)
     (m (ServerStNext header point tip m a)))
recvMsgRequestNext :: m (Either
     (ServerStNext header point tip m a)
     (m (ServerStNext header point tip m a)))
recvMsgRequestNext :: forall header point tip (m :: * -> *) a.
ServerStIdle header point tip m a
-> m (Either
        (ServerStNext header point tip m a)
        (m (ServerStNext header point tip m a)))
recvMsgRequestNext, [point] -> m (ServerStIntersect header point tip m a)
recvMsgFindIntersect :: [point] -> m (ServerStIntersect header point tip m a)
recvMsgFindIntersect :: forall header point tip (m :: * -> *) a.
ServerStIdle header point tip m a
-> [point] -> m (ServerStIntersect header point tip m a)
recvMsgFindIntersect, m a
recvMsgDoneClient :: m a
recvMsgDoneClient :: forall header point tip (m :: * -> *) a.
ServerStIdle header point tip m a -> m a
recvMsgDoneClient}) ->

    Peer (ChainSync header point tip) 'AsServer 'StIdle m a
-> m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer (ChainSync header point tip) 'AsServer 'StIdle m a
 -> m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a))
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
-> m (Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
forall a b. (a -> b) -> a -> b
$ TheyHaveAgency 'AsServer 'StIdle
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) 'StIdle st'
    -> Peer (ChainSync header point tip) 'AsServer st' m a)
-> Peer (ChainSync header point tip) 'AsServer 'StIdle 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 (ClientHasAgency 'StIdle -> PeerHasAgency '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) ((forall (st' :: ChainSync header point tip).
  Message (ChainSync header point tip) 'StIdle st'
  -> Peer (ChainSync header point tip) 'AsServer st' m a)
 -> Peer (ChainSync header point tip) 'AsServer 'StIdle m a)
-> (forall (st' :: ChainSync header point tip).
    Message (ChainSync header point tip) 'StIdle st'
    -> Peer (ChainSync header point tip) 'AsServer st' m a)
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ \Message (ChainSync header point tip) 'StIdle st'
req ->
    case Message (ChainSync header point tip) 'StIdle st'
req of
      Message (ChainSync header point tip) 'StIdle st'
MsgRequestNext -> m (Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a)
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) 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) 'AsServer ('StNext 'StCanAwait) m a)
 -> Peer
      (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a)
-> m (Peer
        (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a)
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a
forall a b. (a -> b) -> a -> b
$ do
        Either
  (ServerStNext header point tip m a)
  (m (ServerStNext header point tip m a))
mresp <- m (Either
     (ServerStNext header point tip m a)
     (m (ServerStNext header point tip m a)))
recvMsgRequestNext
        Peer
  (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a
-> m (Peer
        (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer
   (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a
 -> m (Peer
         (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a))
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a
-> m (Peer
        (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a)
forall a b. (a -> b) -> a -> b
$ case Either
  (ServerStNext header point tip m a)
  (m (ServerStNext header point tip m a))
mresp of
          Left  ServerStNext header point tip m a
resp    -> TokNextKind 'StCanAwait
-> ServerStNext header point tip m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a
forall (nextKind :: StNextKind).
TokNextKind nextKind
-> ServerStNext header point tip m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext nextKind) m a
handleStNext TokNextKind 'StCanAwait
TokCanAwait ServerStNext header point tip m a
resp
          Right m (ServerStNext header point tip m a)
waiting -> WeHaveAgency 'AsServer ('StNext 'StCanAwait)
-> Message
     (ChainSync header point tip)
     ('StNext 'StCanAwait)
     ('StNext 'StMustReply)
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) 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 (ServerHasAgency ('StNext 'StCanAwait)
-> WeHaveAgency '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))
                                 Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
forall k k k (header :: k) (point :: k) (tip :: k).
Message
  (ChainSync header point tip)
  ('StNext 'StCanAwait)
  ('StNext 'StMustReply)
MsgAwaitReply (Peer
   (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
 -> Peer
      (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a)
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StCanAwait) m a
forall a b. (a -> b) -> a -> b
$ m (Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a)
-> Peer
     (ChainSync header point tip) 'AsServer ('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) 'AsServer ('StNext 'StMustReply) m a)
 -> Peer
      (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a)
-> m (Peer
        (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a)
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
forall a b. (a -> b) -> a -> b
$ do
                             ServerStNext header point tip m a
resp <- m (ServerStNext header point tip m a)
waiting
                             Peer
  (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
-> m (Peer
        (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer
   (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
 -> m (Peer
         (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a))
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
-> m (Peer
        (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a)
forall a b. (a -> b) -> a -> b
$ TokNextKind 'StMustReply
-> ServerStNext header point tip m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext 'StMustReply) m a
forall (nextKind :: StNextKind).
TokNextKind nextKind
-> ServerStNext header point tip m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext nextKind) m a
handleStNext TokNextKind 'StMustReply
TokMustReply ServerStNext header point tip m a
resp

      MsgFindIntersect points -> m (Peer (ChainSync header point tip) 'AsServer 'StIntersect m a)
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect 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) 'AsServer 'StIntersect m a)
 -> Peer (ChainSync header point tip) 'AsServer 'StIntersect m a)
-> m (Peer (ChainSync header point tip) 'AsServer 'StIntersect m a)
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect m a
forall a b. (a -> b) -> a -> b
$ do
        ServerStIntersect header point tip m a
resp <- [point] -> m (ServerStIntersect header point tip m a)
recvMsgFindIntersect [point]
[point]
points
        Peer (ChainSync header point tip) 'AsServer 'StIntersect m a
-> m (Peer (ChainSync header point tip) 'AsServer 'StIntersect m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer (ChainSync header point tip) 'AsServer 'StIntersect m a
 -> m (Peer
         (ChainSync header point tip) 'AsServer 'StIntersect m a))
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect m a
-> m (Peer (ChainSync header point tip) 'AsServer 'StIntersect m a)
forall a b. (a -> b) -> a -> b
$ ServerStIntersect header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect m a
handleStIntersect ServerStIntersect header point tip m a
resp

      Message (ChainSync header point tip) 'StIdle st'
MsgDone -> m (Peer (ChainSync header point tip) 'AsServer 'StDone m a)
-> Peer (ChainSync header point tip) 'AsServer 'StDone 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) 'AsServer 'StDone m a)
 -> Peer (ChainSync header point tip) 'AsServer 'StDone m a)
-> m (Peer (ChainSync header point tip) 'AsServer 'StDone m a)
-> Peer (ChainSync header point tip) 'AsServer 'StDone m a
forall a b. (a -> b) -> a -> b
$ (a -> Peer (ChainSync header point tip) 'AsServer 'StDone m a)
-> m a
-> m (Peer (ChainSync header point tip) 'AsServer 'StDone m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NobodyHasAgency 'StDone
-> a -> Peer (ChainSync header point tip) 'AsServer '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) m a
recvMsgDoneClient

  where
    handleStNext
      :: TokNextKind nextKind
      -> ServerStNext header point tip m a
      -> Peer (ChainSync header point tip) AsServer (StNext nextKind) m a

    handleStNext :: TokNextKind nextKind
-> ServerStNext header point tip m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext nextKind) m a
handleStNext TokNextKind nextKind
toknextkind (SendMsgRollForward  header
header tip
tip ChainSyncServer header point tip m a
next) =
      WeHaveAgency 'AsServer ('StNext nextKind)
-> Message (ChainSync header point tip) ('StNext nextKind) 'StIdle
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext nextKind) 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 (ServerHasAgency ('StNext nextKind)
-> WeHaveAgency 'AsServer ('StNext nextKind)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokNextKind nextKind -> ServerHasAgency ('StNext nextKind)
forall k k k (header :: k) (point :: k) (tip :: k)
       (k :: StNextKind).
TokNextKind k -> ServerHasAgency ('StNext k)
TokNext TokNextKind nextKind
toknextkind))
            (header
-> tip
-> Message (ChainSync header point tip) ('StNext nextKind) 'StIdle
forall k header tip (point :: k) (any :: StNextKind).
header
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollForward header
header tip
tip)
            (ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer ChainSyncServer header point tip m a
next)

    handleStNext TokNextKind nextKind
toknextkind (SendMsgRollBackward point
pIntersect tip
tip ChainSyncServer header point tip m a
next) =
      WeHaveAgency 'AsServer ('StNext nextKind)
-> Message (ChainSync header point tip) ('StNext nextKind) 'StIdle
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
-> Peer
     (ChainSync header point tip) 'AsServer ('StNext nextKind) 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 (ServerHasAgency ('StNext nextKind)
-> WeHaveAgency 'AsServer ('StNext nextKind)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokNextKind nextKind -> ServerHasAgency ('StNext nextKind)
forall k k k (header :: k) (point :: k) (tip :: k)
       (k :: StNextKind).
TokNextKind k -> ServerHasAgency ('StNext k)
TokNext TokNextKind nextKind
toknextkind))
            (point
-> tip
-> Message (ChainSync header point tip) ('StNext nextKind) 'StIdle
forall k point tip (header :: k) (any :: StNextKind).
point
-> tip
-> Message (ChainSync header point tip) ('StNext any) 'StIdle
MsgRollBackward point
pIntersect tip
tip)
            (ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer ChainSyncServer header point tip m a
next)


    handleStIntersect
      :: ServerStIntersect header point tip m a
      -> Peer (ChainSync header point tip) AsServer StIntersect m a

    handleStIntersect :: ServerStIntersect header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect m a
handleStIntersect (SendMsgIntersectFound point
pIntersect tip
tip ChainSyncServer header point tip m a
next) =
      WeHaveAgency 'AsServer 'StIntersect
-> Message (ChainSync header point tip) 'StIntersect 'StIdle
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect 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 (ServerHasAgency 'StIntersect -> WeHaveAgency '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)
            (point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall k point tip (header :: k).
point
-> tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectFound point
pIntersect tip
tip)
            (ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer ChainSyncServer header point tip m a
next)

    handleStIntersect (SendMsgIntersectNotFound tip
tip ChainSyncServer header point tip m a
next) =
      WeHaveAgency 'AsServer 'StIntersect
-> Message (ChainSync header point tip) 'StIntersect 'StIdle
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
-> Peer (ChainSync header point tip) 'AsServer 'StIntersect 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 (ServerHasAgency 'StIntersect -> WeHaveAgency '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)
            (tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
forall k k tip (header :: k) (point :: k).
tip -> Message (ChainSync header point tip) 'StIntersect 'StIdle
MsgIntersectNotFound tip
tip)
            (ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer ChainSyncServer header point tip m a
next)