diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexError.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexError.hs index b93b09d0c6..4f45565cb6 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexError.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/ChainIndexError.hs @@ -19,17 +19,21 @@ data ChainIndexError = | QueryFailedNoTip -- ^ Query failed because the chain index does not have a tip (not synchronised with node) | BeamEffectError BeamError | ToCardanoError ToCardanoError + | UnsupportedQuery + | UnsupportedControlOperation deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON, ToJSON) instance Pretty ChainIndexError where pretty = \case - InsertionFailed err -> "Insertion failed" <> colon <+> pretty err - RollbackFailed err -> "Rollback failed" <> colon <+> pretty err - ResumeNotSupported -> "Resume is not supported" - QueryFailedNoTip -> "Query failed" <> colon <+> "No tip." - BeamEffectError err -> "Error during Beam operation" <> colon <+> pretty err - ToCardanoError err -> pretty err + InsertionFailed err -> "Insertion failed" <> colon <+> pretty err + RollbackFailed err -> "Rollback failed" <> colon <+> pretty err + ResumeNotSupported -> "Resume is not supported" + QueryFailedNoTip -> "Query failed" <> colon <+> "No tip." + BeamEffectError err -> "Error during Beam operation" <> colon <+> pretty err + ToCardanoError err -> pretty err + UnsupportedControlOperation -> "The given control operation is not supported" + UnsupportedQuery -> "The given query is not supported" -- | UTXO state could not be inserted into the chain index diff --git a/plutus-contract/src/Plutus/Contract/Marconi/Handler.hs b/plutus-contract/src/Plutus/Contract/Marconi/Handler.hs index 76e82c57a2..e1d960909d 100644 --- a/plutus-contract/src/Plutus/Contract/Marconi/Handler.hs +++ b/plutus-contract/src/Plutus/Contract/Marconi/Handler.hs @@ -25,23 +25,31 @@ import Control.Monad.Freer.TH (makeEffect) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Foldable (foldl') import Data.Maybe (fromJust) -import Data.Set (Set) import Data.Set qualified as Set import Ledger (CardanoTx (CardanoTx)) import Ledger.Address (CardanoAddress) import Ledger.Tx.CardanoAPI.Internal (fromCardanoTxId) -import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (UtxoEvent), StorableQuery (UtxoAddress), Utxo (..), UtxoHandle, - getInputs, getUtxoResult, getUtxos, txId, txIx, urUtxo) +import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (UtxoEvent), StorableQuery (UtxoAddress), UtxoHandle, getInputs, + getUtxoResult, getUtxos, 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.ChainIndexError (ChainIndexError (..)) import Plutus.ChainIndex.Compatibility (toCardanoBlockId) import Plutus.ChainIndex.Effects (ChainIndexControlEffect (AppendBlocks), ChainIndexQueryEffect (UtxoSetAtAddress)) import Plutus.ChainIndex.Types (ChainSyncBlock (..), Point (Point, PointAtGenesis), Tip (TipAtGenesis), citxCardanoTx, tipAsPoint) import Plutus.V2.Ledger.Api (TxOutRef (TxOutRef)) +{- Developer note: + 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. generate `MarconiEffect` on the appropriate queries of `ChainIndexQueries` in `handleQuery` + 4. Add the indexer update in the control operations + 5. Add the `handleMarconiQuery` for the new effect in `handleChainIndexEffects` +-} + data ChainIndexIndexers -- We don't use `newtype` since other indexers will be needed = ChainIndexIndexers { _utxosIndexer :: State UtxoHandle @@ -105,13 +113,6 @@ getUtxoSetAtAddress pageQuery addrInEra = let . getUtxoResult <$> queryIndexer (UtxoAddress addr) -utxosFromCardanoTx :: CardanoTx -> [Utxo] -utxosFromCardanoTx (CardanoTx c _) = getUtxos Nothing c - - -inputsFromCardanoTx :: CardanoTx -> Set C.TxIn -inputsFromCardanoTx (CardanoTx c _) = getInputs c - getUtxoEvents :: [CardanoTx] @@ -119,11 +120,13 @@ getUtxoEvents -> StorableEvent UtxoHandle -- ^ UtxoEvents are stored in storage after conversion to UtxoRow getUtxoEvents txs cp = let - + utxosFromCardanoTx (CardanoTx c _) = getUtxos Nothing c + inputsFromCardanoTx (CardanoTx c _) = getInputs c utxos = Set.fromList $ concatMap utxosFromCardanoTx txs ins = foldl' Set.union Set.empty $ inputsFromCardanoTx <$> txs in UtxoEvent utxos ins cp + handleControl :: ( LastMember IO effs , Member (Eff.State ChainIndexIndexers) effs @@ -135,7 +138,7 @@ handleControl = \case ci <- Eff.get utxosIndexer' <- liftIO $ insertMany (extractUtxosEvent <$> xs) (ci ^. utxosIndexer) Eff.put (ci & utxosIndexer .~ utxosIndexer') - _other -> throwError @ChainIndexError undefined + _other -> throwError UnsupportedControlOperation where toCardanoPoint PointAtGenesis = ChainPointAtGenesis toCardanoPoint (Point slot blockId) = @@ -153,7 +156,7 @@ handleQuery :: ~> Eff effs handleQuery = \case UtxoSetAtAddress pageQuery addr -> getUtxoSetAtAddress pageQuery addr - _eff -> throwError @ChainIndexError undefined + _eff -> throwError UnsupportedQuery -- | Handle the chain index effects from the set of all effects. handleChainIndexEffects