{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

module Cardano.Chain where

import Cardano.Node.Emulator.Chain qualified as EC
import Cardano.Node.Emulator.Params (Params)
import Control.Concurrent
import Control.Concurrent.STM
import Control.Lens hiding (index)
import Control.Monad.Freer
import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logInfo, logWarn)
import Control.Monad.Freer.State (State, gets, modify)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Foldable (traverse_)
import Data.Functor (void)
import Data.Maybe (listToMaybe)
import GHC.Generics (Generic)
import Ledger (Block, CardanoTx, Slot (..))
import Ledger.Index qualified as Index

type TxPool = [CardanoTx]

data MockNodeServerChainState = MockNodeServerChainState
  { MockNodeServerChainState -> TxPool
_txPool      :: TxPool
  , MockNodeServerChainState -> UtxoIndex
_index       :: Index.UtxoIndex
  , MockNodeServerChainState -> Slot
_currentSlot :: Slot
  , MockNodeServerChainState -> TChan Block
_channel     :: TChan Block
  , MockNodeServerChainState -> Maybe Block
_tip         :: Maybe Block
  } deriving ((forall x.
 MockNodeServerChainState -> Rep MockNodeServerChainState x)
-> (forall x.
    Rep MockNodeServerChainState x -> MockNodeServerChainState)
-> Generic MockNodeServerChainState
forall x.
Rep MockNodeServerChainState x -> MockNodeServerChainState
forall x.
MockNodeServerChainState -> Rep MockNodeServerChainState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep MockNodeServerChainState x -> MockNodeServerChainState
$cfrom :: forall x.
MockNodeServerChainState -> Rep MockNodeServerChainState x
Generic)

makeLenses ''MockNodeServerChainState

instance Show MockNodeServerChainState where
    -- Skip showing the full chain
    show :: MockNodeServerChainState -> String
show MockNodeServerChainState {TxPool
_txPool :: TxPool
_txPool :: MockNodeServerChainState -> TxPool
_txPool, UtxoIndex
_index :: UtxoIndex
_index :: MockNodeServerChainState -> UtxoIndex
_index, Slot
_currentSlot :: Slot
_currentSlot :: MockNodeServerChainState -> Slot
_currentSlot, Maybe Block
_tip :: Maybe Block
_tip :: MockNodeServerChainState -> Maybe Block
_tip} =
        String
"MockNodeServerChainState { " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxPool -> String
forall a. Show a => a -> String
show TxPool
_txPool
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UtxoIndex -> String
forall a. Show a => a -> String
show UtxoIndex
_index
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Slot -> String
forall a. Show a => a -> String
show Slot
_currentSlot
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Block -> String
forall a. Show a => a -> String
show Maybe Block
_tip String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" }"

emptyChainState :: MonadIO m => m MockNodeServerChainState
emptyChainState :: m MockNodeServerChainState
emptyChainState = do
    TChan Block
chan <- IO (TChan Block) -> m (TChan Block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan Block) -> m (TChan Block))
-> (STM (TChan Block) -> IO (TChan Block))
-> STM (TChan Block)
-> m (TChan Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (TChan Block) -> IO (TChan Block)
forall a. STM a -> IO a
atomically (STM (TChan Block) -> m (TChan Block))
-> STM (TChan Block) -> m (TChan Block)
forall a b. (a -> b) -> a -> b
$ STM (TChan Block)
forall a. STM (TChan a)
newTChan
    MockNodeServerChainState -> m MockNodeServerChainState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MockNodeServerChainState -> m MockNodeServerChainState)
-> MockNodeServerChainState -> m MockNodeServerChainState
forall a b. (a -> b) -> a -> b
$ TxPool
-> UtxoIndex
-> Slot
-> TChan Block
-> Maybe Block
-> MockNodeServerChainState
MockNodeServerChainState [] UtxoIndex
forall a. Monoid a => a
mempty Slot
0 TChan Block
chan Maybe Block
forall a. Maybe a
Nothing

getChannel :: MonadIO m => MVar MockNodeServerChainState -> m (TChan Block)
getChannel :: MVar MockNodeServerChainState -> m (TChan Block)
getChannel MVar MockNodeServerChainState
mv = IO MockNodeServerChainState -> m MockNodeServerChainState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar MockNodeServerChainState -> IO MockNodeServerChainState
forall a. MVar a -> IO a
readMVar MVar MockNodeServerChainState
mv) m MockNodeServerChainState
-> (MockNodeServerChainState -> TChan Block) -> m (TChan Block)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Getting (TChan Block) MockNodeServerChainState (TChan Block)
-> MockNodeServerChainState -> TChan Block
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan Block) MockNodeServerChainState (TChan Block)
Lens' MockNodeServerChainState (TChan Block)
channel

-- | Build a PAB ChainState from a emulator ChainState
fromEmulatorChainState :: MonadIO m => EC.ChainState -> m MockNodeServerChainState
fromEmulatorChainState :: ChainState -> m MockNodeServerChainState
fromEmulatorChainState EC.ChainState {TxPool
_txPool :: ChainState -> TxPool
_txPool :: TxPool
EC._txPool, UtxoIndex
_index :: ChainState -> UtxoIndex
_index :: UtxoIndex
EC._index, Slot
_chainCurrentSlot :: ChainState -> Slot
_chainCurrentSlot :: Slot
EC._chainCurrentSlot, Blockchain
_chainNewestFirst :: ChainState -> Blockchain
_chainNewestFirst :: Blockchain
EC._chainNewestFirst} = do
    TChan Block
ch <- IO (TChan Block) -> m (TChan Block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan Block) -> m (TChan Block))
-> IO (TChan Block) -> m (TChan Block)
forall a b. (a -> b) -> a -> b
$ STM (TChan Block) -> IO (TChan Block)
forall a. STM a -> IO a
atomically STM (TChan Block)
forall a. STM (TChan a)
newTChan
    m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        (Block -> IO ()) -> Blockchain -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (Block -> STM ()) -> Block -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TChan Block -> Block -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Block
ch) Blockchain
_chainNewestFirst
    MockNodeServerChainState -> m MockNodeServerChainState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MockNodeServerChainState -> m MockNodeServerChainState)
-> MockNodeServerChainState -> m MockNodeServerChainState
forall a b. (a -> b) -> a -> b
$ MockNodeServerChainState :: TxPool
-> UtxoIndex
-> Slot
-> TChan Block
-> Maybe Block
-> MockNodeServerChainState
MockNodeServerChainState { _channel :: TChan Block
_channel     = TChan Block
ch
                      , _txPool :: TxPool
_txPool      = TxPool
_txPool
                      , _index :: UtxoIndex
_index       = UtxoIndex
_index
                      , _currentSlot :: Slot
_currentSlot = Slot
_chainCurrentSlot
                      , _tip :: Maybe Block
_tip         = Blockchain -> Maybe Block
forall a. [a] -> Maybe a
listToMaybe Blockchain
_chainNewestFirst
                      }

-- Get the current tip or wait for one if there are no blocks.
getTip :: forall m. MonadIO m => MVar MockNodeServerChainState -> m Block
getTip :: MVar MockNodeServerChainState -> m Block
getTip MVar MockNodeServerChainState
mvChainState = IO Block -> m Block
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Block -> m Block) -> IO Block -> m Block
forall a b. (a -> b) -> a -> b
$ MVar MockNodeServerChainState -> IO MockNodeServerChainState
forall a. MVar a -> IO a
readMVar MVar MockNodeServerChainState
mvChainState IO MockNodeServerChainState
-> (MockNodeServerChainState -> IO Block) -> IO Block
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    MockNodeServerChainState { _tip :: MockNodeServerChainState -> Maybe Block
_tip = Just Block
tip' } -> Block -> IO Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
tip'
    MockNodeServerChainState { TChan Block
_channel :: TChan Block
_channel :: MockNodeServerChainState -> TChan Block
_channel }         -> do
        -- Wait for the initial block.
        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
$ IO Block -> IO Block
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Block -> IO Block) -> IO Block -> IO Block
forall a b. (a -> b) -> a -> b
$ STM Block -> IO Block
forall a. STM a -> IO a
atomically (STM Block -> IO Block) -> STM Block -> IO Block
forall a b. (a -> b) -> a -> b
$ TChan Block -> STM Block
forall a. TChan a -> STM a
peekTChan TChan Block
_channel
        MVar MockNodeServerChainState -> IO Block
forall (m :: * -> *).
MonadIO m =>
MVar MockNodeServerChainState -> m Block
getTip MVar MockNodeServerChainState
mvChainState

handleControlChain ::
     ( Member (State MockNodeServerChainState) effs
     , Member (LogMsg EC.ChainEvent) effs
     , LastMember m effs
     , MonadIO m )
  => Params -> EC.ChainControlEffect ~> Eff effs
handleControlChain :: Params -> ChainControlEffect ~> Eff effs
handleControlChain Params
params = \case
    ChainControlEffect x
EC.ProcessBlock -> do
        TxPool
pool  <- (MockNodeServerChainState -> TxPool) -> Eff effs TxPool
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets ((MockNodeServerChainState -> TxPool) -> Eff effs TxPool)
-> (MockNodeServerChainState -> TxPool) -> Eff effs TxPool
forall a b. (a -> b) -> a -> b
$ Getting TxPool MockNodeServerChainState TxPool
-> MockNodeServerChainState -> TxPool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TxPool MockNodeServerChainState TxPool
Lens' MockNodeServerChainState TxPool
txPool
        Slot
slot  <- (MockNodeServerChainState -> Slot) -> Eff effs Slot
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets ((MockNodeServerChainState -> Slot) -> Eff effs Slot)
-> (MockNodeServerChainState -> Slot) -> Eff effs Slot
forall a b. (a -> b) -> a -> b
$ Getting Slot MockNodeServerChainState Slot
-> MockNodeServerChainState -> Slot
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Slot MockNodeServerChainState Slot
Lens' MockNodeServerChainState Slot
currentSlot
        UtxoIndex
idx   <- (MockNodeServerChainState -> UtxoIndex) -> Eff effs UtxoIndex
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets ((MockNodeServerChainState -> UtxoIndex) -> Eff effs UtxoIndex)
-> (MockNodeServerChainState -> UtxoIndex) -> Eff effs UtxoIndex
forall a b. (a -> b) -> a -> b
$ Getting UtxoIndex MockNodeServerChainState UtxoIndex
-> MockNodeServerChainState -> UtxoIndex
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UtxoIndex MockNodeServerChainState UtxoIndex
Lens' MockNodeServerChainState UtxoIndex
index
        TChan Block
chan   <- (MockNodeServerChainState -> TChan Block) -> Eff effs (TChan Block)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets ((MockNodeServerChainState -> TChan Block)
 -> Eff effs (TChan Block))
-> (MockNodeServerChainState -> TChan Block)
-> Eff effs (TChan Block)
forall a b. (a -> b) -> a -> b
$ Getting (TChan Block) MockNodeServerChainState (TChan Block)
-> MockNodeServerChainState -> TChan Block
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan Block) MockNodeServerChainState (TChan Block)
Lens' MockNodeServerChainState (TChan Block)
channel

        let EC.ValidatedBlock Block
block [ChainEvent]
events UtxoIndex
idx' = Params -> Slot -> UtxoIndex -> TxPool -> ValidatedBlock
EC.validateBlock Params
params Slot
slot UtxoIndex
idx TxPool
pool

        (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
(s -> s) -> Eff effs ()
modify ((MockNodeServerChainState -> MockNodeServerChainState)
 -> Eff effs ())
-> (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ (TxPool -> Identity TxPool)
-> MockNodeServerChainState -> Identity MockNodeServerChainState
Lens' MockNodeServerChainState TxPool
txPool ((TxPool -> Identity TxPool)
 -> MockNodeServerChainState -> Identity MockNodeServerChainState)
-> TxPool -> MockNodeServerChainState -> MockNodeServerChainState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ []
        (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
(s -> s) -> Eff effs ()
modify ((MockNodeServerChainState -> MockNodeServerChainState)
 -> Eff effs ())
-> (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ (Maybe Block -> Identity (Maybe Block))
-> MockNodeServerChainState -> Identity MockNodeServerChainState
Lens' MockNodeServerChainState (Maybe Block)
tip    ((Maybe Block -> Identity (Maybe Block))
 -> MockNodeServerChainState -> Identity MockNodeServerChainState)
-> Block -> MockNodeServerChainState -> MockNodeServerChainState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Block
block
        (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
(s -> s) -> Eff effs ()
modify ((MockNodeServerChainState -> MockNodeServerChainState)
 -> Eff effs ())
-> (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ (UtxoIndex -> Identity UtxoIndex)
-> MockNodeServerChainState -> Identity MockNodeServerChainState
Lens' MockNodeServerChainState UtxoIndex
index  ((UtxoIndex -> Identity UtxoIndex)
 -> MockNodeServerChainState -> Identity MockNodeServerChainState)
-> UtxoIndex
-> MockNodeServerChainState
-> MockNodeServerChainState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UtxoIndex
idx'

        (ChainEvent -> Eff effs ()) -> [ChainEvent] -> Eff effs ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ChainEvent -> Eff effs ()
forall (effs :: [* -> *]).
Member (LogMsg ChainEvent) effs =>
ChainEvent -> Eff effs ()
logEvent [ChainEvent]
events

        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
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan Block -> Block -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan Block
chan Block
block
        Block -> Eff effs Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
block
    EC.ModifySlot Slot -> Slot
f -> (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
(s -> s) -> Eff effs ()
modify @MockNodeServerChainState (ASetter MockNodeServerChainState MockNodeServerChainState Slot Slot
-> (Slot -> Slot)
-> MockNodeServerChainState
-> MockNodeServerChainState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter MockNodeServerChainState MockNodeServerChainState Slot Slot
Lens' MockNodeServerChainState Slot
currentSlot Slot -> Slot
f) Eff effs () -> Eff effs x -> Eff effs x
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (MockNodeServerChainState -> x) -> Eff effs x
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting Slot MockNodeServerChainState Slot
-> MockNodeServerChainState -> Slot
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Slot MockNodeServerChainState Slot
Lens' MockNodeServerChainState Slot
currentSlot)

handleChain ::
     ( Member (State MockNodeServerChainState) effs )
  => Params
  -> EC.ChainEffect ~> Eff effs
handleChain :: Params -> ChainEffect ~> Eff effs
handleChain Params
params = \case
    EC.QueueTx CardanoTx
tx     -> (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
(s -> s) -> Eff effs ()
modify ((MockNodeServerChainState -> MockNodeServerChainState)
 -> Eff effs ())
-> (MockNodeServerChainState -> MockNodeServerChainState)
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ((TxPool -> Identity TxPool)
 -> MockNodeServerChainState -> Identity MockNodeServerChainState)
-> (TxPool -> TxPool)
-> MockNodeServerChainState
-> MockNodeServerChainState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (TxPool -> Identity TxPool)
-> MockNodeServerChainState -> Identity MockNodeServerChainState
Lens' MockNodeServerChainState TxPool
txPool (CardanoTx -> TxPool -> TxPool
addTxToPool CardanoTx
tx)
    ChainEffect x
EC.GetCurrentSlot -> (MockNodeServerChainState -> Slot) -> Eff effs Slot
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets MockNodeServerChainState -> Slot
_currentSlot
    ChainEffect x
EC.GetParams      -> Params -> Eff effs Params
forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params

logEvent :: Member (LogMsg EC.ChainEvent) effs => EC.ChainEvent -> Eff effs ()
logEvent :: ChainEvent -> Eff effs ()
logEvent ChainEvent
e = case ChainEvent
e of
    EC.SlotAdd{}           -> ChainEvent -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug ChainEvent
e
    EC.TxnValidationFail{} -> ChainEvent -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn ChainEvent
e
    ChainEvent
_                      -> ChainEvent -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo ChainEvent
e

addTxToPool :: CardanoTx -> TxPool -> TxPool
addTxToPool :: CardanoTx -> TxPool -> TxPool
addTxToPool = (:)

-- | Fetch the currently stored chain by iterating over the channel until
--   there is nothing left to be returned.
chainNewestFirst :: forall m. MonadIO m => TChan Block -> m [Block]
chainNewestFirst :: TChan Block -> m Blockchain
chainNewestFirst TChan Block
ch = do
    TChan Block
localChannel <- IO (TChan Block) -> m (TChan Block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan Block) -> m (TChan Block))
-> IO (TChan Block) -> m (TChan Block)
forall a b. (a -> b) -> a -> b
$ STM (TChan Block) -> IO (TChan Block)
forall a. STM a -> IO a
atomically (STM (TChan Block) -> IO (TChan Block))
-> STM (TChan Block) -> IO (TChan Block)
forall a b. (a -> b) -> a -> b
$ TChan Block -> STM (TChan Block)
forall a. TChan a -> STM (TChan a)
cloneTChan TChan Block
ch
    TChan Block -> Blockchain -> m Blockchain
go TChan Block
localChannel []
    where
    go :: TChan Block -> [Block] -> m [Block]
    go :: TChan Block -> Blockchain -> m Blockchain
go TChan Block
local Blockchain
acc =
        (IO (Maybe Block) -> m (Maybe Block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Block) -> m (Maybe Block))
-> IO (Maybe Block) -> m (Maybe Block)
forall a b. (a -> b) -> a -> b
$ STM (Maybe Block) -> IO (Maybe Block)
forall a. STM a -> IO a
atomically (STM (Maybe Block) -> IO (Maybe Block))
-> STM (Maybe Block) -> IO (Maybe Block)
forall a b. (a -> b) -> a -> b
$ TChan Block -> STM (Maybe Block)
forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan Block
local) m (Maybe Block) -> (Maybe Block -> m Blockchain) -> m Blockchain
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Block
Nothing    -> Blockchain -> m Blockchain
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blockchain
acc
            Just Block
block -> TChan Block -> Blockchain -> m Blockchain
go TChan Block
ch (Block
block Block -> Blockchain -> Blockchain
forall a. a -> [a] -> [a]
: Blockchain
acc)