WIP: Add QueryHandle and QueryBackend

src/Contract/Monad.purs

@@ -110,6 +110,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error, throw)
 import Prim.TypeError (class Warn, Text)
+import Undefined (undefined)
 
 -- | The `Contract` monad is a newtype wrapper over `QueryM` which is `ReaderT`
 -- | on `QueryConfig` over asynchronous effects, `Aff`. Throwing and catching
@@ -307,7 +308,8 @@ mkContractEnv
     } = do
   let
     config =
-      { ctlServerConfig
+      { backend: undefined -- TODO:
+      , ctlServerConfig
       , ogmiosConfig
       , datumCacheConfig
       , kupoConfig
@@ -366,7 +368,8 @@ withContractEnv
   let
     config :: QueryConfig
     config =
-      { ctlServerConfig
+      { backend: undefined -- TODO:
+      , ctlServerConfig
       , ogmiosConfig
       , datumCacheConfig
       , kupoConfig

src/Contract/Utxos.purs

@@ -26,11 +26,10 @@ import Ctl.Internal.Plutus.Types.Transaction (UtxoMap) as X
 import Ctl.Internal.Plutus.Types.Value (Value)
 import Ctl.Internal.QueryM (getNetworkId)
 import Ctl.Internal.QueryM.Kupo (getUtxoByOref, utxosAt) as Kupo
+import Ctl.Internal.QueryM.QueryHandle (getQueryHandle)
 import Ctl.Internal.QueryM.Utxos (getWalletBalance, getWalletUtxos) as Utxos
 import Data.Maybe (Maybe)
 
--- | This module defines the functionality for requesting utxos via Kupo.
-
 -- | Queries for utxos at the given Plutus `Address`.
 utxosAt
   :: forall (r :: Row Type) (address :: Type)
@@ -40,7 +39,8 @@ utxosAt
 utxosAt address = do
   networkId <- wrapContract getNetworkId
   let cardanoAddr = fromPlutusAddress networkId (getAddress address)
-  cardanoUtxoMap <- liftedE $ wrapContract $ Kupo.utxosAt cardanoAddr
+  queryHandle <- wrapContract getQueryHandle
+  cardanoUtxoMap <- liftedE $ wrapContract $ queryHandle.utxosAt cardanoAddr
   toPlutusUtxoMap cardanoUtxoMap
     # liftContractM "utxosAt: failed to convert utxos"
 

src/Internal/Plutip/Server.purs

@@ -111,6 +111,7 @@ import Node.ChildProcess (defaultSpawnOptions)
 import Node.FS.Sync (exists, mkdir) as FSSync
 import Node.Path (FilePath, dirname)
 import Type.Prelude (Proxy(Proxy))
+import Undefined (undefined)
 
 -- | Run a single `Contract` in Plutip environment.
 runPlutipContract
@@ -747,7 +748,8 @@ mkClusterContractEnv plutipCfg logger customLogger = do
   pparams <- QueryM.getProtocolParametersAff ogmiosWs logger
   pure $ ContractEnv
     { config:
-        { ctlServerConfig: plutipCfg.ctlServerConfig
+        { backend: undefined -- TODO:
+        , ctlServerConfig: plutipCfg.ctlServerConfig
         , ogmiosConfig: plutipCfg.ogmiosConfig
         , datumCacheConfig: plutipCfg.ogmiosDatumCacheConfig
         , kupoConfig: plutipCfg.kupoConfig

src/Internal/QueryM.purs

@@ -17,6 +17,7 @@ module Ctl.Internal.QueryM
   , Logger
   , OgmiosListeners
   , OgmiosWebSocket
+  , QueryBackend(BlockfrostBackend, CtlBackend)
   , QueryConfig
   , QueryM
   , ParQueryM
@@ -277,6 +278,7 @@ import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error, error, throw, try)
 import Effect.Ref as Ref
 import Foreign.Object as Object
+import Undefined (undefined)
 import Untagged.Union (asOneOf)
 
 -- This module defines an Aff interface for Ogmios Websocket Queries
@@ -313,6 +315,15 @@ emptyHooks =
   , onError: Nothing
   }
 
+data QueryBackend
+  = CtlBackend
+      { ogmiosConfig :: ServerConfig
+      , kupoConfig :: ServerConfig
+      }
+  | BlockfrostBackend
+      { blockfrostConfig :: ServerConfig
+      }
+
 -- | `QueryConfig` contains a complete specification on how to initialize a
 -- | `QueryM` environment.
 -- | It includes:
@@ -322,10 +333,11 @@ emptyHooks =
 -- | - wallet setup instructions
 -- | - optional custom logger
 type QueryConfig =
-  { ctlServerConfig :: Maybe ServerConfig
-  , ogmiosConfig :: ServerConfig
-  , datumCacheConfig :: ServerConfig
-  , kupoConfig :: ServerConfig
+  { backend :: QueryBackend
+  , ctlServerConfig :: Maybe ServerConfig
+  , datumCacheConfig :: ServerConfig -- TODO: make optional
+  , ogmiosConfig :: ServerConfig -- TODO: remove, use `QueryBackend` instead
+  , kupoConfig :: ServerConfig -- TODO: remove, use `QueryBackend` instead
   , networkId :: NetworkId
   , logLevel :: LogLevel
   , walletSpec :: Maybe WalletSpec
@@ -343,11 +355,11 @@ type QueryConfig =
 -- | - A data structure to keep UTxOs that has already been spent
 -- | - Current protocol parameters
 type QueryRuntime =
-  { ogmiosWs :: OgmiosWebSocket
-  , datumCacheWs :: DatumCacheWebSocket
+  { ogmiosWs :: OgmiosWebSocket -- TODO: make optional
+  , datumCacheWs :: DatumCacheWebSocket -- TODO: make optional
   , wallet :: Maybe Wallet
   , usedTxOuts :: UsedTxOuts
-  , pparams :: Ogmios.ProtocolParameters
+  , pparams :: Ogmios.ProtocolParameters -- TODO: fetch using specified backend
   }
 
 -- | `QueryEnv` contains everything needed for `QueryM` to run.

src/Internal/QueryM/Blockfrost.purs

@@ -0,0 +1,17 @@
+module Ctl.Internal.QueryM.Blockfrost where
+
+import Prelude
+
+import Ctl.Internal.Cardano.Types.Transaction (UtxoMap)
+import Ctl.Internal.QueryM (ClientError, QueryM)
+import Ctl.Internal.Serialization.Address (Address)
+import Ctl.Internal.Types.Datum (DataHash, Datum)
+import Data.Either (Either)
+import Data.Maybe (Maybe)
+import Undefined (undefined)
+
+utxosAt :: Address -> QueryM (Either ClientError UtxoMap)
+utxosAt = undefined
+
+getDatumByHash :: DataHash -> QueryM (Either ClientError (Maybe Datum))
+getDatumByHash = undefined

src/Internal/QueryM/Config.purs

@@ -13,10 +13,12 @@ import Ctl.Internal.QueryM.ServerConfig
 import Ctl.Internal.Serialization.Address (NetworkId(TestnetId))
 import Data.Log.Level (LogLevel(Error, Trace))
 import Data.Maybe (Maybe(Just, Nothing))
+import Undefined (undefined)
 
 testnetTraceQueryConfig :: QueryConfig
 testnetTraceQueryConfig =
-  { ctlServerConfig: Just defaultServerConfig
+  { backend: undefined -- TODO:
+  , ctlServerConfig: Just defaultServerConfig
   , ogmiosConfig: defaultOgmiosWsConfig
   , datumCacheConfig: defaultDatumCacheWsConfig
   , kupoConfig: defaultKupoServerConfig

src/Internal/QueryM/Kupo.purs

@@ -1,5 +1,6 @@
 module Ctl.Internal.QueryM.Kupo
-  ( getUtxoByOref
+  ( getDatumByHash
+  , getUtxoByOref
   , utxosAt
   ) where
 

src/Internal/QueryM/QueryHandle.purs

@@ -0,0 +1,43 @@
+module Ctl.Internal.QueryM.QueryHandle where
+
+import Prelude
+
+import Control.Monad.Reader.Class (asks)
+import Ctl.Internal.Cardano.Types.ScriptRef (ScriptRef)
+import Ctl.Internal.Cardano.Types.Transaction (UtxoMap)
+import Ctl.Internal.QueryM
+  ( ClientError
+  , QueryBackend(BlockfrostBackend, CtlBackend)
+  , QueryM
+  )
+import Ctl.Internal.QueryM.Blockfrost (getDatumByHash, utxosAt) as Blockfrost
+import Ctl.Internal.QueryM.Kupo (getDatumByHash, utxosAt) as Kupo
+import Ctl.Internal.Serialization.Address (Address)
+import Ctl.Internal.Serialization.Hash (ScriptHash)
+import Ctl.Internal.Types.Datum (DataHash, Datum)
+import Data.Either (Either)
+import Data.Map (Map)
+import Data.Maybe (Maybe)
+
+type QueryME (a :: Type) = QueryM (Either ClientError a)
+
+type QueryHandle =
+  { utxosAt :: Address -> QueryME UtxoMap
+  , getDatumByHash :: DataHash -> QueryME (Maybe Datum)
+  -- , getDatumByHashes :: Array DataHash -> QueryME (Map DataHash Datum)
+  -- , getScriptByHash :: ScriptHash -> QueryME (Maybe ScriptRef)
+  -- , getScriptsByHashes :: Array ScriptHash -> QueryME (Map ScriptHash ScriptRef)
+  }
+
+getQueryHandle :: QueryM QueryHandle
+getQueryHandle =
+  asks (_.backend <<< _.config) <#> case _ of
+    CtlBackend _ ->
+      { utxosAt: Kupo.utxosAt
+      , getDatumByHash: Kupo.getDatumByHash
+      }
+    BlockfrostBackend _ ->
+      { utxosAt: Blockfrost.utxosAt
+      , getDatumByHash: Blockfrost.getDatumByHash
+      }
+