{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

module Ouroboros.Consensus.MiniProtocol.ChainSync.Server
  ( chainSyncHeadersServer
  , chainSyncBlocksServer
  , Tip
    -- * Trace events
  , TraceChainSyncServerEvent (..)
  ) where

import           Control.Tracer

import           Ouroboros.Network.Block (ChainUpdate (..), Serialised,
                     Tip (..))
import           Ouroboros.Network.Protocol.ChainSync.Server

import           Ouroboros.Consensus.Storage.ChainDB.API (ChainDB, Reader,
                     WithPoint (..), getSerialisedBlockWithPoint,
                     getSerialisedHeaderWithPoint)
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import           Ouroboros.Consensus.Storage.Serialisation

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)

-- | Chain Sync Server for block headers for a given a 'ChainDB'.
--
-- The node-to-node protocol uses the chain sync mini-protocol with chain
-- headers (and fetches blocks separately with the block fetch mini-protocol).
--
chainSyncHeadersServer
    :: forall m blk.
       ( IOLike m
       , HasHeader (Header blk)
       )
    => Tracer m (TraceChainSyncServerEvent blk)
    -> ChainDB m blk
    -> NodeToNodeVersion
    -> ResourceRegistry m
    -> ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
chainSyncHeadersServer :: Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
chainSyncHeadersServer Tracer m (TraceChainSyncServerEvent blk)
tracer ChainDB m blk
chainDB NodeToNodeVersion
_version ResourceRegistry m
registry =
    m (ServerStIdle (SerialisedHeader blk) (Point blk) (Tip blk) m ())
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
forall header point tip (m :: * -> *) a.
m (ServerStIdle header point tip m a)
-> ChainSyncServer header point tip m a
ChainSyncServer (m (ServerStIdle (SerialisedHeader blk) (Point blk) (Tip blk) m ())
 -> ChainSyncServer
      (SerialisedHeader blk) (Point blk) (Tip blk) m ())
-> m (ServerStIdle
        (SerialisedHeader blk) (Point blk) (Tip blk) m ())
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
forall a b. (a -> b) -> a -> b
$ do
      Reader m blk (WithPoint blk (SerialisedHeader blk))
rdr <- ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk (WithPoint blk (SerialisedHeader blk))
-> m (Reader m blk (WithPoint blk (SerialisedHeader blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m -> BlockComponent blk b -> m (Reader m blk b)
ChainDB.newReader ChainDB m blk
chainDB ResourceRegistry m
registry BlockComponent blk (WithPoint blk (SerialisedHeader blk))
forall blk.
BlockComponent blk (WithPoint blk (SerialisedHeader blk))
getSerialisedHeaderWithPoint
      let ChainSyncServer m (ServerStIdle (SerialisedHeader blk) (Point blk) (Tip blk) m ())
server = Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Reader m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
forall (m :: * -> *) blk b.
(IOLike m, HasHeader (Header blk)) =>
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Reader m blk (WithPoint blk b)
-> ChainSyncServer b (Point blk) (Tip blk) m ()
chainSyncServerForReader Tracer m (TraceChainSyncServerEvent blk)
tracer ChainDB m blk
chainDB Reader m blk (WithPoint blk (SerialisedHeader blk))
rdr
      m (ServerStIdle (SerialisedHeader blk) (Point blk) (Tip blk) m ())
server

-- | Chain Sync Server for blocks for a given a 'ChainDB'.
--
-- The local node-to-client protocol uses the chain sync mini-protocol with
-- chains of full blocks (rather than a header \/ body split).
--
chainSyncBlocksServer
    :: forall m blk. (IOLike m, HasHeader (Header blk))
    => Tracer m (TraceChainSyncServerEvent blk)
    -> ChainDB m blk
    -> ResourceRegistry m
    -> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
chainSyncBlocksServer :: Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> ResourceRegistry m
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
chainSyncBlocksServer Tracer m (TraceChainSyncServerEvent blk)
tracer ChainDB m blk
chainDB ResourceRegistry m
registry =
    m (ServerStIdle (Serialised blk) (Point blk) (Tip blk) m ())
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
forall header point tip (m :: * -> *) a.
m (ServerStIdle header point tip m a)
-> ChainSyncServer header point tip m a
ChainSyncServer (m (ServerStIdle (Serialised blk) (Point blk) (Tip blk) m ())
 -> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ())
-> m (ServerStIdle (Serialised blk) (Point blk) (Tip blk) m ())
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
forall a b. (a -> b) -> a -> b
$ do
      Reader m blk (WithPoint blk (Serialised blk))
rdr <- ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk (WithPoint blk (Serialised blk))
-> m (Reader m blk (WithPoint blk (Serialised blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m -> BlockComponent blk b -> m (Reader m blk b)
ChainDB.newReader ChainDB m blk
chainDB ResourceRegistry m
registry BlockComponent blk (WithPoint blk (Serialised blk))
forall blk. BlockComponent blk (WithPoint blk (Serialised blk))
getSerialisedBlockWithPoint
      let ChainSyncServer m (ServerStIdle (Serialised blk) (Point blk) (Tip blk) m ())
server = Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Reader m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
forall (m :: * -> *) blk b.
(IOLike m, HasHeader (Header blk)) =>
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Reader m blk (WithPoint blk b)
-> ChainSyncServer b (Point blk) (Tip blk) m ()
chainSyncServerForReader Tracer m (TraceChainSyncServerEvent blk)
tracer ChainDB m blk
chainDB Reader m blk (WithPoint blk (Serialised blk))
rdr
      m (ServerStIdle (Serialised blk) (Point blk) (Tip blk) m ())
server

-- | A chain sync server.
--
-- This is a version of
-- 'Ouroboros.Network.Protocol.ChainSync.Examples.chainSyncServerExample' that
-- uses a 'chainDB' and a 'Reader' instead of
-- 'Ourboros.Network.ChainProducerState.ChainProducerState'.
--
-- All the hard work is done by the 'Reader's provided by the 'ChainDB'.
--
chainSyncServerForReader
    :: forall m blk b.
       ( IOLike m
       , HasHeader (Header blk)
       )
    => Tracer m (TraceChainSyncServerEvent blk)
    -> ChainDB m blk
    -> Reader  m blk (WithPoint blk b)
    -> ChainSyncServer b (Point blk) (Tip blk) m ()
chainSyncServerForReader :: Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Reader m blk (WithPoint blk b)
-> ChainSyncServer b (Point blk) (Tip blk) m ()
chainSyncServerForReader Tracer m (TraceChainSyncServerEvent blk)
tracer ChainDB m blk
chainDB Reader m blk (WithPoint blk b)
rdr =
    ChainSyncServer b (Point blk) (Tip blk) m ()
idle'
  where
    idle :: ServerStIdle b (Point blk) (Tip blk) m ()
    idle :: ServerStIdle b (Point blk) (Tip blk) m ()
idle = ServerStIdle :: forall header point tip (m :: * -> *) a.
m (Either
     (ServerStNext header point tip m a)
     (m (ServerStNext header point tip m a)))
-> ([point] -> m (ServerStIntersect header point tip m a))
-> m a
-> ServerStIdle header point tip m a
ServerStIdle {
        recvMsgRequestNext :: m (Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ())))
recvMsgRequestNext   = m (Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ())))
handleRequestNext,
        recvMsgFindIntersect :: [Point blk] -> m (ServerStIntersect b (Point blk) (Tip blk) m ())
recvMsgFindIntersect = [Point blk] -> m (ServerStIntersect b (Point blk) (Tip blk) m ())
handleFindIntersect,
        recvMsgDoneClient :: m ()
recvMsgDoneClient    = Reader m blk (WithPoint blk b) -> m ()
forall (m :: * -> *) blk a. Reader m blk a -> m ()
ChainDB.readerClose Reader m blk (WithPoint blk b)
rdr
      }

    idle' :: ChainSyncServer b (Point blk) (Tip blk) m ()
    idle' :: ChainSyncServer b (Point blk) (Tip blk) m ()
idle' = m (ServerStIdle b (Point blk) (Tip blk) m ())
-> ChainSyncServer b (Point blk) (Tip blk) m ()
forall header point tip (m :: * -> *) a.
m (ServerStIdle header point tip m a)
-> ChainSyncServer header point tip m a
ChainSyncServer (m (ServerStIdle b (Point blk) (Tip blk) m ())
 -> ChainSyncServer b (Point blk) (Tip blk) m ())
-> m (ServerStIdle b (Point blk) (Tip blk) m ())
-> ChainSyncServer b (Point blk) (Tip blk) m ()
forall a b. (a -> b) -> a -> b
$ ServerStIdle b (Point blk) (Tip blk) m ()
-> m (ServerStIdle b (Point blk) (Tip blk) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ServerStIdle b (Point blk) (Tip blk) m ()
idle

    handleRequestNext :: m (Either (ServerStNext b (Point blk) (Tip blk) m ())
                                (m (ServerStNext b (Point blk) (Tip blk) m ())))
    handleRequestNext :: m (Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ())))
handleRequestNext = Reader m blk (WithPoint blk b)
-> m (Maybe (ChainUpdate blk (WithPoint blk b)))
forall (m :: * -> *) blk a.
Reader m blk a -> m (Maybe (ChainUpdate blk a))
ChainDB.readerInstruction Reader m blk (WithPoint blk b)
rdr m (Maybe (ChainUpdate blk (WithPoint blk b)))
-> (Maybe (ChainUpdate blk (WithPoint blk b))
    -> m (Either
            (ServerStNext b (Point blk) (Tip blk) m ())
            (m (ServerStNext b (Point blk) (Tip blk) m ()))))
-> m (Either
        (ServerStNext b (Point blk) (Tip blk) m ())
        (m (ServerStNext b (Point blk) (Tip blk) m ())))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just ChainUpdate blk (WithPoint blk b)
update -> do
        Tip blk
tip <- STM m (Tip blk) -> m (Tip blk)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Tip blk) -> m (Tip blk)) -> STM m (Tip blk) -> m (Tip blk)
forall a b. (a -> b) -> a -> b
$ ChainDB m blk -> STM m (Tip blk)
forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (Tip blk)
ChainDB.getCurrentTip ChainDB m blk
chainDB
        Tracer m (TraceChainSyncServerEvent blk)
-> TraceChainSyncServerEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChainSyncServerEvent blk)
tracer (TraceChainSyncServerEvent blk -> m ())
-> TraceChainSyncServerEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$
          Tip blk
-> ChainUpdate blk (Point blk) -> TraceChainSyncServerEvent blk
forall blk.
Tip blk
-> ChainUpdate blk (Point blk) -> TraceChainSyncServerEvent blk
TraceChainSyncServerRead Tip blk
tip (WithPoint blk b -> Point blk
forall blk b. WithPoint blk b -> Point blk
point (WithPoint blk b -> Point blk)
-> ChainUpdate blk (WithPoint blk b) -> ChainUpdate blk (Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainUpdate blk (WithPoint blk b)
update)
        Either
  (ServerStNext b (Point blk) (Tip blk) m ())
  (m (ServerStNext b (Point blk) (Tip blk) m ()))
-> m (Either
        (ServerStNext b (Point blk) (Tip blk) m ())
        (m (ServerStNext b (Point blk) (Tip blk) m ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (ServerStNext b (Point blk) (Tip blk) m ())
   (m (ServerStNext b (Point blk) (Tip blk) m ()))
 -> m (Either
         (ServerStNext b (Point blk) (Tip blk) m ())
         (m (ServerStNext b (Point blk) (Tip blk) m ()))))
-> Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ()))
-> m (Either
        (ServerStNext b (Point blk) (Tip blk) m ())
        (m (ServerStNext b (Point blk) (Tip blk) m ())))
forall a b. (a -> b) -> a -> b
$ ServerStNext b (Point blk) (Tip blk) m ()
-> Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ()))
forall a b. a -> Either a b
Left (ServerStNext b (Point blk) (Tip blk) m ()
 -> Either
      (ServerStNext b (Point blk) (Tip blk) m ())
      (m (ServerStNext b (Point blk) (Tip blk) m ())))
-> ServerStNext b (Point blk) (Tip blk) m ()
-> Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ()))
forall a b. (a -> b) -> a -> b
$ Tip blk
-> ChainUpdate blk b -> ServerStNext b (Point blk) (Tip blk) m ()
sendNext Tip blk
tip (WithPoint blk b -> b
forall blk b. WithPoint blk b -> b
withoutPoint (WithPoint blk b -> b)
-> ChainUpdate blk (WithPoint blk b) -> ChainUpdate blk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainUpdate blk (WithPoint blk b)
update)
      Maybe (ChainUpdate blk (WithPoint blk b))
Nothing     -> Either
  (ServerStNext b (Point blk) (Tip blk) m ())
  (m (ServerStNext b (Point blk) (Tip blk) m ()))
-> m (Either
        (ServerStNext b (Point blk) (Tip blk) m ())
        (m (ServerStNext b (Point blk) (Tip blk) m ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   (ServerStNext b (Point blk) (Tip blk) m ())
   (m (ServerStNext b (Point blk) (Tip blk) m ()))
 -> m (Either
         (ServerStNext b (Point blk) (Tip blk) m ())
         (m (ServerStNext b (Point blk) (Tip blk) m ()))))
-> Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ()))
-> m (Either
        (ServerStNext b (Point blk) (Tip blk) m ())
        (m (ServerStNext b (Point blk) (Tip blk) m ())))
forall a b. (a -> b) -> a -> b
$ m (ServerStNext b (Point blk) (Tip blk) m ())
-> Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ()))
forall a b. b -> Either a b
Right (m (ServerStNext b (Point blk) (Tip blk) m ())
 -> Either
      (ServerStNext b (Point blk) (Tip blk) m ())
      (m (ServerStNext b (Point blk) (Tip blk) m ())))
-> m (ServerStNext b (Point blk) (Tip blk) m ())
-> Either
     (ServerStNext b (Point blk) (Tip blk) m ())
     (m (ServerStNext b (Point blk) (Tip blk) m ()))
forall a b. (a -> b) -> a -> b
$ do
        -- Reader is at the head, we have to block and wait for the chain to
        -- change.
        ChainUpdate blk (WithPoint blk b)
update <- Reader m blk (WithPoint blk b)
-> m (ChainUpdate blk (WithPoint blk b))
forall (m :: * -> *) blk a. Reader m blk a -> m (ChainUpdate blk a)
ChainDB.readerInstructionBlocking Reader m blk (WithPoint blk b)
rdr
        Tip blk
tip    <- STM m (Tip blk) -> m (Tip blk)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Tip blk) -> m (Tip blk)) -> STM m (Tip blk) -> m (Tip blk)
forall a b. (a -> b) -> a -> b
$ ChainDB m blk -> STM m (Tip blk)
forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (Tip blk)
ChainDB.getCurrentTip ChainDB m blk
chainDB
        Tracer m (TraceChainSyncServerEvent blk)
-> TraceChainSyncServerEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceChainSyncServerEvent blk)
tracer (TraceChainSyncServerEvent blk -> m ())
-> TraceChainSyncServerEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$
          Tip blk
-> ChainUpdate blk (Point blk) -> TraceChainSyncServerEvent blk
forall blk.
Tip blk
-> ChainUpdate blk (Point blk) -> TraceChainSyncServerEvent blk
TraceChainSyncServerReadBlocked Tip blk
tip (WithPoint blk b -> Point blk
forall blk b. WithPoint blk b -> Point blk
point (WithPoint blk b -> Point blk)
-> ChainUpdate blk (WithPoint blk b) -> ChainUpdate blk (Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainUpdate blk (WithPoint blk b)
update)
        ServerStNext b (Point blk) (Tip blk) m ()
-> m (ServerStNext b (Point blk) (Tip blk) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerStNext b (Point blk) (Tip blk) m ()
 -> m (ServerStNext b (Point blk) (Tip blk) m ()))
-> ServerStNext b (Point blk) (Tip blk) m ()
-> m (ServerStNext b (Point blk) (Tip blk) m ())
forall a b. (a -> b) -> a -> b
$ Tip blk
-> ChainUpdate blk b -> ServerStNext b (Point blk) (Tip blk) m ()
sendNext Tip blk
tip (WithPoint blk b -> b
forall blk b. WithPoint blk b -> b
withoutPoint (WithPoint blk b -> b)
-> ChainUpdate blk (WithPoint blk b) -> ChainUpdate blk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainUpdate blk (WithPoint blk b)
update)

    sendNext :: Tip blk
             -> ChainUpdate blk b
             -> ServerStNext b (Point blk) (Tip blk) m ()
    sendNext :: Tip blk
-> ChainUpdate blk b -> ServerStNext b (Point blk) (Tip blk) m ()
sendNext Tip blk
tip ChainUpdate blk b
update = case ChainUpdate blk b
update of
      AddBlock b
hdr -> b
-> Tip blk
-> ChainSyncServer b (Point blk) (Tip blk) m ()
-> ServerStNext b (Point blk) (Tip blk) m ()
forall header tip point (m :: * -> *) a.
header
-> tip
-> ChainSyncServer header point tip m a
-> ServerStNext header point tip m a
SendMsgRollForward  b
hdr Tip blk
tip ChainSyncServer b (Point blk) (Tip blk) m ()
idle'
      RollBack Point blk
pt  -> Point blk
-> Tip blk
-> ChainSyncServer b (Point blk) (Tip blk) m ()
-> ServerStNext b (Point blk) (Tip blk) m ()
forall point tip header (m :: * -> *) a.
point
-> tip
-> ChainSyncServer header point tip m a
-> ServerStNext header point tip m a
SendMsgRollBackward Point blk
pt Tip blk
tip ChainSyncServer b (Point blk) (Tip blk) m ()
idle'

    handleFindIntersect :: [Point blk]
                        -> m (ServerStIntersect b (Point blk) (Tip blk) m ())
    handleFindIntersect :: [Point blk] -> m (ServerStIntersect b (Point blk) (Tip blk) m ())
handleFindIntersect [Point blk]
points = do
      -- TODO guard number of points
      Maybe (Point blk)
changed <- Reader m blk (WithPoint blk b)
-> [Point blk] -> m (Maybe (Point blk))
forall (m :: * -> *) blk a.
Reader m blk a -> [Point blk] -> m (Maybe (Point blk))
ChainDB.readerForward Reader m blk (WithPoint blk b)
rdr [Point blk]
points
      Tip blk
tip     <- STM m (Tip blk) -> m (Tip blk)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Tip blk) -> m (Tip blk)) -> STM m (Tip blk) -> m (Tip blk)
forall a b. (a -> b) -> a -> b
$ ChainDB m blk -> STM m (Tip blk)
forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (Tip blk)
ChainDB.getCurrentTip ChainDB m blk
chainDB
      ServerStIntersect b (Point blk) (Tip blk) m ()
-> m (ServerStIntersect b (Point blk) (Tip blk) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerStIntersect b (Point blk) (Tip blk) m ()
 -> m (ServerStIntersect b (Point blk) (Tip blk) m ()))
-> ServerStIntersect b (Point blk) (Tip blk) m ()
-> m (ServerStIntersect b (Point blk) (Tip blk) m ())
forall a b. (a -> b) -> a -> b
$ case Maybe (Point blk)
changed of
        Just Point blk
pt -> Point blk
-> Tip blk
-> ChainSyncServer b (Point blk) (Tip blk) m ()
-> ServerStIntersect b (Point blk) (Tip blk) m ()
forall point tip header (m :: * -> *) a.
point
-> tip
-> ChainSyncServer header point tip m a
-> ServerStIntersect header point tip m a
SendMsgIntersectFound    Point blk
pt Tip blk
tip ChainSyncServer b (Point blk) (Tip blk) m ()
idle'
        Maybe (Point blk)
Nothing -> Tip blk
-> ChainSyncServer b (Point blk) (Tip blk) m ()
-> ServerStIntersect b (Point blk) (Tip blk) m ()
forall tip header point (m :: * -> *) a.
tip
-> ChainSyncServer header point tip m a
-> ServerStIntersect header point tip m a
SendMsgIntersectNotFound    Tip blk
tip ChainSyncServer b (Point blk) (Tip blk) m ()
idle'

{-------------------------------------------------------------------------------
  Trace events
-------------------------------------------------------------------------------}

-- | Events traced by the Chain Sync Server.
--
-- The whole headers/blocks in the traced 'ChainUpdate' are substituted with
-- their corresponding 'Point'.
data TraceChainSyncServerEvent blk
  = TraceChainSyncServerRead        (Tip blk) (ChainUpdate blk (Point blk))
  | TraceChainSyncServerReadBlocked (Tip blk) (ChainUpdate blk (Point blk))
  deriving (TraceChainSyncServerEvent blk
-> TraceChainSyncServerEvent blk -> Bool
(TraceChainSyncServerEvent blk
 -> TraceChainSyncServerEvent blk -> Bool)
-> (TraceChainSyncServerEvent blk
    -> TraceChainSyncServerEvent blk -> Bool)
-> Eq (TraceChainSyncServerEvent blk)
forall blk.
StandardHash blk =>
TraceChainSyncServerEvent blk
-> TraceChainSyncServerEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceChainSyncServerEvent blk
-> TraceChainSyncServerEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceChainSyncServerEvent blk
-> TraceChainSyncServerEvent blk -> Bool
== :: TraceChainSyncServerEvent blk
-> TraceChainSyncServerEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
TraceChainSyncServerEvent blk
-> TraceChainSyncServerEvent blk -> Bool
Eq, Int -> TraceChainSyncServerEvent blk -> ShowS
[TraceChainSyncServerEvent blk] -> ShowS
TraceChainSyncServerEvent blk -> String
(Int -> TraceChainSyncServerEvent blk -> ShowS)
-> (TraceChainSyncServerEvent blk -> String)
-> ([TraceChainSyncServerEvent blk] -> ShowS)
-> Show (TraceChainSyncServerEvent blk)
forall blk.
StandardHash blk =>
Int -> TraceChainSyncServerEvent blk -> ShowS
forall blk.
StandardHash blk =>
[TraceChainSyncServerEvent blk] -> ShowS
forall blk.
StandardHash blk =>
TraceChainSyncServerEvent blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceChainSyncServerEvent blk] -> ShowS
$cshowList :: forall blk.
StandardHash blk =>
[TraceChainSyncServerEvent blk] -> ShowS
show :: TraceChainSyncServerEvent blk -> String
$cshow :: forall blk.
StandardHash blk =>
TraceChainSyncServerEvent blk -> String
showsPrec :: Int -> TraceChainSyncServerEvent blk -> ShowS
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> TraceChainSyncServerEvent blk -> ShowS
Show)