{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Cardano.Node.Mock where

import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar (MVar, modifyMVar_, putMVar, takeMVar)
import Control.Lens (over, set, unto, view)
import Control.Monad (forever, void)
import Control.Monad.Freer (Eff, LastMember, Member, interpret, reinterpret, runM)
import Control.Monad.Freer.Extras.Log
import Control.Monad.Freer.Extras.Modify (handleZoomedState)
import Control.Monad.Freer.Reader (Reader)
import Control.Monad.Freer.Reader qualified as Eff
import Control.Monad.Freer.State qualified as Eff
import Control.Monad.Freer.Writer qualified as Eff
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Foldable (traverse_)
import Data.Function ((&))
import Data.Time.Units (Millisecond, toMicroseconds)
import Data.Time.Units.Extra ()
import Servant (NoContent (NoContent))

import Cardano.Api qualified as C
import Cardano.BM.Data.Trace (Trace)
import Cardano.Chain (handleChain, handleControlChain)
import Cardano.Node.Emulator.Chain qualified as Chain
import Cardano.Node.Emulator.Params (Params (..))
import Cardano.Node.Emulator.TimeSlot (SlotConfig (SlotConfig, scSlotLength), currentSlot)
import Cardano.Node.Types
import Cardano.Protocol.Socket.Mock.Client qualified as Client
import Cardano.Protocol.Socket.Mock.Server qualified as Server
import Plutus.PAB.Arbitrary ()
import Plutus.PAB.Monitoring.Monitoring qualified as LM

healthcheck :: Monad m => m NoContent
healthcheck :: m NoContent
healthcheck = NoContent -> m NoContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent

consumeEventHistory :: MonadIO m => MVar AppState -> m [LogMessage PABServerLogMsg]
consumeEventHistory :: MVar AppState -> m [LogMessage PABServerLogMsg]
consumeEventHistory MVar AppState
stateVar =
    IO [LogMessage PABServerLogMsg] -> m [LogMessage PABServerLogMsg]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [LogMessage PABServerLogMsg] -> m [LogMessage PABServerLogMsg])
-> IO [LogMessage PABServerLogMsg]
-> m [LogMessage PABServerLogMsg]
forall a b. (a -> b) -> a -> b
$ do
        AppState
oldState <- MVar AppState -> IO AppState
forall a. MVar a -> IO a
takeMVar MVar AppState
stateVar
        let events :: [LogMessage PABServerLogMsg]
events = Getting
  [LogMessage PABServerLogMsg] AppState [LogMessage PABServerLogMsg]
-> AppState -> [LogMessage PABServerLogMsg]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [LogMessage PABServerLogMsg] AppState [LogMessage PABServerLogMsg]
Lens' AppState [LogMessage PABServerLogMsg]
eventHistory AppState
oldState
        let newState :: AppState
newState = ASetter
  AppState
  AppState
  [LogMessage PABServerLogMsg]
  [LogMessage PABServerLogMsg]
-> [LogMessage PABServerLogMsg] -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  AppState
  AppState
  [LogMessage PABServerLogMsg]
  [LogMessage PABServerLogMsg]
Lens' AppState [LogMessage PABServerLogMsg]
eventHistory [LogMessage PABServerLogMsg]
forall a. Monoid a => a
mempty AppState
oldState
        MVar AppState -> AppState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar AppState
stateVar AppState
newState
        [LogMessage PABServerLogMsg] -> IO [LogMessage PABServerLogMsg]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LogMessage PABServerLogMsg]
events

addTx ::
    ( Member (LogMsg PABServerLogMsg) effs
    , Member (Reader (Maybe Client.TxSendHandle)) effs
    , MonadIO m
    , LastMember m effs
    )
 => C.Tx C.BabbageEra -> Eff effs NoContent
addTx :: Tx BabbageEra -> Eff effs NoContent
addTx Tx BabbageEra
tx = do
    PABServerLogMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo (PABServerLogMsg -> Eff effs ()) -> PABServerLogMsg -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ BlockEvent -> PABServerLogMsg
BlockOperation (BlockEvent -> PABServerLogMsg) -> BlockEvent -> PABServerLogMsg
forall a b. (a -> b) -> a -> b
$ Tx BabbageEra -> BlockEvent
NewTransaction Tx BabbageEra
tx
    Maybe TxSendHandle
clientHandler <- Eff effs (Maybe TxSendHandle)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
Eff.ask
    case Maybe TxSendHandle
clientHandler of
      Maybe TxSendHandle
Nothing      -> PABServerLogMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logError PABServerLogMsg
TxSendCalledWithoutMock
      Just TxSendHandle
handler ->
          IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ TxSendHandle -> Tx BabbageEra -> IO ()
Client.queueTx TxSendHandle
handler Tx BabbageEra
tx
    NoContent -> Eff effs NoContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent

-- | Run all chain effects in the IO Monad
runChainEffects ::
 Trace IO PABServerLogMsg
 -> Params
 -> Maybe Client.TxSendHandle
 -> MVar AppState
 -> Eff (NodeServerEffects IO) a
 -> IO ([LogMessage PABServerLogMsg], a)
runChainEffects :: Trace IO PABServerLogMsg
-> Params
-> Maybe TxSendHandle
-> MVar AppState
-> Eff (NodeServerEffects IO) a
-> IO ([LogMessage PABServerLogMsg], a)
runChainEffects Trace IO PABServerLogMsg
trace Params
params Maybe TxSendHandle
clientHandler MVar AppState
stateVar Eff (NodeServerEffects IO) a
eff = do
    AppState
oldAppState <- IO AppState -> IO AppState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppState -> IO AppState) -> IO AppState -> IO AppState
forall a b. (a -> b) -> a -> b
$ MVar AppState -> IO AppState
forall a. MVar a -> IO a
takeMVar MVar AppState
stateVar
    ((a
a, [LogMessage PABServerLogMsg]
events), AppState
newState) <- IO ((a, [LogMessage PABServerLogMsg]), AppState)
-> IO ((a, [LogMessage PABServerLogMsg]), AppState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            (IO ((a, [LogMessage PABServerLogMsg]), AppState)
 -> IO ((a, [LogMessage PABServerLogMsg]), AppState))
-> IO ((a, [LogMessage PABServerLogMsg]), AppState)
-> IO ((a, [LogMessage PABServerLogMsg]), AppState)
forall a b. (a -> b) -> a -> b
$ Eff (NodeServerEffects IO) a -> Eff (NodeServerEffects IO) a
forall (effs :: [* -> *]) b.
FindElem ChainControlEffect effs =>
Eff effs b -> Eff effs b
processBlock Eff (NodeServerEffects IO) a
eff
            Eff (NodeServerEffects IO) a
-> (Eff (NodeServerEffects IO) a
    -> Eff
         '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
           Reader (Maybe TxSendHandle), State AppState,
           LogMsg PABServerLogMsg, IO]
         a)
-> Eff
     '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
       Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     a
forall a b. a -> (a -> b) -> b
& Eff (NodeServerEffects IO) a
-> Eff
     '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
       Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     a
runChain
            Eff
  '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
    Reader (Maybe TxSendHandle), State AppState,
    LogMsg PABServerLogMsg, IO]
  a
-> (Eff
      '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
        Reader (Maybe TxSendHandle), State AppState,
        LogMsg PABServerLogMsg, IO]
      a
    -> Eff
         '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
           State AppState, LogMsg PABServerLogMsg, IO]
         a)
-> Eff
     '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     a
forall a b. a -> (a -> b) -> b
& Eff
  '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
    Reader (Maybe TxSendHandle), State AppState,
    LogMsg PABServerLogMsg, IO]
  a
-> Eff
     '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     a
forall x.
Eff
  '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
    Reader (Maybe TxSendHandle), State AppState,
    LogMsg PABServerLogMsg, IO]
  x
-> Eff
     '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     x
mergeState
            Eff
  '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
    State AppState, LogMsg PABServerLogMsg, IO]
  a
-> (Eff
      '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO]
      a
    -> Eff
         '[Reader (Maybe TxSendHandle), State AppState,
           LogMsg PABServerLogMsg, IO]
         (a, [LogMessage PABServerLogMsg]))
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
forall a b. a -> (a -> b) -> b
& Eff
  '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
    State AppState, LogMsg PABServerLogMsg, IO]
  a
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
forall a.
Eff
  '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
    State AppState, LogMsg PABServerLogMsg, IO]
  a
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
toWriter
            Eff
  '[Reader (Maybe TxSendHandle), State AppState,
    LogMsg PABServerLogMsg, IO]
  (a, [LogMessage PABServerLogMsg])
-> (Eff
      '[Reader (Maybe TxSendHandle), State AppState,
        LogMsg PABServerLogMsg, IO]
      (a, [LogMessage PABServerLogMsg])
    -> Eff
         '[LogMsg PABServerLogMsg, IO]
         ((a, [LogMessage PABServerLogMsg]), AppState))
-> Eff
     '[LogMsg PABServerLogMsg, IO]
     ((a, [LogMessage PABServerLogMsg]), AppState)
forall a b. a -> (a -> b) -> b
& AppState
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
-> Eff
     '[LogMsg PABServerLogMsg, IO]
     ((a, [LogMessage PABServerLogMsg]), AppState)
runReaders AppState
oldAppState
            Eff
  '[LogMsg PABServerLogMsg, IO]
  ((a, [LogMessage PABServerLogMsg]), AppState)
-> (Eff
      '[LogMsg PABServerLogMsg, IO]
      ((a, [LogMessage PABServerLogMsg]), AppState)
    -> Eff '[IO] ((a, [LogMessage PABServerLogMsg]), AppState))
-> Eff '[IO] ((a, [LogMessage PABServerLogMsg]), AppState)
forall a b. a -> (a -> b) -> b
& (LogMsg PABServerLogMsg ~> Eff '[IO])
-> Eff '[LogMsg PABServerLogMsg, IO] ~> Eff '[IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO PABServerLogMsg -> LogMsg PABServerLogMsg ~> Eff '[IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO PABServerLogMsg
trace)
            Eff '[IO] ((a, [LogMessage PABServerLogMsg]), AppState)
-> (Eff '[IO] ((a, [LogMessage PABServerLogMsg]), AppState)
    -> IO ((a, [LogMessage PABServerLogMsg]), AppState))
-> IO ((a, [LogMessage PABServerLogMsg]), AppState)
forall a b. a -> (a -> b) -> b
& Eff '[IO] ((a, [LogMessage PABServerLogMsg]), AppState)
-> IO ((a, [LogMessage PABServerLogMsg]), AppState)
forall (m :: * -> *) a. Monad m => Eff '[m] a -> m a
runM
    IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar AppState -> AppState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar AppState
stateVar AppState
newState
    ([LogMessage PABServerLogMsg], a)
-> IO ([LogMessage PABServerLogMsg], a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LogMessage PABServerLogMsg]
events, a
a)
        where
            processBlock :: Eff effs b -> Eff effs b
processBlock Eff effs b
e = Eff effs b
e Eff effs b -> (b -> Eff effs b) -> Eff effs b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Eff effs Block
forall (effs :: [* -> *]).
Member ChainControlEffect effs =>
Eff effs Block
Chain.processBlock Eff effs Block -> Eff effs b -> Eff effs b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Eff effs b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r

            runChain :: Eff (NodeServerEffects IO) a
-> Eff
     '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
       Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     a
runChain = (LogMsg ChainEvent
 ~> Eff
      '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
        Reader (Maybe TxSendHandle), State AppState,
        LogMsg PABServerLogMsg, IO])
-> Eff
     '[LogMsg ChainEvent, State MockNodeServerChainState,
       LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
   ~> Eff
        '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
          Reader (Maybe TxSendHandle), State AppState,
          LogMsg PABServerLogMsg, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((ChainEvent -> PABServerLogMsg)
-> LogMsg ChainEvent
   ~> Eff
        '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
          Reader (Maybe TxSendHandle), State AppState,
          LogMsg PABServerLogMsg, IO]
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog ChainEvent -> PABServerLogMsg
ProcessingChainEvent)
                     (Eff
   '[LogMsg ChainEvent, State MockNodeServerChainState,
     LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
     State AppState, LogMsg PABServerLogMsg, IO]
   a
 -> Eff
      '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
        Reader (Maybe TxSendHandle), State AppState,
        LogMsg PABServerLogMsg, IO]
      a)
-> (Eff (NodeServerEffects IO) a
    -> Eff
         '[LogMsg ChainEvent, State MockNodeServerChainState,
           LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
           State AppState, LogMsg PABServerLogMsg, IO]
         a)
-> Eff (NodeServerEffects IO) a
-> Eff
     '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
       Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEffect
 ~> Eff
      '[LogMsg ChainEvent, State MockNodeServerChainState,
        LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO])
-> Eff
     '[ChainEffect, State MockNodeServerChainState,
       LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
   ~> Eff
        '[LogMsg ChainEvent, State MockNodeServerChainState,
          LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (Params
-> ChainEffect
   ~> Eff
        '[LogMsg ChainEvent, State MockNodeServerChainState,
          LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall (effs :: [* -> *]).
Member (State MockNodeServerChainState) effs =>
Params -> ChainEffect ~> Eff effs
handleChain Params
params)
                     (Eff
   '[ChainEffect, State MockNodeServerChainState,
     LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
     State AppState, LogMsg PABServerLogMsg, IO]
   a
 -> Eff
      '[LogMsg ChainEvent, State MockNodeServerChainState,
        LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO]
      a)
-> (Eff (NodeServerEffects IO) a
    -> Eff
         '[ChainEffect, State MockNodeServerChainState,
           LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
           State AppState, LogMsg PABServerLogMsg, IO]
         a)
-> Eff (NodeServerEffects IO) a
-> Eff
     '[LogMsg ChainEvent, State MockNodeServerChainState,
       LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg ChainEvent
 ~> Eff
      '[ChainEffect, State MockNodeServerChainState,
        LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO])
-> Eff
     '[LogMsg ChainEvent, ChainEffect, State MockNodeServerChainState,
       LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
   ~> Eff
        '[ChainEffect, State MockNodeServerChainState,
          LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((ChainEvent -> PABServerLogMsg)
-> LogMsg ChainEvent
   ~> Eff
        '[ChainEffect, State MockNodeServerChainState,
          LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog ChainEvent -> PABServerLogMsg
ProcessingChainEvent)
                     (Eff
   '[LogMsg ChainEvent, ChainEffect, State MockNodeServerChainState,
     LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
     State AppState, LogMsg PABServerLogMsg, IO]
   a
 -> Eff
      '[ChainEffect, State MockNodeServerChainState,
        LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO]
      a)
-> (Eff (NodeServerEffects IO) a
    -> Eff
         '[LogMsg ChainEvent, ChainEffect, State MockNodeServerChainState,
           LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
           State AppState, LogMsg PABServerLogMsg, IO]
         a)
-> Eff (NodeServerEffects IO) a
-> Eff
     '[ChainEffect, State MockNodeServerChainState,
       LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainControlEffect
 ~> Eff
      '[LogMsg ChainEvent, ChainEffect, State MockNodeServerChainState,
        LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO])
-> Eff (NodeServerEffects IO)
   ~> Eff
        '[LogMsg ChainEvent, ChainEffect, State MockNodeServerChainState,
          LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (Params
-> ChainControlEffect
   ~> Eff
        '[LogMsg ChainEvent, ChainEffect, State MockNodeServerChainState,
          LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall (effs :: [* -> *]) (m :: * -> *).
(Member (State MockNodeServerChainState) effs,
 Member (LogMsg ChainEvent) effs, LastMember m effs, MonadIO m) =>
Params -> ChainControlEffect ~> Eff effs
handleControlChain Params
params)

            mergeState :: Eff
  '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
    Reader (Maybe TxSendHandle), State AppState,
    LogMsg PABServerLogMsg, IO]
  x
-> Eff
     '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     x
mergeState = (State MockNodeServerChainState
 ~> Eff
      '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO])
-> forall x.
   Eff
     '[State MockNodeServerChainState, LogMsg PABServerLogMsg,
       Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     x
   -> Eff
        '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
        x
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' AppState MockNodeServerChainState
-> State MockNodeServerChainState
   ~> Eff
        '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState Lens' AppState MockNodeServerChainState
chainState)

            toWriter :: Eff
  '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
    State AppState, LogMsg PABServerLogMsg, IO]
  a
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
toWriter = Eff
  '[Writer [LogMessage PABServerLogMsg], Reader (Maybe TxSendHandle),
    State AppState, LogMsg PABServerLogMsg, IO]
  a
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
forall w (effs :: [* -> *]) a.
Monoid w =>
Eff (Writer w : effs) a -> Eff effs (a, w)
Eff.runWriter (Eff
   '[Writer [LogMessage PABServerLogMsg], Reader (Maybe TxSendHandle),
     State AppState, LogMsg PABServerLogMsg, IO]
   a
 -> Eff
      '[Reader (Maybe TxSendHandle), State AppState,
        LogMsg PABServerLogMsg, IO]
      (a, [LogMessage PABServerLogMsg]))
-> (Eff
      '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO]
      a
    -> Eff
         '[Writer [LogMessage PABServerLogMsg], Reader (Maybe TxSendHandle),
           State AppState, LogMsg PABServerLogMsg, IO]
         a)
-> Eff
     '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
     a
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg PABServerLogMsg
 ~> Eff
      '[Writer [LogMessage PABServerLogMsg], Reader (Maybe TxSendHandle),
        State AppState, LogMsg PABServerLogMsg, IO])
-> Eff
     '[LogMsg PABServerLogMsg, Reader (Maybe TxSendHandle),
       State AppState, LogMsg PABServerLogMsg, IO]
   ~> Eff
        '[Writer [LogMessage PABServerLogMsg], Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (AReview [LogMessage PABServerLogMsg] (LogMessage PABServerLogMsg)
-> LogMsg PABServerLogMsg
   ~> Eff
        '[Writer [LogMessage PABServerLogMsg], Reader (Maybe TxSendHandle),
          State AppState, LogMsg PABServerLogMsg, IO]
forall a w (effs :: [* -> *]).
Member (Writer w) effs =>
AReview w (LogMessage a) -> LogMsg a ~> Eff effs
handleLogWriter @PABServerLogMsg @[LogMessage PABServerLogMsg] ((LogMessage PABServerLogMsg -> [LogMessage PABServerLogMsg])
-> AReview
     [LogMessage PABServerLogMsg] (LogMessage PABServerLogMsg)
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto LogMessage PABServerLogMsg -> [LogMessage PABServerLogMsg]
forall (m :: * -> *) a. Monad m => a -> m a
return))

            runReaders :: AppState
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
-> Eff
     '[LogMsg PABServerLogMsg, IO]
     ((a, [LogMessage PABServerLogMsg]), AppState)
runReaders AppState
s = AppState
-> Eff
     '[State AppState, LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
-> Eff
     '[LogMsg PABServerLogMsg, IO]
     ((a, [LogMessage PABServerLogMsg]), AppState)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
Eff.runState AppState
s (Eff
   '[State AppState, LogMsg PABServerLogMsg, IO]
   (a, [LogMessage PABServerLogMsg])
 -> Eff
      '[LogMsg PABServerLogMsg, IO]
      ((a, [LogMessage PABServerLogMsg]), AppState))
-> (Eff
      '[Reader (Maybe TxSendHandle), State AppState,
        LogMsg PABServerLogMsg, IO]
      (a, [LogMessage PABServerLogMsg])
    -> Eff
         '[State AppState, LogMsg PABServerLogMsg, IO]
         (a, [LogMessage PABServerLogMsg]))
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
-> Eff
     '[LogMsg PABServerLogMsg, IO]
     ((a, [LogMessage PABServerLogMsg]), AppState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TxSendHandle
-> Eff
     '[Reader (Maybe TxSendHandle), State AppState,
       LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
-> Eff
     '[State AppState, LogMsg PABServerLogMsg, IO]
     (a, [LogMessage PABServerLogMsg])
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
Eff.runReader Maybe TxSendHandle
clientHandler

processChainEffects ::
    Trace IO PABServerLogMsg
    -> Params
    -> Maybe Client.TxSendHandle
    -> MVar AppState
    -> Eff (NodeServerEffects IO) a
    -> IO a
processChainEffects :: Trace IO PABServerLogMsg
-> Params
-> Maybe TxSendHandle
-> MVar AppState
-> Eff (NodeServerEffects IO) a
-> IO a
processChainEffects Trace IO PABServerLogMsg
trace Params
params Maybe TxSendHandle
clientHandler MVar AppState
stateVar Eff (NodeServerEffects IO) a
eff = do
    ([LogMessage PABServerLogMsg]
events, a
result) <- IO ([LogMessage PABServerLogMsg], a)
-> IO ([LogMessage PABServerLogMsg], a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([LogMessage PABServerLogMsg], a)
 -> IO ([LogMessage PABServerLogMsg], a))
-> IO ([LogMessage PABServerLogMsg], a)
-> IO ([LogMessage PABServerLogMsg], a)
forall a b. (a -> b) -> a -> b
$ Trace IO PABServerLogMsg
-> Params
-> Maybe TxSendHandle
-> MVar AppState
-> Eff (NodeServerEffects IO) a
-> IO ([LogMessage PABServerLogMsg], a)
forall a.
Trace IO PABServerLogMsg
-> Params
-> Maybe TxSendHandle
-> MVar AppState
-> Eff (NodeServerEffects IO) a
-> IO ([LogMessage PABServerLogMsg], a)
runChainEffects Trace IO PABServerLogMsg
trace Params
params Maybe TxSendHandle
clientHandler MVar AppState
stateVar Eff (NodeServerEffects IO) a
eff
    Trace IO PABServerLogMsg -> Eff '[LogMsg PABServerLogMsg, IO] ~> IO
forall (m :: * -> *) l.
MonadIO m =>
Trace m l -> Eff '[LogMsg l, m] ~> m
LM.runLogEffects Trace IO PABServerLogMsg
trace (Eff '[LogMsg PABServerLogMsg, IO] () -> IO ())
-> Eff '[LogMsg PABServerLogMsg, IO] () -> IO ()
forall a b. (a -> b) -> a -> b
$ (LogMessage PABServerLogMsg
 -> Eff '[LogMsg PABServerLogMsg, IO] ())
-> [LogMessage PABServerLogMsg]
-> Eff '[LogMsg PABServerLogMsg, IO] ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\(LogMessage LogLevel
_ PABServerLogMsg
chainEvent) -> PABServerLogMsg -> Eff '[LogMsg PABServerLogMsg, IO] ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug PABServerLogMsg
chainEvent) [LogMessage PABServerLogMsg]
events
    IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        MVar AppState -> (AppState -> IO AppState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_
            MVar AppState
stateVar
            (\AppState
state -> AppState -> IO AppState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppState -> IO AppState) -> AppState -> IO AppState
forall a b. (a -> b) -> a -> b
$ ASetter
  AppState
  AppState
  [LogMessage PABServerLogMsg]
  [LogMessage PABServerLogMsg]
-> ([LogMessage PABServerLogMsg] -> [LogMessage PABServerLogMsg])
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  AppState
  AppState
  [LogMessage PABServerLogMsg]
  [LogMessage PABServerLogMsg]
Lens' AppState [LogMessage PABServerLogMsg]
eventHistory ([LogMessage PABServerLogMsg]
-> [LogMessage PABServerLogMsg] -> [LogMessage PABServerLogMsg]
forall a. Monoid a => a -> a -> a
mappend [LogMessage PABServerLogMsg]
events) AppState
state)
    a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

-- | Calls 'addBlock' at the start of every slot, causing pending transactions
--   to be validated and added to the chain.
slotCoordinator ::
    SlotConfig
    -> Server.ServerHandler
    -> IO a
slotCoordinator :: SlotConfig -> ServerHandler -> IO a
slotCoordinator sc :: SlotConfig
sc@SlotConfig{Integer
scSlotLength :: Integer
scSlotLength :: SlotConfig -> Integer
scSlotLength} ServerHandler
serverHandler = do
    IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO a) -> IO () -> IO a
forall a b. (a -> b) -> a -> b
$ do
        IO Block -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Block -> IO ()) -> IO Block -> IO ()
forall a b. (a -> b) -> a -> b
$ ServerHandler -> IO Block
forall (m :: * -> *). MonadIO m => ServerHandler -> m Block
Server.processBlock ServerHandler
serverHandler
        Slot
newSlot <- SlotConfig -> IO Slot
currentSlot SlotConfig
sc
        IO Slot -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Slot -> IO ()) -> IO Slot -> IO ()
forall a b. (a -> b) -> a -> b
$ (Slot -> Slot) -> ServerHandler -> IO Slot
forall (m :: * -> *).
MonadIO m =>
(Slot -> Slot) -> ServerHandler -> m Slot
Server.modifySlot (Slot -> Slot -> Slot
forall a b. a -> b -> a
const Slot
newSlot) ServerHandler
serverHandler
        IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay
               (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
               (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Millisecond -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Integer -> Millisecond
forall a. Num a => Integer -> a
fromInteger Integer
scSlotLength :: Millisecond)