{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TupleSections      #-}
{-| Using the chain index as a library.

A minimal example that just syncs the chain index:

@
`withDefaultRunRequirements` $ \runReq -> do

    syncHandler <- `defaultChainSyncHandler` runReq

    `syncChainIndex` `defaultConfig` runReq syncHandler

    void getLine
@

-}
module Plutus.ChainIndex.Lib (
    RunRequirements(..)
    , withRunRequirements
    , withDefaultRunRequirements
    , defaultLoggingConfig
    , Config.defaultConfig
    -- * Chain index effects
    , CI.handleChainIndexEffects
    , runChainIndexEffects
    -- * Chain synchronisation
    , syncChainIndex
    -- ** Synchronisation handlers
    , ChainSyncHandler
    , ChainSyncEvent(..)
    , EventsQueue
    , storeChainSyncHandler
    , storeFromBlockNo
    , filterTxs
    , runChainIndexDuringSync
    -- * Utils
    , getTipSlot
) where

import Control.Monad.Freer (Eff)
import Control.Monad.Freer.Extras.Beam (BeamLog (SqlLog))
import Control.Monad.Freer.Extras.Beam.Effects (BeamEffect)
import Control.Monad.Freer.Extras.Log qualified as Log
import Data.Default (def)
import Data.Functor (void)
import Data.Pool qualified as Pool
import Database.Beam.Migrate.Simple (autoMigrate)
import Database.Beam.Sqlite qualified as Sqlite
import Database.Beam.Sqlite.Migrate qualified as Sqlite
import Database.SQLite.Simple qualified as Sqlite

import Cardano.Api qualified as C
import Cardano.BM.Configuration.Model qualified as CM
import Cardano.BM.Setup (setupTrace_)
import Cardano.BM.Trace (Trace, logDebug, nullTracer)

import Cardano.Protocol.Socket.Client qualified as C
import Cardano.Protocol.Socket.Type (epochSlots)
import Control.Concurrent.STM (atomically, newTVarIO)
import Control.Concurrent.STM.TBMQueue (TBMQueue, writeTBMQueue)
import Database.Beam.Sqlite (Sqlite)
import Plutus.ChainIndex (ChainIndexLog (BeamLogItem), RunRequirements (RunRequirements), getResumePoints,
                          runChainIndexEffects, tipBlockNo)
import Plutus.ChainIndex qualified as CI
import Plutus.ChainIndex.Compatibility (fromCardanoBlock, fromCardanoPoint, fromCardanoTip, tipFromCardanoBlock)
import Plutus.ChainIndex.Config qualified as Config
import Plutus.ChainIndex.DbSchema (checkedSqliteDb)
import Plutus.ChainIndex.Effects (ChainIndexControlEffect, ChainIndexQueryEffect)
import Plutus.ChainIndex.Logging qualified as Logging
import Plutus.Monitoring.Util (PrettyObject (PrettyObject), convertLog, runLogEffects)

-- | Generate the requirements to run the chain index effects given logging configuration and chain index configuration.
withRunRequirements :: CM.Configuration -> Config.ChainIndexConfig -> (RunRequirements -> IO ()) -> IO ()
withRunRequirements :: Configuration
-> ChainIndexConfig -> (RunRequirements -> IO ()) -> IO ()
withRunRequirements Configuration
logConfig ChainIndexConfig
config RunRequirements -> IO ()
cont = do
  Pool Connection
pool <- PoolConfig Connection -> IO (Pool Connection)
forall a. PoolConfig a -> IO (Pool a)
Pool.newPool PoolConfig :: forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
Pool.PoolConfig
    { createResource :: IO Connection
Pool.createResource = String -> IO Connection
Sqlite.open (ChainIndexConfig -> String
Config.cicDbPath ChainIndexConfig
config) IO Connection -> (Connection -> IO Connection) -> IO Connection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> IO Connection
setupConn
    , freeResource :: Connection -> IO ()
Pool.freeResource = Connection -> IO ()
Sqlite.close
    , poolCacheTTL :: Double
Pool.poolCacheTTL = Double
1_000_000
    , poolMaxResources :: Int
Pool.poolMaxResources = Int
25
    }
  (Trace IO (PrettyObject ChainIndexLog)
trace :: Trace IO (PrettyObject ChainIndexLog), Switchboard (PrettyObject ChainIndexLog)
_) <- Configuration
-> Text
-> IO
     (Trace IO (PrettyObject ChainIndexLog),
      Switchboard (PrettyObject ChainIndexLog))
forall (m :: * -> *) a.
(MonadIO m, ToJSON a, FromJSON a, ToObject a) =>
Configuration -> Text -> m (Trace m a, Switchboard a)
setupTrace_ Configuration
logConfig Text
"chain-index"
  Pool Connection -> (Connection -> IO ()) -> IO ()
forall a r. Pool a -> (a -> IO r) -> IO r
Pool.withResource Pool Connection
pool ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
    (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
Sqlite.runBeamSqliteDebug (Trace IO ChainIndexLog -> ChainIndexLog -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logDebug ((ChainIndexLog -> PrettyObject ChainIndexLog)
-> Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
convertLog ChainIndexLog -> PrettyObject ChainIndexLog
forall t. t -> PrettyObject t
PrettyObject Trace IO (PrettyObject ChainIndexLog)
trace) (ChainIndexLog -> IO ())
-> (String -> ChainIndexLog) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BeamLog -> ChainIndexLog
BeamLogItem (BeamLog -> ChainIndexLog)
-> (String -> BeamLog) -> String -> ChainIndexLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BeamLog
SqlLog)) Connection
conn (SqliteM () -> IO ()) -> SqliteM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        BeamMigrationBackend Sqlite SqliteM
-> CheckedDatabaseSettings Sqlite Db -> SqliteM ()
forall be (db :: (* -> *) -> *) (m :: * -> *).
(Database be db, MonadFail m) =>
BeamMigrationBackend be m -> CheckedDatabaseSettings be db -> m ()
autoMigrate BeamMigrationBackend Sqlite SqliteM
Sqlite.migrationBackend CheckedDatabaseSettings Sqlite Db
checkedSqliteDb

    -- Automatically delete the input when an output from a matching input/output pair is deleted.
    -- See reduceOldUtxoDb in Plutus.ChainIndex.Handlers
    Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"DROP TRIGGER IF EXISTS delete_matching_input"
    Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn
        Query
"CREATE TRIGGER delete_matching_input AFTER DELETE ON unspent_outputs \
        \BEGIN \
        \  DELETE FROM unmatched_inputs WHERE input_row_tip__row_slot = old.output_row_tip__row_slot \
        \                                 AND input_row_out_ref = old.output_row_out_ref; \
        \END"

    -- creating extra index to optimize utxoSetAtAddress and utxoSetWithCurrency queries
    Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"DROP INDEX IF EXISTS unspent_index"
    Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"DROP INDEX IF EXISTS unmatched_index"
    Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS unspent_index on unspent_outputs (output_row_out_ref, output_row_tip__row_slot)"
    Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"CREATE INDEX IF NOT EXISTS unmatched_index on unmatched_inputs (input_row_out_ref, input_row_tip__row_slot)"

  TVar ChainIndexState
stateTVar <- ChainIndexState -> IO (TVar ChainIndexState)
forall a. a -> IO (TVar a)
newTVarIO ChainIndexState
forall a. Monoid a => a
mempty
  RunRequirements -> IO ()
cont (RunRequirements -> IO ()) -> RunRequirements -> IO ()
forall a b. (a -> b) -> a -> b
$ Trace IO (PrettyObject ChainIndexLog)
-> TVar ChainIndexState
-> Pool Connection
-> Int
-> RunRequirements
RunRequirements Trace IO (PrettyObject ChainIndexLog)
trace TVar ChainIndexState
stateTVar Pool Connection
pool (ChainIndexConfig -> Int
Config.cicSecurityParam ChainIndexConfig
config)

  where
    setupConn :: Connection -> IO Connection
setupConn Connection
conn = do
        -- Optimize Sqlite for write performance, halves the sync time.
        -- https://sqlite.org/wal.html
        Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"PRAGMA journal_mode=WAL;"
        Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

-- | Generate the requirements to run the chain index effects given default configurations.
withDefaultRunRequirements :: (RunRequirements -> IO ()) -> IO ()
withDefaultRunRequirements :: (RunRequirements -> IO ()) -> IO ()
withDefaultRunRequirements RunRequirements -> IO ()
cont = do
    Configuration
logConfig <- IO Configuration
Logging.defaultConfig
    Configuration
-> ChainIndexConfig -> (RunRequirements -> IO ()) -> IO ()
withRunRequirements Configuration
logConfig ChainIndexConfig
Config.defaultConfig RunRequirements -> IO ()
cont

-- | The default logging configuration.
defaultLoggingConfig :: IO CM.Configuration
defaultLoggingConfig :: IO Configuration
defaultLoggingConfig = IO Configuration
Logging.defaultConfig

-- | Chain synchronisation events.
data ChainSyncEvent
    = Resume       CI.Point
    -- ^ Resume from the given point
    | RollForward  CI.ChainSyncBlock CI.Tip
    -- ^ Append the given block. The tip is the current tip of the node, which is newer than the tip of the block during syncing.
    | RollBackward CI.Point CI.Tip
    -- ^ Roll back to the given point. The tip is current tip of the node.
    deriving (Int -> ChainSyncEvent -> ShowS
[ChainSyncEvent] -> ShowS
ChainSyncEvent -> String
(Int -> ChainSyncEvent -> ShowS)
-> (ChainSyncEvent -> String)
-> ([ChainSyncEvent] -> ShowS)
-> Show ChainSyncEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainSyncEvent] -> ShowS
$cshowList :: [ChainSyncEvent] -> ShowS
show :: ChainSyncEvent -> String
$cshow :: ChainSyncEvent -> String
showsPrec :: Int -> ChainSyncEvent -> ShowS
$cshowsPrec :: Int -> ChainSyncEvent -> ShowS
Show)

toCardanoChainSyncHandler :: ChainSyncHandler -> C.ChainSyncEvent -> IO ()
toCardanoChainSyncHandler :: ChainSyncHandler -> ChainSyncEvent -> IO ()
toCardanoChainSyncHandler ChainSyncHandler
handler = \case
    C.RollBackward ChainPoint
cp ChainTip
ct -> ChainSyncHandler
handler (Point -> Tip -> ChainSyncEvent
RollBackward (ChainPoint -> Point
fromCardanoPoint ChainPoint
cp) (ChainTip -> Tip
fromCardanoTip ChainTip
ct))
    C.Resume ChainPoint
cp -> ChainSyncHandler
handler (Point -> ChainSyncEvent
Resume (ChainPoint -> Point
fromCardanoPoint ChainPoint
cp))
    C.RollForward BlockInMode CardanoMode
block ChainTip
ct ->
        let txs :: [ChainIndexTx]
txs = BlockInMode CardanoMode -> [ChainIndexTx]
fromCardanoBlock BlockInMode CardanoMode
block
        in ChainSyncHandler
handler (ChainSyncBlock -> Tip -> ChainSyncEvent
RollForward (Tip -> [(ChainIndexTx, TxProcessOption)] -> ChainSyncBlock
CI.Block (BlockInMode CardanoMode -> Tip
tipFromCardanoBlock BlockInMode CardanoMode
block) ((ChainIndexTx -> (ChainIndexTx, TxProcessOption))
-> [ChainIndexTx] -> [(ChainIndexTx, TxProcessOption)]
forall a b. (a -> b) -> [a] -> [b]
map (, TxProcessOption
forall a. Default a => a
def) [ChainIndexTx]
txs)) (ChainTip -> Tip
fromCardanoTip ChainTip
ct))

-- | A handler for chain synchronisation events.
type ChainSyncHandler = ChainSyncEvent -> IO ()
type EventsQueue = TBMQueue ChainSyncEvent

storeChainSyncHandler :: EventsQueue -> ChainSyncHandler
storeChainSyncHandler :: EventsQueue -> ChainSyncHandler
storeChainSyncHandler EventsQueue
eventsQueue = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (ChainSyncEvent -> STM ()) -> ChainSyncHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventsQueue -> ChainSyncEvent -> STM ()
forall a. TBMQueue a -> a -> STM ()
writeTBMQueue EventsQueue
eventsQueue

-- | Changes the given @ChainSyncHandler@ to only store transactions with a block number no smaller than the given one.
storeFromBlockNo :: CI.BlockNumber -> ChainSyncHandler -> ChainSyncHandler
storeFromBlockNo :: BlockNumber -> ChainSyncHandler -> ChainSyncHandler
storeFromBlockNo BlockNumber
storeFrom ChainSyncHandler
handler (RollForward (CI.Block Tip
blockTip [(ChainIndexTx, TxProcessOption)]
txs) Tip
chainTip) =
    ChainSyncHandler
handler (ChainSyncBlock -> Tip -> ChainSyncEvent
RollForward (Tip -> [(ChainIndexTx, TxProcessOption)] -> ChainSyncBlock
CI.Block Tip
blockTip (((ChainIndexTx, TxProcessOption)
 -> (ChainIndexTx, TxProcessOption))
-> [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ChainIndexTx
tx, TxProcessOption
opt) -> (ChainIndexTx
tx, TxProcessOption
opt { tpoStoreTx :: Bool
CI.tpoStoreTx = TxProcessOption -> Bool
CI.tpoStoreTx TxProcessOption
opt Bool -> Bool -> Bool
&& Bool
store })) [(ChainIndexTx, TxProcessOption)]
txs)) Tip
chainTip)
        where store :: Bool
store = Tip -> BlockNumber
tipBlockNo Tip
blockTip BlockNumber -> BlockNumber -> Bool
forall a. Ord a => a -> a -> Bool
>= BlockNumber
storeFrom
storeFromBlockNo BlockNumber
_ ChainSyncHandler
handler ChainSyncEvent
evt = ChainSyncHandler
handler ChainSyncEvent
evt

-- | Changes the given @ChainSyncHandler@ to only process and store certain transactions.
filterTxs
    :: (CI.ChainIndexTx -> Bool)
    -- ^ Only process transactions for which this function returns @True@.
    -> (CI.ChainIndexTx -> Bool)
    -- ^ From those, only store transactions for which this function returns @True@.
    -> ChainSyncHandler
    -- ^ The @ChainSyncHandler@ on which the returned @ChainSyncHandler@ is based.
    -> ChainSyncHandler
filterTxs :: (ChainIndexTx -> Bool)
-> (ChainIndexTx -> Bool) -> ChainSyncHandler -> ChainSyncHandler
filterTxs ChainIndexTx -> Bool
isAccepted ChainIndexTx -> Bool
isStored ChainSyncHandler
handler (RollForward (CI.Block Tip
blockTip [(ChainIndexTx, TxProcessOption)]
txs) Tip
chainTip) =
    let txs' :: [(ChainIndexTx, TxProcessOption)]
txs' = ((ChainIndexTx, TxProcessOption)
 -> (ChainIndexTx, TxProcessOption))
-> [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ChainIndexTx
tx, TxProcessOption
opt) -> (ChainIndexTx
tx, TxProcessOption
opt { tpoStoreTx :: Bool
CI.tpoStoreTx = TxProcessOption -> Bool
CI.tpoStoreTx TxProcessOption
opt Bool -> Bool -> Bool
&& ChainIndexTx -> Bool
isStored ChainIndexTx
tx }))
                ([(ChainIndexTx, TxProcessOption)]
 -> [(ChainIndexTx, TxProcessOption)])
-> [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTx, TxProcessOption) -> Bool)
-> [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ChainIndexTx -> Bool
isAccepted (ChainIndexTx -> Bool)
-> ((ChainIndexTx, TxProcessOption) -> ChainIndexTx)
-> (ChainIndexTx, TxProcessOption)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTx, TxProcessOption) -> ChainIndexTx
forall a b. (a, b) -> a
fst) [(ChainIndexTx, TxProcessOption)]
txs
    in ChainSyncHandler
handler (ChainSyncBlock -> Tip -> ChainSyncEvent
RollForward (Tip -> [(ChainIndexTx, TxProcessOption)] -> ChainSyncBlock
CI.Block Tip
blockTip [(ChainIndexTx, TxProcessOption)]
txs') Tip
chainTip)
filterTxs ChainIndexTx -> Bool
_ ChainIndexTx -> Bool
_ ChainSyncHandler
handler ChainSyncEvent
evt = ChainSyncHandler
handler ChainSyncEvent
evt

-- | Get the slot number of the current tip of the node.
getTipSlot :: Config.ChainIndexConfig -> IO (Maybe C.SlotNo)
getTipSlot :: ChainIndexConfig -> IO (Maybe SlotNo)
getTipSlot ChainIndexConfig
config = do
  ChainTip
tip <- LocalNodeConnectInfo CardanoMode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
C.getLocalChainTip (LocalNodeConnectInfo CardanoMode -> IO ChainTip)
-> LocalNodeConnectInfo CardanoMode -> IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
C.LocalNodeConnectInfo
         { localConsensusModeParams :: ConsensusModeParams CardanoMode
C.localConsensusModeParams = EpochSlots -> ConsensusModeParams CardanoMode
C.CardanoModeParams EpochSlots
epochSlots
         , localNodeNetworkId :: NetworkId
C.localNodeNetworkId = ChainIndexConfig -> NetworkId
Config.cicNetworkId ChainIndexConfig
config
         , localNodeSocketPath :: String
C.localNodeSocketPath = ChainIndexConfig -> String
Config.cicSocketPath ChainIndexConfig
config
         }
  case ChainTip
tip of
    C.ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ -> Maybe SlotNo -> IO (Maybe SlotNo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SlotNo -> IO (Maybe SlotNo))
-> Maybe SlotNo -> IO (Maybe SlotNo)
forall a b. (a -> b) -> a -> b
$ SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
slotNo
    ChainTip
C.ChainTipAtGenesis   -> Maybe SlotNo -> IO (Maybe SlotNo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SlotNo -> IO (Maybe SlotNo))
-> Maybe SlotNo -> IO (Maybe SlotNo)
forall a b. (a -> b) -> a -> b
$ Maybe SlotNo
forall a. Maybe a
Nothing


-- | Synchronise the chain index with the node using the given handler.
syncChainIndex :: Config.ChainIndexConfig -> RunRequirements -> ChainSyncHandler -> IO ()
syncChainIndex :: ChainIndexConfig -> RunRequirements -> ChainSyncHandler -> IO ()
syncChainIndex ChainIndexConfig
config RunRequirements
runReq ChainSyncHandler
syncHandler = do
    Just [ChainPoint]
resumePoints <- RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite]
     [ChainPoint]
-> IO (Maybe [ChainPoint])
forall a.
RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite]
     a
-> IO (Maybe a)
runChainIndexDuringSync RunRequirements
runReq Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    BeamEffect Sqlite]
  [ChainPoint]
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
Eff effs [ChainPoint]
getResumePoints
    IO (ChainSyncHandle ChainSyncEvent) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ChainSyncHandle ChainSyncEvent) -> IO ())
-> IO (ChainSyncHandle ChainSyncEvent) -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Trace IO ClientMsg
-> SlotConfig
-> NetworkId
-> [ChainPoint]
-> (ChainSyncEvent -> IO ())
-> IO (ChainSyncHandle ChainSyncEvent)
C.runChainSync
        (ChainIndexConfig -> String
Config.cicSocketPath ChainIndexConfig
config)
        Trace IO ClientMsg
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        (ChainIndexConfig -> SlotConfig
Config.cicSlotConfig ChainIndexConfig
config)
        (ChainIndexConfig -> NetworkId
Config.cicNetworkId  ChainIndexConfig
config)
        [ChainPoint]
resumePoints
        (ChainSyncHandler -> ChainSyncEvent -> IO ()
toCardanoChainSyncHandler ChainSyncHandler
syncHandler)

runChainIndexDuringSync
  :: RunRequirements
  -> Eff '[ChainIndexQueryEffect, ChainIndexControlEffect, BeamEffect Sqlite] a
  -> IO (Maybe a)
runChainIndexDuringSync :: RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite]
     a
-> IO (Maybe a)
runChainIndexDuringSync RunRequirements
runReq Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    BeamEffect Sqlite]
  a
effect = do
    Either ChainIndexError a
errOrResult <- RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite]
     a
-> IO (Either ChainIndexError a)
forall a.
RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite]
     a
-> IO (Either ChainIndexError a)
runChainIndexEffects RunRequirements
runReq Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    BeamEffect Sqlite]
  a
effect
    case Either ChainIndexError a
errOrResult of
        Left ChainIndexError
err -> do
            Trace IO ChainIndexLog -> Eff '[LogMsg ChainIndexLog, IO] ~> IO
forall (m :: * -> *) l.
MonadIO m =>
Trace m l -> Eff '[LogMsg l, m] ~> m
runLogEffects ((ChainIndexLog -> PrettyObject ChainIndexLog)
-> Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
convertLog ChainIndexLog -> PrettyObject ChainIndexLog
forall t. t -> PrettyObject t
PrettyObject (Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog)
-> Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog
forall a b. (a -> b) -> a -> b
$ RunRequirements -> Trace IO (PrettyObject ChainIndexLog)
CI.trace RunRequirements
runReq) (Eff '[LogMsg ChainIndexLog, IO] () -> IO ())
-> Eff '[LogMsg ChainIndexLog, IO] () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChainIndexLog -> Eff '[LogMsg ChainIndexLog, IO] ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
Log.logError (ChainIndexLog -> Eff '[LogMsg ChainIndexLog, IO] ())
-> ChainIndexLog -> Eff '[LogMsg ChainIndexLog, IO] ()
forall a b. (a -> b) -> a -> b
$ ChainIndexError -> ChainIndexLog
CI.Err ChainIndexError
err
            Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Right a
result -> do
            Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
result)