Fix blockfrost

pab-blockfrost/src/Plutus/Blockfrost/Client.hs

@@ -10,6 +10,7 @@ import Control.Monad.Freer.Reader (Reader, ask)
 import Control.Monad.IO.Class (MonadIO (..))
 import Plutus.ChainIndex.Effects (ChainIndexQueryEffect (..))
 
+import Ledger.Address (cardanoAddressCredential)
 import Plutus.Blockfrost.Queries
 import Plutus.Blockfrost.Responses
 import Plutus.Blockfrost.Types (BlockfrostEnv (..))
@@ -61,9 +62,9 @@ handleBlockfrostClient event = do
             TxFromTxId i                  -> (runClientMaybe . getTxFromTxIdBlockfrost . toBlockfrostTxHash) i      >>= processGetTxFromTxId
             TxsFromTxIds is               -> (runClientWithDef defaultGetList . getTxsFromTxIdsBlockfrost . toBlockfrostTxHashes) is >>= processGetTxsFromTxIds
             UtxoSetMembership r           -> (runClientWithDef defaultIsUtxo  . getIsUtxoBlockfrost . toBlockfrostRef) r                >>= processIsUtxo
-            UtxoSetAtAddress pq a         -> (runClientWithDef defaultGetUtxo . getUtxoAtAddressBlockfrost pq . credentialToAddress (envNetworkId bfEnv)) a  >>= processGetUtxos pq
+            UtxoSetAtAddress pq a         -> (runClientWithDef defaultGetUtxo . getUtxoAtAddressBlockfrost pq . fromCardanoAddressInEra) a  >>= processGetUtxos pq
             UtxoSetWithCurrency pq a      -> (runClientWithDef defaultGetUtxo . getUtxoSetWithCurrency pq . toBlockfrostAssetId) a      >>= processGetUtxos pq
-            TxoSetAtAddress pq a          -> (runClientWithDef defaultGetList . getTxoAtAddressBlockfrost pq . credentialToAddress (envNetworkId bfEnv)) a >>= processGetTxos pq
+            TxoSetAtAddress pq a          -> (runClientWithDef defaultGetList . getTxoAtAddressBlockfrost pq . fromCardanoAddressInEra) a >>= processGetTxos pq
             GetTip                        -> runClient getTipBlockfrost >>= processTip
-            UnspentTxOutSetAtAddress pq a -> (runClientWithDef defaultGetList . getUnspentAtAddressBlockfrost pq . credentialToAddress (envNetworkId bfEnv)) a  >>= processUnspentTxOutSetAtAddress pq a
-            DatumsAtAddress pq a          -> (runClientWithDef defaultGetList . getDatumsAtAddressBlockfrost pq . credentialToAddress (envNetworkId bfEnv)) a  >>= processDatumsAtAddress pq a
+            UnspentTxOutSetAtAddress pq a -> (runClientWithDef defaultGetList . getUnspentAtAddressBlockfrost pq . fromCardanoAddressInEra) a  >>= processUnspentTxOutSetAtAddress pq (cardanoAddressCredential a)
+            DatumsAtAddress pq a          -> (runClientWithDef defaultGetList . getDatumsAtAddressBlockfrost pq . fromCardanoAddressInEra) a  >>= processDatumsAtAddress pq (cardanoAddressCredential a)

pab-blockfrost/src/Plutus/Blockfrost/Utils.hs

@@ -20,7 +20,7 @@ import Cardano.Api.Shelley qualified as Api
 import Ledger.Slot qualified as Ledger (Slot (..), SlotRange)
 import Ledger.Tx (TxOutRef (..))
 import Ledger.Tx qualified as LT (ScriptTag (..), TxId (TxId))
-import Ledger.Tx.CardanoAPI
+import Ledger.Tx.CardanoAPI hiding (fromCardanoAddressInEra)
 import Ledger.Value.CardanoAPI qualified as Value
 import Money (Approximation (Round), DecimalConf (..), SomeDiscrete, UnitScale, defaultDecimalConf, discreteToDecimal,
               scale, someDiscreteAmount, someDiscreteCurrency)
@@ -91,10 +91,13 @@ toCardanoAddress bAddr = case deserialized of
     deserialized :: Maybe (Api.Address C.ShelleyAddr)
     deserialized = C.deserialiseAddress C.AsShelleyAddress (unAddress bAddr)
 
+fromCardanoAddressInEra :: C.AddressInEra C.BabbageEra -> Blockfrost.Address
+fromCardanoAddressInEra = mkAddress . C.serialiseAddress
+
 credentialToAddress :: C.NetworkId -> Credential -> Blockfrost.Address
 credentialToAddress netId c = case toCardanoAddressInEra netId pAddress of
     Left err   -> error $ show err
-    Right addr -> mkAddress $ C.serialiseAddress addr
+    Right addr -> fromCardanoAddressInEra addr
   where
     pAddress :: LA.Address
     pAddress = case c of

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

@@ -160,8 +160,8 @@ data IsUtxoResponse = IsUtxoResponse
     deriving (Show, Eq, Generic, FromJSON, ToJSON, OpenApi.ToSchema)
 
 data TxoAtAddressRequest = TxoAtAddressRequest
-    { pageQuery  :: Maybe (PageQuery TxOutRef)
-    , credential :: Credential
+    { pageQuery :: Maybe (PageQuery TxOutRef)
+    , address   :: CardanoAddress
     }
     deriving (Show, Eq, Generic, FromJSON, ToJSON, OpenApi.ToSchema)
 
@@ -173,8 +173,8 @@ data TxosResponse = TxosResponse
 
 
 data QueryAtAddressRequest = QueryAtAddressRequest
-    { pageQuery  :: Maybe (PageQuery TxOutRef)
-    , credential :: CardanoAddress
+    { pageQuery :: Maybe (PageQuery TxOutRef)
+    , address   :: CardanoAddress
     }
     deriving (Show, Eq, Generic, FromJSON, ToJSON, OpenApi.ToSchema)
 

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

@@ -72,14 +72,14 @@ data ChainIndexQueryEffect r where
     -- | Whether a tx output is part of the UTXO set
     UtxoSetMembership :: TxOutRef -> ChainIndexQueryEffect IsUtxoResponse
 
-    -- | Unspent outputs located at addresses with the given credential.
+    -- | Unspent outputs located at addresses with the given address.
     UtxoSetAtAddress :: PageQuery TxOutRef -> CardanoAddress -> ChainIndexQueryEffect UtxosResponse
 
     -- | Get the unspent txouts located at an address
     -- This is to avoid multiple queries from chain-index when using utxosAt
     UnspentTxOutSetAtAddress :: PageQuery TxOutRef -> CardanoAddress -> ChainIndexQueryEffect (QueryResponse [(TxOutRef, DecoratedTxOut)])
 
-    -- | get the datums located at addresses with the given credential.
+    -- | get the datums located at addresses with the given address.
     DatumsAtAddress :: PageQuery TxOutRef -> CardanoAddress -> ChainIndexQueryEffect (QueryResponse [Datum])
 
     -- | Unspent outputs containing a specific currency ('AssetClass').
@@ -91,8 +91,8 @@ data ChainIndexQueryEffect r where
     -- | Get the transactions for a list of tx IDs.
     TxsFromTxIds :: [TxId] -> ChainIndexQueryEffect [ChainIndexTx]
 
-    -- | Outputs located at addresses with the given credential.
-    TxoSetAtAddress :: PageQuery TxOutRef -> Credential -> ChainIndexQueryEffect TxosResponse
+    -- | Outputs located at addresses with the given address.
+    TxoSetAtAddress :: PageQuery TxOutRef -> CardanoAddress -> ChainIndexQueryEffect TxosResponse
 
     -- | Get the tip of the chain index
     GetTip :: ChainIndexQueryEffect Tip

plutus-chain-index-core/src/Plutus/ChainIndex/Emulator/Handlers.hs

@@ -257,9 +257,10 @@ handleQuery = \case
                 pure (UtxosResponse TipAtGenesis (pageOf pageQuery Set.empty))
             tp           -> pure (UtxosResponse tp page)
     TxsFromTxIds is -> catMaybes <$> mapM getTxFromTxId is
-    TxoSetAtAddress pageQuery cred -> do
+    TxoSetAtAddress pageQuery addr -> do
         state <- get
-        let outRefs = view (diskState . addressMap . at cred) state
+        let cred = cardanoAddressCredential addr
+            outRefs = view (diskState . addressMap . at cred) state
             txoRefs = fromMaybe mempty outRefs
             utxo = view (utxoIndex . to utxoState) state
             page = pageOf pageQuery txoRefs

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

@@ -102,7 +102,7 @@ handleQuery = \case
     DatumsAtAddress pageQuery addr -> getDatumsAtAddress pageQuery addr
     UtxoSetWithCurrency pageQuery assetClass ->
       getUtxoSetWithCurrency pageQuery assetClass
-    TxoSetAtAddress pageQuery cred -> getTxoSetAtAddress pageQuery cred
+    TxoSetAtAddress pageQuery addr -> getTxoSetAtAddress pageQuery addr
     TxsFromTxIds txids -> getTxsFromTxIds txids
     GetTip -> getTip
 
@@ -377,10 +377,11 @@ getTxoSetAtAddress
     , Member (LogMsg ChainIndexLog) effs
     )
   => PageQuery TxOutRef
-  -> Credential
+  -> CardanoAddress
   -> Eff effs TxosResponse
-getTxoSetAtAddress pageQuery (toDbValue -> cred) = do
+getTxoSetAtAddress pageQuery addr = do
   utxoState <- gets @ChainIndexState UtxoState.utxoState
+  let cred = toDbValue $ cardanoAddressCredential addr
   case UtxoState.tip utxoState of
       TipAtGenesis -> do
           logWarn TipIsGenesis

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

@@ -9,7 +9,7 @@
 
 module Plutus.Contract.Marconi.Handler where
 
-import Cardano.Api (AddressInEra (AddressInEra), AddressTypeInEra (..), TxIx (TxIx), toAddressAny)
+import Cardano.Api (AddressInEra (AddressInEra), AddressTypeInEra (..), ChainPoint, TxIx (TxIx), toAddressAny)
 import Control.Concurrent (MVar, putMVar, readMVar)
 import Control.Lens (views, (^.))
 import Control.Monad.Freer (Eff, LastMember, Member, interpret, type (~>))
@@ -19,22 +19,28 @@ import Control.Monad.Freer.Extras.Pagination (PageQuery, pageOf)
 import Control.Monad.Freer.Reader (Reader, ask, runReader)
 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, State, StorableEvent, StorableMonad,
-                              StorablePoint, StorableResult, query)
+import Marconi.Core.Storable (HasPoint, QueryInterval (QEverything), Queryable, Rewindable, State, StorableEvent,
+                              StorableMonad, StorablePoint, StorableResult, query)
+import Marconi.Core.Storable qualified as Storable (rewind)
 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 (Tip (..))
+import Plutus.ChainIndex.Types (ChainSyncBlock, Point, Tip (..))
 import Plutus.V2.Ledger.Api (TxOutRef (TxOutRef))
 
 data MarconiEffect handle r where
   QueryIndexer :: StorableQuery handle -> MarconiEffect handle (StorableResult handle)
-  Rewind :: Point -> Marconi handle ()
+  Rewind :: Point -> MarconiEffect handle ()
+  Index  :: ChainSyncBlock -> MarconiEffect handle ()
+  Resume  :: Point -> MarconiEffect handle ()
+
 
 makeEffect ''MarconiEffect
 
@@ -43,14 +49,26 @@ handleMarconi ::
     ( LastMember IO effs
     , Member (Reader (State handle)) effs
     , StorableMonad handle ~ IO
+    , StorablePoint handle ~ ChainPoint
     , HasPoint (StorableEvent handle) (StorablePoint handle)
     , Ord (StorablePoint handle)
     , Queryable handle
+    , Rewindable handle
     )
-    => MarconiEffect handle ~> Eff effs
-handleMarconi (QueryIndexer q) = do
-  st <- ask
-  liftIO $ query QEverything st q
+    => (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
 
 getUtxoSetAtAddress
   :: forall effs.