Revisit the solutions to add extra handlers

plutus-chain-index-core/src/Plutus/ChainIndex/Effects.hs

@@ -34,7 +34,6 @@ module Plutus.ChainIndex.Effects(
 import Control.Monad.Freer.Extras.Pagination (PageQuery)
 import Control.Monad.Freer.TH (makeEffect)
 import Ledger.Address (CardanoAddress)
-import Ledger.Credential (Credential)
 import Ledger.Tx (DecoratedTxOut, TxId, TxOutRef, Versioned)
 import Plutus.ChainIndex.Api (IsUtxoResponse, QueryResponse, TxosResponse, UtxosResponse)
 import Plutus.ChainIndex.Tx (ChainIndexTx)

plutus-contract/src/Plutus/Contract/Effects.hs

@@ -99,7 +99,6 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.String (fromString)
 import GHC.Generics (Generic)
 import Ledger.Address (CardanoAddress, toPlutusAddress)
-import Ledger.Credential (Credential)
 import Ledger.Scripts (Validator)
 import Ledger.Slot (Slot, SlotRange)
 import Ledger.Time (POSIXTime, POSIXTimeRange)
@@ -277,7 +276,7 @@ data ChainIndexQuery =
   | DatumsAtAddress (PageQuery TxOutRef) CardanoAddress
   | UtxoSetWithCurrency (PageQuery TxOutRef) AssetClass
   | TxsFromTxIds [TxId]
-  | TxoSetAtAddress (PageQuery TxOutRef) Credential
+  | TxoSetAtAddress (PageQuery TxOutRef) CardanoAddress
   | GetTip
     deriving stock (Eq, Show, Generic)
     deriving anyclass (ToJSON, FromJSON)
@@ -298,7 +297,7 @@ instance Pretty ChainIndexQuery where
         DatumsAtAddress _ addr          -> "requesting datums located at addresses with the credential" <+> pretty (toPlutusAddress addr)
         UtxoSetWithCurrency _ ac        -> "requesting utxos containing the asset class" <+> pretty ac
         TxsFromTxIds i                  -> "requesting chain index txs from ids" <+> pretty i
-        TxoSetAtAddress _ c             -> "requesting txos located at addresses with the credential" <+> pretty c
+        TxoSetAtAddress _ addr          -> "requesting txos located at addresses with the credential" <+> pretty (toPlutusAddress addr)
         GetTip                          -> "requesting the tip of the chain index"
 
 -- | Represents all possible responses to chain index queries. Each constructor

plutus-contract/src/Plutus/Contract/Marconi/Handler.hs

@@ -1,74 +1,59 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE TypeApplications    #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE GADTs            #-}
+{-# LANGUAGE LambdaCase       #-}
+{-# LANGUAGE RankNTypes       #-}
+{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators    #-}
 
 module Plutus.Contract.Marconi.Handler where
 
-import Cardano.Api (AddressInEra (AddressInEra), AddressTypeInEra (..), ChainPoint, TxIx (TxIx), toAddressAny)
+import Cardano.Api (AddressInEra (AddressInEra), AddressTypeInEra (..), TxIx (TxIx), toAddressAny)
 import Control.Concurrent (MVar, putMVar, readMVar)
-import Control.Lens (views, (^.))
+import Control.Lens (Lens', makeLenses, views, (&), (.~), (^.))
 import Control.Monad.Freer (Eff, LastMember, Member, interpret, type (~>))
 import Control.Monad.Freer.Error (Error, runError, throwError)
 import Control.Monad.Freer.Extras (raiseMUnderN)
 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.Maybe (fromJust)
 import Data.Set qualified as Set
 import Ledger.Address (CardanoAddress)
 import Ledger.Tx.CardanoAPI.Internal (fromCardanoTxId)
-import Marconi.ChainIndex.Indexers.Utxo (StorableQuery (UtxoAddress), UtxoHandle, UtxoIndexer, getUtxoResult, txId,
-                                         txIx, urUtxo)
-import Marconi.Core.Storable (HasPoint, QueryInterval (QEverything), Queryable, Rewindable, State, StorableEvent,
-                              StorableMonad, StorablePoint, StorableResult, query)
-import Marconi.Core.Storable qualified as Storable (rewind)
+import Marconi.ChainIndex.Indexers.Utxo (StorableQuery (UtxoAddress), UtxoHandle, getUtxoResult, txId, txIx, urUtxo)
+import Marconi.Core.Storable (HasPoint, QueryInterval (QEverything), Queryable, State, StorableEvent, StorableMonad,
+                              StorablePoint, StorableResult, insertMany, query)
 import Plutus.ChainIndex.Api (UtxosResponse (UtxosResponse))
 import Plutus.ChainIndex.ChainIndexError (ChainIndexError)
-import Plutus.ChainIndex.Compatibility (toCardanoPoint)
-import Plutus.ChainIndex.Effects (ChainIndexControlEffect (..), ChainIndexQueryEffect (UtxoSetAtAddress))
-import Plutus.ChainIndex.Types (ChainSyncBlock, Point, Tip (..))
+import Plutus.ChainIndex.Effects (ChainIndexControlEffect (AppendBlocks), ChainIndexQueryEffect (UtxoSetAtAddress))
+import Plutus.ChainIndex.Types (ChainSyncBlock, Tip (TipAtGenesis))
 import Plutus.V2.Ledger.Api (TxOutRef (TxOutRef))
 
+data ChainIndexIndexers -- We don't use `newtype` since other indexers will be needed
+   = ChainIndexIndexers
+       { _utxosIndexer :: State UtxoHandle
+       }
+
+makeLenses ''ChainIndexIndexers
+
 data MarconiEffect handle r where
   QueryIndexer :: StorableQuery handle -> MarconiEffect handle (StorableResult handle)
-  Rewind :: Point -> MarconiEffect handle ()
-  Index  :: ChainSyncBlock -> MarconiEffect handle ()
-  Resume  :: Point -> MarconiEffect handle ()
-
 
 makeEffect ''MarconiEffect
 
-
-handleMarconi ::
+handleMarconiQuery ::
     ( LastMember IO effs
-    , Member (Reader (State handle)) effs
+    , Member (Eff.State ChainIndexIndexers) effs
     , StorableMonad handle ~ IO
-    , StorablePoint handle ~ ChainPoint
     , HasPoint (StorableEvent handle) (StorablePoint handle)
     , Ord (StorablePoint handle)
     , Queryable handle
-    , Rewindable handle
     )
-    => (ChainSyncBlock -> [StorableEvent handle]) -> MarconiEffect handle ~> Eff effs
-handleMarconi _ (QueryIndexer q) = do
-    st <- ask
-    -- At the moment we query everything, we may need to find the latest common sync point in the future
-    liftIO $ query QEverything st q
-handleMarconi _f (Rewind point) = do
-    st <- ask
-    ix <- liftIO $ readMVar st
-    mix <- liftIO $ Storable.rewind (fromJust $ toCardanoPoint point) ix
-    maybe
-        (throwError  _a)
-        (liftIO $ writeTMVar st ix)
-        mix
-handleMarconi _f _others = undefined
+    => Lens' ChainIndexIndexers (State handle) -> MarconiEffect handle ~> Eff effs
+handleMarconiQuery l (QueryIndexer q) = do
+  ci <- Eff.get
+  liftIO $ query QEverything (ci ^. l) q
 
 getUtxoSetAtAddress
   :: forall effs.
@@ -91,6 +76,23 @@ getUtxoSetAtAddress pageQuery addrInEra = let
            . getUtxoResult
            <$> queryIndexer (UtxoAddress addr)
 
+
+handleControl ::
+    ( LastMember IO effs
+    , Member (Eff.State ChainIndexIndexers) effs
+    , Member (Error ChainIndexError) effs
+    ) =>
+    ChainIndexControlEffect ~> Eff effs
+handleControl = \case
+    AppendBlocks xs -> do
+        ci <- Eff.get
+        utxosIndexer' <- liftIO $ insertMany (extractUtxosEvent <$> xs) (ci ^. utxosIndexer)
+        Eff.put (ci & utxosIndexer .~ utxosIndexer')
+    _other -> throwError @ChainIndexError undefined
+    where
+        extractUtxosEvent :: ChainSyncBlock -> StorableEvent UtxoHandle
+        extractUtxosEvent = undefined
+
 handleQuery ::
     ( Member (MarconiEffect UtxoHandle) effs
     , Member (Error ChainIndexError) effs
@@ -100,28 +102,19 @@ handleQuery = \case
    UtxoSetAtAddress pageQuery addr -> getUtxoSetAtAddress pageQuery addr
    _eff                            -> throwError @ChainIndexError undefined
 
-handleControl ::
-    forall effs.
-    ( Member (Error ChainIndexError) effs
-    )
-    => ChainIndexControlEffect
-    ~> Eff effs
-handleControl = \case
-    _eff -> throwError @ChainIndexError undefined
-
 -- | Handle the chain index effects from the set of all effects.
 handleChainIndexEffects
-    :: (LastMember IO effs, StorableMonad UtxoIndexer ~ IO)
-    => MVar UtxoIndexer
+    :: LastMember IO effs
+    => MVar ChainIndexIndexers
     -> Eff (ChainIndexQueryEffect ': ChainIndexControlEffect ': MarconiEffect UtxoHandle ': effs) a
     -> Eff effs (Either ChainIndexError a)
 handleChainIndexEffects mutxos action = do
-    utxosIndexer <- liftIO $ readMVar mutxos
-    result <- runReader utxosIndexer
+    ciIndexers <- liftIO $ readMVar mutxos
+    (result, ciIndexers') <- Eff.runState ciIndexers
         $ runError @ChainIndexError
-        $ interpret (handleMarconi @_ @UtxoHandle)
+        $ interpret (handleMarconiQuery utxosIndexer)
         $ interpret handleControl
         $ interpret handleQuery
         $ raiseMUnderN @[_,_] @[_,_,_] action
-    liftIO $ putMVar mutxos utxosIndexer
+    liftIO $ putMVar mutxos ciIndexers'
     pure result

plutus-contract/src/Plutus/Contract/Request.hs

@@ -134,8 +134,8 @@ import GHC.Generics (Generic)
 import GHC.Natural (Natural)
 import GHC.TypeLits (Symbol, symbolVal)
 import Ledger (CardanoAddress, DiffMilliSeconds, POSIXTime, PaymentPubKeyHash (PaymentPubKeyHash), Slot, TxId, TxOutRef,
-               ValidatorHash (ValidatorHash), cardanoAddressCredential, cardanoPubKeyHash,
-               decoratedTxOutReferenceScript, fromMilliSeconds, getScriptHash, scriptHash, txOutRefId)
+               ValidatorHash (ValidatorHash), cardanoPubKeyHash, decoratedTxOutReferenceScript, fromMilliSeconds,
+               getScriptHash, scriptHash, txOutRefId)
 import Ledger.Tx (CardanoTx, DecoratedTxOut, Versioned, decoratedTxOutValue, getCardanoTxId)
 import Ledger.Tx.Constraints (TxConstraints)
 import Ledger.Tx.Constraints.OffChain (ScriptLookups, UnbalancedTx)
@@ -654,7 +654,7 @@ txoRefsAt ::
     -> CardanoAddress
     -> Contract w s e TxosResponse
 txoRefsAt pq addr = do
-  cir <- pabReq (ChainIndexQueryReq $ E.TxoSetAtAddress pq $ cardanoAddressCredential addr) E._ChainIndexQueryResp
+  cir <- pabReq (ChainIndexQueryReq $ E.TxoSetAtAddress pq addr) E._ChainIndexQueryResp
   case cir of
     E.TxoSetAtResponse r -> pure r
     r                    -> throwError $ review _ChainIndexContractError ("TxoSetAtAddress", r)

plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs

@@ -273,7 +273,7 @@ handleChainIndexQueries = RequestHandler $ \chainIndexQuery ->
         UnspentTxOutSetAtAddress pq c -> UnspentTxOutsAtResponse <$> ChainIndexEff.unspentTxOutSetAtAddress pq c
         DatumsAtAddress pq c          -> DatumsAtResponse <$> ChainIndexEff.datumsAtAddress pq c
         UtxoSetWithCurrency pq ac     -> UtxoSetWithCurrencyResponse <$> ChainIndexEff.utxoSetWithCurrency pq ac
-        TxoSetAtAddress pq c          -> TxoSetAtResponse <$> ChainIndexEff.txoSetAtAddress pq c
+        TxoSetAtAddress pq a          -> TxoSetAtResponse <$> ChainIndexEff.txoSetAtAddress pq a
         TxsFromTxIds txids            -> TxIdsResponse <$> ChainIndexEff.txsFromTxIds txids
         GetTip                        -> GetTipResponse <$> ChainIndexEff.getTip