{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

module Cardano.Protocol.Socket.Client where

import Control.Concurrent
import Control.Monad.Catch (Handler (..), SomeException (..))
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text, pack)
import GHC.Generics (Generic)

import Cardano.Api (BlockInMode (..), CardanoMode, ChainPoint (..), ChainTip (..), ConsensusModeParams (..),
                    LocalChainSyncClient (..), LocalNodeClientProtocols (..), LocalNodeClientProtocolsInMode,
                    LocalNodeConnectInfo (..), NetworkId, connectToLocalNode)
import Cardano.BM.Data.Trace (Trace)
import Cardano.BM.Data.Tracer (ToObject (..))
import Cardano.BM.Trace (logDebug, logWarning)
import Cardano.Node.Emulator.TimeSlot (SlotConfig, currentSlot)
import Control.Retry (fibonacciBackoff, recovering, skipAsyncExceptions)
import Control.Tracer (nullTracer)
import Ouroboros.Network.IOManager
import Ouroboros.Network.Protocol.ChainSync.Client qualified as ChainSync

import Cardano.Protocol.Socket.Type hiding (Tip)
import Ledger (Slot (..))
import Plutus.ChainIndex.Compatibility (fromCardanoPoint, fromCardanoTip)
import Plutus.ChainIndex.Types (Point, Tip)

data ChainSyncHandle event = ChainSyncHandle
    { ChainSyncHandle event -> IO Slot
cshCurrentSlot :: IO Slot
    , ChainSyncHandle event -> event -> Slot -> IO ()
cshHandler     :: event -> Slot -> IO ()
    }

data ChainSyncEvent =
    Resume       !ChainPoint
  | RollForward  !(BlockInMode CardanoMode) !ChainTip
  | RollBackward !ChainPoint !ChainTip

{- | The `Slot` parameter here represents the `current` slot as computed from the
     current time. There is also the slot where the block was published, which is
     available from the `ChainSyncEvent`.

     Currently we are using this current slot everywhere, which is why I leave it
     here, as a parameter.
-}
type ChainSyncCallback = ChainSyncEvent -> Slot -> IO ()

data ClientMsg =
    Disconnected Text
  | Resumed Point
  | RolledForward Tip
  | RolledBackward Point
  deriving stock (ClientMsg -> ClientMsg -> Bool
(ClientMsg -> ClientMsg -> Bool)
-> (ClientMsg -> ClientMsg -> Bool) -> Eq ClientMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientMsg -> ClientMsg -> Bool
$c/= :: ClientMsg -> ClientMsg -> Bool
== :: ClientMsg -> ClientMsg -> Bool
$c== :: ClientMsg -> ClientMsg -> Bool
Eq, Int -> ClientMsg -> ShowS
[ClientMsg] -> ShowS
ClientMsg -> String
(Int -> ClientMsg -> ShowS)
-> (ClientMsg -> String)
-> ([ClientMsg] -> ShowS)
-> Show ClientMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientMsg] -> ShowS
$cshowList :: [ClientMsg] -> ShowS
show :: ClientMsg -> String
$cshow :: ClientMsg -> String
showsPrec :: Int -> ClientMsg -> ShowS
$cshowsPrec :: Int -> ClientMsg -> ShowS
Show, (forall x. ClientMsg -> Rep ClientMsg x)
-> (forall x. Rep ClientMsg x -> ClientMsg) -> Generic ClientMsg
forall x. Rep ClientMsg x -> ClientMsg
forall x. ClientMsg -> Rep ClientMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientMsg x -> ClientMsg
$cfrom :: forall x. ClientMsg -> Rep ClientMsg x
Generic)
  deriving anyclass (Value -> Parser [ClientMsg]
Value -> Parser ClientMsg
(Value -> Parser ClientMsg)
-> (Value -> Parser [ClientMsg]) -> FromJSON ClientMsg
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClientMsg]
$cparseJSONList :: Value -> Parser [ClientMsg]
parseJSON :: Value -> Parser ClientMsg
$cparseJSON :: Value -> Parser ClientMsg
FromJSON, [ClientMsg] -> Encoding
[ClientMsg] -> Value
ClientMsg -> Encoding
ClientMsg -> Value
(ClientMsg -> Value)
-> (ClientMsg -> Encoding)
-> ([ClientMsg] -> Value)
-> ([ClientMsg] -> Encoding)
-> ToJSON ClientMsg
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClientMsg] -> Encoding
$ctoEncodingList :: [ClientMsg] -> Encoding
toJSONList :: [ClientMsg] -> Value
$ctoJSONList :: [ClientMsg] -> Value
toEncoding :: ClientMsg -> Encoding
$ctoEncoding :: ClientMsg -> Encoding
toJSON :: ClientMsg -> Value
$ctoJSON :: ClientMsg -> Value
ToJSON, TracingVerbosity -> ClientMsg -> Object
ClientMsg -> Object -> Text
(TracingVerbosity -> ClientMsg -> Object)
-> (ClientMsg -> Object -> Text) -> ToObject ClientMsg
forall a.
(TracingVerbosity -> a -> Object)
-> (a -> Object -> Text) -> ToObject a
textTransformer :: ClientMsg -> Object -> Text
$ctextTransformer :: ClientMsg -> Object -> Text
toObject :: TracingVerbosity -> ClientMsg -> Object
$ctoObject :: TracingVerbosity -> ClientMsg -> Object
ToObject)

getCurrentSlot
  :: forall block.
     ChainSyncHandle block
  -> IO Slot
getCurrentSlot :: ChainSyncHandle block -> IO Slot
getCurrentSlot = ChainSyncHandle block -> IO Slot
forall event. ChainSyncHandle event -> IO Slot
cshCurrentSlot

-- | Run the chain sync protocol to get access to the current slot number.
runChainSync'
  :: FilePath
  -> SlotConfig
  -> NetworkId
  -> [ChainPoint]
  -> IO (ChainSyncHandle ChainSyncEvent)
runChainSync' :: String
-> SlotConfig
-> NetworkId
-> [ChainPoint]
-> IO (ChainSyncHandle ChainSyncEvent)
runChainSync' String
socketPath SlotConfig
slotConfig NetworkId
networkId [ChainPoint]
resumePoints =
  String
-> Trace IO ClientMsg
-> SlotConfig
-> NetworkId
-> [ChainPoint]
-> (ChainSyncEvent -> IO ())
-> IO (ChainSyncHandle ChainSyncEvent)
runChainSync String
socketPath Trace IO ClientMsg
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer SlotConfig
slotConfig NetworkId
networkId [ChainPoint]
resumePoints (\ChainSyncEvent
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

runChainSync
  :: FilePath
  -> Trace IO ClientMsg
  -> SlotConfig
  -> NetworkId
  -> [ChainPoint]
  -> (ChainSyncEvent -> IO ())
  -> IO (ChainSyncHandle ChainSyncEvent)
runChainSync :: String
-> Trace IO ClientMsg
-> SlotConfig
-> NetworkId
-> [ChainPoint]
-> (ChainSyncEvent -> IO ())
-> IO (ChainSyncHandle ChainSyncEvent)
runChainSync String
socketPath Trace IO ClientMsg
trace SlotConfig
slotConfig NetworkId
networkId [ChainPoint]
resumePoints ChainSyncEvent -> IO ()
onChainSyncEvent = do
    let handle :: ChainSyncHandle ChainSyncEvent
handle = ChainSyncHandle :: forall event.
IO Slot -> (event -> Slot -> IO ()) -> ChainSyncHandle event
ChainSyncHandle {
          cshCurrentSlot :: IO Slot
cshCurrentSlot = SlotConfig -> IO Slot
currentSlot SlotConfig
slotConfig,
          cshHandler :: ChainSyncEvent -> Slot -> IO ()
cshHandler = ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler }

    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (IOManager -> IO ()) -> IO ()
WithIOManager
withIOManager ((IOManager -> IO ()) -> IO ()) -> (IOManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOManager
_ ->
           RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO ())
-> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering
             (Int -> RetryPolicyM IO
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
fibonacciBackoff Int
500)
             ([RetryStatus -> Handler IO Bool]
forall (m :: * -> *). MonadIO m => [RetryStatus -> Handler m Bool]
skipAsyncExceptions [RetryStatus -> Handler IO Bool]
-> [RetryStatus -> Handler IO Bool]
-> [RetryStatus -> Handler IO Bool]
forall a. [a] -> [a] -> [a]
++
               [(\RetryStatus
_ -> (SomeException -> IO Bool) -> Handler IO Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> IO Bool) -> Handler IO Bool)
-> (SomeException -> IO Bool) -> Handler IO Bool
forall a b. (a -> b) -> a -> b
$ \(SomeException
err :: SomeException) -> do
                   Trace IO ClientMsg -> ClientMsg -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logWarning Trace IO ClientMsg
trace (Text -> ClientMsg
Disconnected (Text -> ClientMsg) -> Text -> ClientMsg
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
err)
                   Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True )])
             (\RetryStatus
_ -> LocalNodeConnectInfo CardanoMode
-> LocalNodeClientProtocolsInMode CardanoMode -> IO ()
forall mode.
LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode
                      LocalNodeConnectInfo CardanoMode
localNodeConnectInfo
                      LocalNodeClientProtocolsInMode CardanoMode
localNodeClientProtocols)

    ChainSyncHandle ChainSyncEvent
-> IO (ChainSyncHandle ChainSyncEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainSyncHandle ChainSyncEvent
handle
    where
      chainSyncEventHandler :: ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler ChainSyncEvent
evt Slot
_ = ChainSyncEvent -> IO ()
onChainSyncEvent ChainSyncEvent
evt
      localNodeConnectInfo :: LocalNodeConnectInfo CardanoMode
localNodeConnectInfo = LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo {
        localConsensusModeParams :: ConsensusModeParams CardanoMode
localConsensusModeParams = EpochSlots -> ConsensusModeParams CardanoMode
CardanoModeParams EpochSlots
epochSlots,
        localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
networkId,
        localNodeSocketPath :: String
localNodeSocketPath = String
socketPath }
      localNodeClientProtocols :: LocalNodeClientProtocolsInMode CardanoMode
      localNodeClientProtocols :: LocalNodeClientProtocolsInMode CardanoMode
localNodeClientProtocols = LocalNodeClientProtocols :: forall block point tip slot tx txid txerr (query :: * -> *)
       (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> Maybe (LocalTxMonitorClient txid tx slot m ())
-> LocalNodeClientProtocols
     block point tip slot tx txid txerr query m
LocalNodeClientProtocols {
        localChainSyncClient :: LocalChainSyncClient
  (BlockInMode CardanoMode) ChainPoint ChainTip IO
localChainSyncClient =
          ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall block point tip (m :: * -> *).
ChainSyncClient block point tip m ()
-> LocalChainSyncClient block point tip m
LocalChainSyncClient (ChainSyncClient
   (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
 -> LocalChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO)
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall a b. (a -> b) -> a -> b
$
            Trace IO ClientMsg
-> SlotConfig
-> [ChainPoint]
-> (ChainSyncEvent -> Slot -> IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
chainSyncClient Trace IO ClientMsg
trace SlotConfig
slotConfig [ChainPoint]
resumePoints ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler,
        localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
forall a. Maybe a
Nothing,
        localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
localStateQueryClient = Maybe
  (LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
forall a. Maybe a
Nothing,
        localTxMonitoringClient :: Maybe
  (LocalTxMonitorClient
     (TxIdInMode CardanoMode) (TxInMode CardanoMode) SlotNo IO ())
localTxMonitoringClient = Maybe
  (LocalTxMonitorClient
     (TxIdInMode CardanoMode) (TxInMode CardanoMode) SlotNo IO ())
forall a. Maybe a
Nothing }

-- | The client updates the application state when the protocol state changes.
chainSyncClient
  :: Trace IO ClientMsg
  -> SlotConfig
  -> [ChainPoint]
  -> ChainSyncCallback
  -> ChainSync.ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
chainSyncClient :: Trace IO ClientMsg
-> SlotConfig
-> [ChainPoint]
-> (ChainSyncEvent -> Slot -> IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
chainSyncClient Trace IO ClientMsg
trace SlotConfig
slotConfig [] ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler =
  Trace IO ClientMsg
-> SlotConfig
-> [ChainPoint]
-> (ChainSyncEvent -> Slot -> IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
chainSyncClient Trace IO ClientMsg
trace SlotConfig
slotConfig [ChainPoint
ChainPointAtGenesis] ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler
chainSyncClient Trace IO ClientMsg
trace SlotConfig
slotConfig [ChainPoint]
resumePoints ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler =
    IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSync.ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
initialise
    where
      initialise :: ChainSync.ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
      initialise :: ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
initialise =
        [ChainPoint]
-> ClientStIntersect
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall point header tip (m :: * -> *) a.
[point]
-> ClientStIntersect header point tip m a
-> ClientStIdle header point tip m a
ChainSync.SendMsgFindIntersect [ChainPoint]
resumePoints (ClientStIntersect
   (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
 -> ClientStIdle
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ClientStIntersect
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$
          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
ChainSync.ClientStIntersect {
            recvMsgIntersectFound :: ChainPoint
-> ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
ChainSync.recvMsgIntersectFound    =
              \ChainPoint
chainPoint ChainTip
_ ->
                 IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSync.ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
                   Slot
slot <- SlotConfig -> IO Slot
currentSlot SlotConfig
slotConfig
                   Trace IO ClientMsg -> ClientMsg -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logDebug Trace IO ClientMsg
trace (Point -> ClientMsg
Resumed (Point -> ClientMsg) -> Point -> ClientMsg
forall a b. (a -> b) -> a -> b
$ ChainPoint -> Point
fromCardanoPoint ChainPoint
chainPoint)
                   ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler (ChainPoint -> ChainSyncEvent
Resume ChainPoint
chainPoint) Slot
slot
                   ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
requestNext,
            recvMsgIntersectNotFound :: ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
ChainSync.recvMsgIntersectNotFound =
              \ChainTip
_   -> IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSync.ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
requestNext
          }

      requestNext :: ChainSync.ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
      requestNext :: ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
requestNext =
        ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
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
ChainSync.SendMsgRequestNext
          ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
handleNext
          (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
handleNext)

      handleNext :: ChainSync.ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
      handleNext :: ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
handleNext =
        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
ChainSync.ClientStNext
        {
          recvMsgRollForward :: BlockInMode CardanoMode
-> ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
ChainSync.recvMsgRollForward  = \BlockInMode CardanoMode
block ChainTip
tip ->
            IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSync.ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
              Slot
slot <- SlotConfig -> IO Slot
currentSlot SlotConfig
slotConfig
              Trace IO ClientMsg -> ClientMsg -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logDebug Trace IO ClientMsg
trace (Tip -> ClientMsg
RolledForward (Tip -> ClientMsg) -> Tip -> ClientMsg
forall a b. (a -> b) -> a -> b
$ ChainTip -> Tip
fromCardanoTip ChainTip
tip)
              ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler (BlockInMode CardanoMode -> ChainTip -> ChainSyncEvent
RollForward BlockInMode CardanoMode
block ChainTip
tip) Slot
slot
              ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
requestNext
        , recvMsgRollBackward :: ChainPoint
-> ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
ChainSync.recvMsgRollBackward = \ChainPoint
point ChainTip
tip ->
            IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSync.ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
              Slot
slot <- SlotConfig -> IO Slot
currentSlot SlotConfig
slotConfig
              Trace IO ClientMsg -> ClientMsg -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logDebug Trace IO ClientMsg
trace (Point -> ClientMsg
RolledBackward (Point -> ClientMsg) -> Point -> ClientMsg
forall a b. (a -> b) -> a -> b
$ ChainPoint -> Point
fromCardanoPoint ChainPoint
point)
              ChainSyncEvent -> Slot -> IO ()
chainSyncEventHandler (ChainPoint -> ChainTip -> ChainSyncEvent
RollBackward ChainPoint
point ChainTip
tip) Slot
slot
              ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
requestNext
        }