{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

module Plutus.ChainIndex.Marconi where

import Cardano.Api (AddressInEra (AddressInEra), AddressTypeInEra (..), TxIx (TxIx), toAddressAny)
import Cardano.Api qualified as C
import Cardano.BM.Trace (Trace)
import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)
import Control.Lens (Lens', _1, folded, makeLenses, views, (&), (.~), (^.), (^..))
import Control.Monad.Freer (Eff, LastMember, Member, interpret, type (~>))
import Control.Monad.Freer.Error (Error, runError, throwError)
import Control.Monad.Freer.Extras
import Control.Monad.Freer.Extras.Pagination (PageQuery, pageOf)
import Control.Monad.Freer.Reader (Reader, ask, runReader)
import Control.Monad.Freer.State qualified as Eff (State, get, put, runState)
import Control.Monad.Freer.TH (makeEffect)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Foldable (foldl')
import Data.Map (elems)
import Data.Set qualified as Set
import Ledger.Address (CardanoAddress)
import Ledger.Tx (CardanoTx (CardanoTx))
import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (UtxoEvent), StorableQuery (UtxoByAddress), UtxoHandle,
                                         getInputs, getUtxoResult, getUtxosFromTxBody, txId, txIx, urUtxo)
import Marconi.Core.Storable (HasPoint, QueryInterval (QEverything), Queryable, State, StorableMonad, StorablePoint,
                              StorableResult, insertMany, query)
import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse))
import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..))
import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog)
import Plutus.ChainIndex.Compatibility (toCardanoPoint)
import Plutus.ChainIndex.Effects (ChainIndexControlEffect (AppendBlocks), ChainIndexQueryEffect (UtxoSetAtAddress))
import Plutus.ChainIndex.Types (ChainSyncBlock (..), Tip (TipAtGenesis), citxCardanoTx, tipAsPoint)
import Plutus.Contract.CardanoAPI (fromCardanoTxId)
import Plutus.Monitoring.Util (PrettyObject (PrettyObject), convertLog, runLogEffects)
import Plutus.V2.Ledger.Api (TxOutRef (TxOutRef))

{- Handling ChainIndexEffects with Marconi - Developer notes:

    The general idea is to transform `ChainIndexQueryEffect` into a @MarconiEffect@ for an handler,
    and to resolve these effects afterwards with a bunch of calls to `handleMarconiQuery`.

    The  main reason for this is that we mutualise the code that queries the handlers (see @handleMarconiQuery@) and we have a
    uniform way to query the different indexers.

    And a minor one:

        * There's no need of different handlers for @MarconiEffect@ at this stage but we leave the door open to it.
          A possible use case might be to provide a simpler indexer backend for the emulator.

    How to add new indexer to support new effect?

        1. add the indexer MVar to `ChainIndexIndexersMvar` and the corresponding indexer to `ChainIndexIndexers`
        2. edit `getChainIndexIndexers` and `putChainIndexIndexers` accordingly
        3. handle the appropriate queries of `ChainIndexQueries` in `handleQuery`
        4. Add the indexer update in the control operations
-}

data ChainIndexIndexers -- We don't use `newtype` since other indexers will be needed
   = ChainIndexIndexers
       { ChainIndexIndexers -> State UtxoHandle
_utxosIndexer :: State UtxoHandle
       }

makeLenses ''ChainIndexIndexers

data ChainIndexIndexersMVar -- We don't use `newtype` since other indexers will be needed
   = ChainIndexIndexersMVar
       { ChainIndexIndexersMVar -> MVar (State UtxoHandle)
_utxosIndexerMVar :: MVar (State UtxoHandle)
       }

boxChainIndexIndexers :: ChainIndexIndexers -> IO ChainIndexIndexersMVar
boxChainIndexIndexers :: ChainIndexIndexers -> IO ChainIndexIndexersMVar
boxChainIndexIndexers ChainIndexIndexers
ci =
  MVar (State UtxoHandle) -> ChainIndexIndexersMVar
ChainIndexIndexersMVar (MVar (State UtxoHandle) -> ChainIndexIndexersMVar)
-> IO (MVar (State UtxoHandle)) -> IO ChainIndexIndexersMVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       (State UtxoHandle -> IO (MVar (State UtxoHandle))
forall a. a -> IO (MVar a)
newMVar (State UtxoHandle -> IO (MVar (State UtxoHandle)))
-> State UtxoHandle -> IO (MVar (State UtxoHandle))
forall a b. (a -> b) -> a -> b
$ ChainIndexIndexers
ci ChainIndexIndexers
-> Getting (State UtxoHandle) ChainIndexIndexers (State UtxoHandle)
-> State UtxoHandle
forall s a. s -> Getting a s a -> a
^. Getting (State UtxoHandle) ChainIndexIndexers (State UtxoHandle)
Iso' ChainIndexIndexers (State UtxoHandle)
utxosIndexer)

makeLenses ''ChainIndexIndexersMVar

getChainIndexIndexers :: ChainIndexIndexersMVar -> IO ChainIndexIndexers
getChainIndexIndexers :: ChainIndexIndexersMVar -> IO ChainIndexIndexers
getChainIndexIndexers ChainIndexIndexersMVar
mvarCi =
    State UtxoHandle -> ChainIndexIndexers
ChainIndexIndexers (State UtxoHandle -> ChainIndexIndexers)
-> IO (State UtxoHandle) -> IO ChainIndexIndexers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar (State UtxoHandle) -> IO (State UtxoHandle)
forall a. MVar a -> IO a
takeMVar (ChainIndexIndexersMVar
mvarCi ChainIndexIndexersMVar
-> Getting
     (MVar (State UtxoHandle))
     ChainIndexIndexersMVar
     (MVar (State UtxoHandle))
-> MVar (State UtxoHandle)
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar (State UtxoHandle))
  ChainIndexIndexersMVar
  (MVar (State UtxoHandle))
Iso' ChainIndexIndexersMVar (MVar (State UtxoHandle))
utxosIndexerMVar)

putChainIndexIndexers :: ChainIndexIndexers -> ChainIndexIndexersMVar -> IO ()
putChainIndexIndexers :: ChainIndexIndexers -> ChainIndexIndexersMVar -> IO ()
putChainIndexIndexers ChainIndexIndexers
ci ChainIndexIndexersMVar
mvarCi = do
    MVar (State UtxoHandle) -> State UtxoHandle -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (ChainIndexIndexersMVar
mvarCi ChainIndexIndexersMVar
-> Getting
     (MVar (State UtxoHandle))
     ChainIndexIndexersMVar
     (MVar (State UtxoHandle))
-> MVar (State UtxoHandle)
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar (State UtxoHandle))
  ChainIndexIndexersMVar
  (MVar (State UtxoHandle))
Iso' ChainIndexIndexersMVar (MVar (State UtxoHandle))
utxosIndexerMVar) (ChainIndexIndexers
ci ChainIndexIndexers
-> Getting (State UtxoHandle) ChainIndexIndexers (State UtxoHandle)
-> State UtxoHandle
forall s a. s -> Getting a s a -> a
^. Getting (State UtxoHandle) ChainIndexIndexers (State UtxoHandle)
Iso' ChainIndexIndexers (State UtxoHandle)
utxosIndexer)



data MarconiEffect handle r where
  QueryIndexer :: StorableQuery handle -> MarconiEffect handle (StorableResult handle)

makeEffect ''MarconiEffect

handleMarconiQuery ::
    ( LastMember IO effs
    , Member (Eff.State ChainIndexIndexers) effs
    , StorableMonad handle ~ IO
    , HasPoint (StorableEvent handle) (StorablePoint handle)
    , Ord (StorablePoint handle)
    , Queryable handle
    )
    => Lens' ChainIndexIndexers (State handle) -> MarconiEffect handle ~> Eff effs
handleMarconiQuery :: Lens' ChainIndexIndexers (State handle)
-> MarconiEffect handle ~> Eff effs
handleMarconiQuery Lens' ChainIndexIndexers (State handle)
l (QueryIndexer StorableQuery handle
q) = do
  ChainIndexIndexers
ci <- Eff effs ChainIndexIndexers
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
Eff.get
  IO x -> Eff effs x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> Eff effs x) -> IO x -> Eff effs x
forall a b. (a -> b) -> a -> b
$ QueryInterval (StorablePoint handle)
-> State handle
-> StorableQuery handle
-> StorableMonad handle (StorableResult handle)
forall h.
(HasPoint (StorableEvent h) (StorablePoint h),
 Ord (StorablePoint h), Queryable h, PrimMonad (StorableMonad h)) =>
QueryInterval (StorablePoint h)
-> State h -> StorableQuery h -> StorableMonad h (StorableResult h)
query QueryInterval (StorablePoint handle)
forall p. QueryInterval p
QEverything (ChainIndexIndexers
ci ChainIndexIndexers
-> Getting (State handle) ChainIndexIndexers (State handle)
-> State handle
forall s a. s -> Getting a s a -> a
^. Getting (State handle) ChainIndexIndexers (State handle)
Lens' ChainIndexIndexers (State handle)
l) StorableQuery handle
q

getUtxoSetAtAddress
  :: forall effs.
    ( Member (MarconiEffect UtxoHandle) effs
    )
  => PageQuery TxOutRef
  -> CardanoAddress
  -> Eff effs UtxosResponse
getUtxoSetAtAddress :: PageQuery TxOutRef -> CardanoAddress -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery CardanoAddress
addrInEra = let
    toTxOutRef :: Utxo -> TxOutRef
toTxOutRef Utxo
utxo = TxId -> Integer -> TxOutRef
TxOutRef
                          (TxId -> TxId
fromCardanoTxId (TxId -> TxId) -> TxId -> TxId
forall a b. (a -> b) -> a -> b
$ Utxo
utxo Utxo -> Getting TxId Utxo TxId -> TxId
forall s a. s -> Getting a s a -> a
^. Getting TxId Utxo TxId
Lens' Utxo TxId
txId)
                          (Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Integer) -> (TxIx -> Word) -> TxIx -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(TxIx Word
x) -> Word
x) (TxIx -> Integer) -> TxIx -> Integer
forall a b. (a -> b) -> a -> b
$ Utxo
utxo Utxo -> Getting TxIx Utxo TxIx -> TxIx
forall s a. s -> Getting a s a -> a
^. Getting TxIx Utxo TxIx
Lens' Utxo TxIx
txIx)
    addr :: AddressAny
addr = case CardanoAddress
addrInEra of
                AddressInEra AddressTypeInEra addrtype BabbageEra
ByronAddressInAnyEra Address addrtype
addr'    -> Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny Address addrtype
addr'
                AddressInEra (ShelleyAddressInEra ShelleyBasedEra BabbageEra
_) Address addrtype
addr' -> Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny Address addrtype
addr'
    in Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
TipAtGenesis
           (Page TxOutRef -> UtxosResponse)
-> (StorableResult UtxoHandle -> Page TxOutRef)
-> StorableResult UtxoHandle
-> UtxosResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery
           (Set TxOutRef -> Page TxOutRef)
-> (StorableResult UtxoHandle -> Set TxOutRef)
-> StorableResult UtxoHandle
-> Page TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList
           ([TxOutRef] -> Set TxOutRef)
-> (StorableResult UtxoHandle -> [TxOutRef])
-> StorableResult UtxoHandle
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoRow -> TxOutRef) -> [UtxoRow] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LensLike' (Const TxOutRef) UtxoRow Utxo
-> (Utxo -> TxOutRef) -> UtxoRow -> TxOutRef
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const TxOutRef) UtxoRow Utxo
Lens' UtxoRow Utxo
urUtxo Utxo -> TxOutRef
toTxOutRef)
           ([UtxoRow] -> [TxOutRef])
-> (StorableResult UtxoHandle -> [UtxoRow])
-> StorableResult UtxoHandle
-> [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorableResult UtxoHandle -> [UtxoRow]
getUtxoResult
           (StorableResult UtxoHandle -> UtxosResponse)
-> Eff effs (StorableResult UtxoHandle) -> Eff effs UtxosResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorableQuery UtxoHandle -> Eff effs (StorableResult UtxoHandle)
forall handle (effs :: [* -> *]).
Member (MarconiEffect handle) effs =>
StorableQuery handle -> Eff effs (StorableResult handle)
queryIndexer (AddressAny -> Maybe SlotNo -> StorableQuery UtxoHandle
UtxoByAddress AddressAny
addr Maybe SlotNo
forall a. Maybe a
Nothing)


getUtxoEvents
  :: [CardanoTx]
  -> C.ChainPoint
  -> StorableEvent UtxoHandle -- ^ UtxoEvents are stored in storage after conversion to UtxoRow
getUtxoEvents :: [CardanoTx] -> ChainPoint -> StorableEvent UtxoHandle
getUtxoEvents [CardanoTx]
txs ChainPoint
cp =
  let utxosFromCardanoTx :: CardanoTx -> [Utxo]
utxosFromCardanoTx (CardanoTx (C.Tx TxBody era
txBody [KeyWitness era]
_) EraInMode era CardanoMode
_) = Map TxIn Utxo -> [Utxo]
forall k a. Map k a -> [a]
elems (Map TxIn Utxo -> [Utxo]) -> Map TxIn Utxo -> [Utxo]
forall a b. (a -> b) -> a -> b
$ Maybe TargetAddresses -> TxBody era -> Map TxIn Utxo
forall era.
IsCardanoEra era =>
Maybe TargetAddresses -> TxBody era -> Map TxIn Utxo
getUtxosFromTxBody Maybe TargetAddresses
forall a. Maybe a
Nothing TxBody era
txBody
      inputsFromCardanoTx :: CardanoTx -> Set TxIn
inputsFromCardanoTx (CardanoTx (C.Tx TxBody era
txBody [KeyWitness era]
_) EraInMode era CardanoMode
_) = TxBody era -> Set TxIn
forall era. TxBody era -> Set TxIn
getInputs TxBody era
txBody
      utxos :: Set Utxo
utxos = [Utxo] -> Set Utxo
forall a. Ord a => [a] -> Set a
Set.fromList ([Utxo] -> Set Utxo) -> [Utxo] -> Set Utxo
forall a b. (a -> b) -> a -> b
$ (CardanoTx -> [Utxo]) -> [CardanoTx] -> [Utxo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CardanoTx -> [Utxo]
utxosFromCardanoTx [CardanoTx]
txs
      ins :: Set TxIn
ins = (Set TxIn -> Set TxIn -> Set TxIn)
-> Set TxIn -> [Set TxIn] -> Set TxIn
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set TxIn
forall a. Set a
Set.empty ([Set TxIn] -> Set TxIn) -> [Set TxIn] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Set TxIn
inputsFromCardanoTx (CardanoTx -> Set TxIn) -> [CardanoTx] -> [Set TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CardanoTx]
txs
  in Set Utxo -> Set TxIn -> ChainPoint -> StorableEvent UtxoHandle
UtxoEvent Set Utxo
utxos Set TxIn
ins ChainPoint
cp

-- | The required arguments to run the chain index effects.
data RunRequirements = RunRequirements
    { RunRequirements -> Trace IO (PrettyObject ChainIndexLog)
trace    :: !(Trace IO (PrettyObject ChainIndexLog))
    , RunRequirements -> ChainIndexIndexersMVar
indexers :: !ChainIndexIndexersMVar
    }


-- | Run the chain index effects.
runChainIndexEffects
    :: RunRequirements
    -> Eff '[ChainIndexQueryEffect, ChainIndexControlEffect] a
    -> IO (Either ChainIndexError a)
runChainIndexEffects :: RunRequirements
-> Eff '[ChainIndexQueryEffect, ChainIndexControlEffect] a
-> IO (Either ChainIndexError a)
runChainIndexEffects RunRequirements
runReq Eff '[ChainIndexQueryEffect, ChainIndexControlEffect] a
action =
    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)
trace RunRequirements
runReq)
        (Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
 -> IO (Either ChainIndexError a))
-> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
-> IO (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ ChainIndexIndexersMVar
-> Eff
     '[Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
     (Either ChainIndexError a)
-> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader (RunRequirements -> ChainIndexIndexersMVar
indexers RunRequirements
runReq)
        (Eff
   '[Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
   (Either ChainIndexError a)
 -> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a))
-> Eff
     '[Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
     (Either ChainIndexError a)
-> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
  a
-> Eff
     '[Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
     (Either ChainIndexError a)
forall (effs :: [* -> *]) a.
(LastMember IO effs,
 Member (Reader ChainIndexIndexersMVar) effs) =>
Eff (ChainIndexQueryEffect : ChainIndexControlEffect : effs) a
-> Eff effs (Either ChainIndexError a)
handleChainIndexEffects
        (Eff
   '[ChainIndexQueryEffect, ChainIndexControlEffect,
     Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
   a
 -> Eff
      '[Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
      (Either ChainIndexError a))
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
     a
-> Eff
     '[Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
     (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ Eff '[ChainIndexQueryEffect, ChainIndexControlEffect] a
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       Reader ChainIndexIndexersMVar, LogMsg ChainIndexLog, IO]
     a
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd Eff '[ChainIndexQueryEffect, ChainIndexControlEffect] a
action

handleControl ::
    ( LastMember IO effs
    , Member (Eff.State ChainIndexIndexers) effs
    , Member (Error ChainIndexError) effs
    ) =>
    ChainIndexControlEffect ~> Eff effs
handleControl :: ChainIndexControlEffect ~> Eff effs
handleControl = \case
    AppendBlocks [ChainSyncBlock]
xs -> do
        ChainIndexIndexers
ci <- Eff effs ChainIndexIndexers
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
Eff.get
        State UtxoHandle
utxosIndexer' <- IO (State UtxoHandle) -> Eff effs (State UtxoHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (State UtxoHandle) -> Eff effs (State UtxoHandle))
-> IO (State UtxoHandle) -> Eff effs (State UtxoHandle)
forall a b. (a -> b) -> a -> b
$ [StorableEvent UtxoHandle]
-> State UtxoHandle -> StorableMonad UtxoHandle (State UtxoHandle)
forall (f :: * -> *) h.
(Foldable f, Buffered h, PrimMonad (StorableMonad h)) =>
f (StorableEvent h) -> State h -> StorableMonad h (State h)
insertMany (ChainSyncBlock -> StorableEvent UtxoHandle
extractUtxosEvent (ChainSyncBlock -> StorableEvent UtxoHandle)
-> [ChainSyncBlock] -> [StorableEvent UtxoHandle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChainSyncBlock]
xs) (ChainIndexIndexers
ci ChainIndexIndexers
-> Getting (State UtxoHandle) ChainIndexIndexers (State UtxoHandle)
-> State UtxoHandle
forall s a. s -> Getting a s a -> a
^. Getting (State UtxoHandle) ChainIndexIndexers (State UtxoHandle)
Iso' ChainIndexIndexers (State UtxoHandle)
utxosIndexer)
        ChainIndexIndexers -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
Eff.put (ChainIndexIndexers
ci ChainIndexIndexers
-> (ChainIndexIndexers -> ChainIndexIndexers) -> ChainIndexIndexers
forall a b. a -> (a -> b) -> b
& (State UtxoHandle -> Identity (State UtxoHandle))
-> ChainIndexIndexers -> Identity ChainIndexIndexers
Iso' ChainIndexIndexers (State UtxoHandle)
utxosIndexer ((State UtxoHandle -> Identity (State UtxoHandle))
 -> ChainIndexIndexers -> Identity ChainIndexIndexers)
-> State UtxoHandle -> ChainIndexIndexers -> ChainIndexIndexers
forall s t a b. ASetter s t a b -> b -> s -> t
.~ State UtxoHandle
utxosIndexer')
    ChainIndexControlEffect x
_other -> ChainIndexError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError ChainIndexError
UnsupportedControlOperation
    where
        extractUtxosEvent :: ChainSyncBlock -> StorableEvent UtxoHandle
extractUtxosEvent Block{Tip
blockTip :: ChainSyncBlock -> Tip
blockTip :: Tip
blockTip,[(ChainIndexTx, TxProcessOption)]
blockTxs :: ChainSyncBlock -> [(ChainIndexTx, TxProcessOption)]
blockTxs :: [(ChainIndexTx, TxProcessOption)]
blockTxs} = let
            point :: ChainPoint
point = Point -> ChainPoint
toCardanoPoint (Point -> ChainPoint) -> Point -> ChainPoint
forall a b. (a -> b) -> a -> b
$ Tip -> Point
tipAsPoint Tip
blockTip
            in [CardanoTx] -> ChainPoint -> StorableEvent UtxoHandle
getUtxoEvents
                ([(ChainIndexTx, TxProcessOption)]
blockTxs [(ChainIndexTx, TxProcessOption)]
-> Getting
     (Endo [CardanoTx]) [(ChainIndexTx, TxProcessOption)] CardanoTx
-> [CardanoTx]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((ChainIndexTx, TxProcessOption)
 -> Const (Endo [CardanoTx]) (ChainIndexTx, TxProcessOption))
-> [(ChainIndexTx, TxProcessOption)]
-> Const (Endo [CardanoTx]) [(ChainIndexTx, TxProcessOption)]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded (((ChainIndexTx, TxProcessOption)
  -> Const (Endo [CardanoTx]) (ChainIndexTx, TxProcessOption))
 -> [(ChainIndexTx, TxProcessOption)]
 -> Const (Endo [CardanoTx]) [(ChainIndexTx, TxProcessOption)])
-> ((CardanoTx -> Const (Endo [CardanoTx]) CardanoTx)
    -> (ChainIndexTx, TxProcessOption)
    -> Const (Endo [CardanoTx]) (ChainIndexTx, TxProcessOption))
-> Getting
     (Endo [CardanoTx]) [(ChainIndexTx, TxProcessOption)] CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTx -> Const (Endo [CardanoTx]) ChainIndexTx)
-> (ChainIndexTx, TxProcessOption)
-> Const (Endo [CardanoTx]) (ChainIndexTx, TxProcessOption)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((ChainIndexTx -> Const (Endo [CardanoTx]) ChainIndexTx)
 -> (ChainIndexTx, TxProcessOption)
 -> Const (Endo [CardanoTx]) (ChainIndexTx, TxProcessOption))
-> ((CardanoTx -> Const (Endo [CardanoTx]) CardanoTx)
    -> ChainIndexTx -> Const (Endo [CardanoTx]) ChainIndexTx)
-> (CardanoTx -> Const (Endo [CardanoTx]) CardanoTx)
-> (ChainIndexTx, TxProcessOption)
-> Const (Endo [CardanoTx]) (ChainIndexTx, TxProcessOption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CardanoTx -> Const (Endo [CardanoTx]) (Maybe CardanoTx))
-> ChainIndexTx -> Const (Endo [CardanoTx]) ChainIndexTx
Lens' ChainIndexTx (Maybe CardanoTx)
citxCardanoTx ((Maybe CardanoTx -> Const (Endo [CardanoTx]) (Maybe CardanoTx))
 -> ChainIndexTx -> Const (Endo [CardanoTx]) ChainIndexTx)
-> ((CardanoTx -> Const (Endo [CardanoTx]) CardanoTx)
    -> Maybe CardanoTx -> Const (Endo [CardanoTx]) (Maybe CardanoTx))
-> (CardanoTx -> Const (Endo [CardanoTx]) CardanoTx)
-> ChainIndexTx
-> Const (Endo [CardanoTx]) ChainIndexTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoTx -> Const (Endo [CardanoTx]) CardanoTx)
-> Maybe CardanoTx -> Const (Endo [CardanoTx]) (Maybe CardanoTx)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded)
                ChainPoint
point

handleQuery ::
    ( LastMember IO effs
    , Member (Eff.State ChainIndexIndexers) effs
    , Member (Error ChainIndexError) effs
    ) => ChainIndexQueryEffect
    ~> Eff effs
handleQuery :: ChainIndexQueryEffect ~> Eff effs
handleQuery = \case
    UtxoSetAtAddress PageQuery TxOutRef
pageQuery CardanoAddress
addr ->
        (MarconiEffect UtxoHandle ~> Eff effs)
-> Eff (MarconiEffect UtxoHandle : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' ChainIndexIndexers (State UtxoHandle)
-> MarconiEffect UtxoHandle ~> Eff effs
forall (effs :: [* -> *]) handle.
(LastMember IO effs, Member (State ChainIndexIndexers) effs,
 StorableMonad handle ~ IO,
 HasPoint (StorableEvent handle) (StorablePoint handle),
 Ord (StorablePoint handle), Queryable handle) =>
Lens' ChainIndexIndexers (State handle)
-> MarconiEffect handle ~> Eff effs
handleMarconiQuery Lens' ChainIndexIndexers (State UtxoHandle)
Iso' ChainIndexIndexers (State UtxoHandle)
utxosIndexer) (Eff (MarconiEffect UtxoHandle : effs) UtxosResponse
 -> Eff effs UtxosResponse)
-> Eff (MarconiEffect UtxoHandle : effs) UtxosResponse
-> Eff effs UtxosResponse
forall a b. (a -> b) -> a -> b
$ PageQuery TxOutRef
-> CardanoAddress
-> Eff (MarconiEffect UtxoHandle : effs) UtxosResponse
forall (effs :: [* -> *]).
Member (MarconiEffect UtxoHandle) effs =>
PageQuery TxOutRef -> CardanoAddress -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery CardanoAddress
addr
    ChainIndexQueryEffect x
_eff -> ChainIndexError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError ChainIndexError
UnsupportedQuery

-- | Handle the chain index effects from the set of all effects.
handleChainIndexEffects ::
    ( LastMember IO effs
    , Member (Reader ChainIndexIndexersMVar) effs
    )
    => Eff (ChainIndexQueryEffect ': ChainIndexControlEffect ': effs) a
    -> Eff effs (Either ChainIndexError a)
handleChainIndexEffects :: Eff (ChainIndexQueryEffect : ChainIndexControlEffect : effs) a
-> Eff effs (Either ChainIndexError a)
handleChainIndexEffects Eff (ChainIndexQueryEffect : ChainIndexControlEffect : effs) a
action = do
    ChainIndexIndexersMVar
mIndexers <- Eff effs ChainIndexIndexersMVar
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
    ChainIndexIndexers
indexers <- IO ChainIndexIndexers -> Eff effs ChainIndexIndexers
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainIndexIndexers -> Eff effs ChainIndexIndexers)
-> IO ChainIndexIndexers -> Eff effs ChainIndexIndexers
forall a b. (a -> b) -> a -> b
$ ChainIndexIndexersMVar -> IO ChainIndexIndexers
getChainIndexIndexers ChainIndexIndexersMVar
mIndexers
    (Either ChainIndexError a
result, ChainIndexIndexers
indexers') <- ChainIndexIndexers
-> Eff (State ChainIndexIndexers : effs) (Either ChainIndexError a)
-> Eff effs (Either ChainIndexError a, ChainIndexIndexers)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
Eff.runState ChainIndexIndexers
indexers
        (Eff (State ChainIndexIndexers : effs) (Either ChainIndexError a)
 -> Eff effs (Either ChainIndexError a, ChainIndexIndexers))
-> Eff (State ChainIndexIndexers : effs) (Either ChainIndexError a)
-> Eff effs (Either ChainIndexError a, ChainIndexIndexers)
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]) a.
Eff (Error ChainIndexError : effs) a
-> Eff effs (Either ChainIndexError a)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError @ChainIndexError
        (Eff (Error ChainIndexError : State ChainIndexIndexers : effs) a
 -> Eff
      (State ChainIndexIndexers : effs) (Either ChainIndexError a))
-> Eff (Error ChainIndexError : State ChainIndexIndexers : effs) a
-> Eff (State ChainIndexIndexers : effs) (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ (ChainIndexControlEffect
 ~> Eff (Error ChainIndexError : State ChainIndexIndexers : effs))
-> Eff
     (ChainIndexControlEffect
        : Error ChainIndexError : State ChainIndexIndexers : effs)
   ~> Eff (Error ChainIndexError : State ChainIndexIndexers : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(LastMember IO effs, Member (State ChainIndexIndexers) effs,
 Member (Error ChainIndexError) effs) =>
ChainIndexControlEffect ~> Eff effs
ChainIndexControlEffect
~> Eff (Error ChainIndexError : State ChainIndexIndexers : effs)
handleControl
        (Eff
   (ChainIndexControlEffect
      : Error ChainIndexError : State ChainIndexIndexers : effs)
   a
 -> Eff (Error ChainIndexError : State ChainIndexIndexers : effs) a)
-> Eff
     (ChainIndexControlEffect
        : Error ChainIndexError : State ChainIndexIndexers : effs)
     a
-> Eff (Error ChainIndexError : State ChainIndexIndexers : effs) a
forall a b. (a -> b) -> a -> b
$ (ChainIndexQueryEffect
 ~> Eff
      (ChainIndexControlEffect
         : Error ChainIndexError : State ChainIndexIndexers : effs))
-> Eff
     (ChainIndexQueryEffect
        : ChainIndexControlEffect : Error ChainIndexError
        : State ChainIndexIndexers : effs)
   ~> Eff
        (ChainIndexControlEffect
           : Error ChainIndexError : State ChainIndexIndexers : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(LastMember IO effs, Member (State ChainIndexIndexers) effs,
 Member (Error ChainIndexError) effs) =>
ChainIndexQueryEffect ~> Eff effs
ChainIndexQueryEffect
~> Eff
     (ChainIndexControlEffect
        : Error ChainIndexError : State ChainIndexIndexers : effs)
handleQuery
        (Eff
   (ChainIndexQueryEffect
      : ChainIndexControlEffect : Error ChainIndexError
      : State ChainIndexIndexers : effs)
   a
 -> Eff
      (ChainIndexControlEffect
         : Error ChainIndexError : State ChainIndexIndexers : effs)
      a)
-> Eff
     (ChainIndexQueryEffect
        : ChainIndexControlEffect : Error ChainIndexError
        : State ChainIndexIndexers : effs)
     a
-> Eff
     (ChainIndexControlEffect
        : Error ChainIndexError : State ChainIndexIndexers : effs)
     a
forall a b. (a -> b) -> a -> b
$ Eff ('[ChainIndexQueryEffect, ChainIndexControlEffect] :++: effs) a
-> Eff
     ('[ChainIndexQueryEffect, ChainIndexControlEffect]
      :++: ('[Error ChainIndexError, State ChainIndexIndexers]
            :++: effs))
     a
forall (effs' :: [* -> *]) (as :: [* -> *]) (effs :: [* -> *]).
(UnderN as, Weakens effs') =>
Eff (as :++: effs) ~> Eff (as :++: (effs' :++: effs))
raiseMUnderN @[_,_] @[_,_] Eff (ChainIndexQueryEffect : ChainIndexControlEffect : effs) a
Eff ('[ChainIndexQueryEffect, ChainIndexControlEffect] :++: effs) a
action
    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
$ ChainIndexIndexers -> ChainIndexIndexersMVar -> IO ()
putChainIndexIndexers ChainIndexIndexers
indexers' ChainIndexIndexersMVar
mIndexers
    Either ChainIndexError a -> Eff effs (Either ChainIndexError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ChainIndexError a
result