Limit parallel requests to Ogmios

package.json

@@ -31,7 +31,7 @@
   },
   "license": "MIT",
   "dependencies": {
-    "@mlabs-haskell/ctl-npm-meta": "2.0.0-beta.1"
+    "@mlabs-haskell/ctl-npm-meta": "2.0.0"
   },
   "devDependencies": {
     "@eslint/js": "^9.7.0",

packages.dhall

@@ -1,6 +1,6 @@
 let upstream =
     -- https://github.com/mlabs-haskell/purescript-cardano-package-set
-      https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v3.1.0/packages.dhall
-        sha256:0d8a7ca4e8ecfc8d1d795a989b76364caa9583d60e765c490cfa215a8824c246
+      https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v4.0.1/packages.dhall
+        sha256:738a4057532f0dc140978b02964432d281011514e7ab9482053adaef4e4e7027
 
 in upstream

src/Internal/Contract/Monad.purs

@@ -22,17 +22,16 @@ module Ctl.Internal.Contract.Monad
 
 import Prelude
 
-import Cardano.Blockfrost.Service
-  ( BlockfrostServiceM
-  , runBlockfrostServiceM
-  )
+import Cardano.Blockfrost.Service (BlockfrostServiceM, runBlockfrostServiceM)
 import Cardano.Blockfrost.Service as Blockfrost
-import Cardano.Kupmios.KupmiosM (KupmiosEnv, KupmiosM)
-import Cardano.Kupmios.Ogmios (getProtocolParameters, getSystemStartTime)
-import Cardano.Kupmios.Ogmios.Types
-  ( OgmiosDecodeError
-  , pprintOgmiosDecodeError
+import Cardano.Kupmios
+  ( KupmiosConfig
+  , KupmiosEnv
+  , KupmiosM
+  , initOgmiosRequestRateLimiter
   )
+import Cardano.Kupmios.Ogmios (getProtocolParameters, getSystemStartTime)
+import Cardano.Kupmios.Ogmios.Types (OgmiosDecodeError, pprintOgmiosDecodeError)
 import Cardano.Provider.Error (ClientError)
 import Cardano.Provider.Type (Provider)
 import Cardano.Types (NetworkId(TestnetId, MainnetId), TransactionHash, UtxoMap)
@@ -79,7 +78,7 @@ import Data.Maybe (Maybe(Just, Nothing), fromMaybe)
 import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set)
 import Data.Set as Set
-import Data.Time.Duration (Milliseconds, Seconds)
+import Data.Time.Duration (Milliseconds(Milliseconds), Seconds)
 import Data.Traversable (for_, traverse)
 import Effect.Aff (Aff, ParAff, attempt, error, finally, supervise)
 import Effect.Aff.Class (class MonadAff, liftAff)
@@ -264,8 +263,10 @@ buildBackend _ = case _ of
   where
   buildCtlBackend :: CtlBackendParams -> Aff CtlBackend
   buildCtlBackend { ogmiosConfig, kupoConfig } = do
+    sem <- initOgmiosRequestRateLimiter { maxParallelRequests: 5 }
     pure
       { ogmiosConfig
+      , ogmiosRequestRateLimiter: Just sem
       , kupoConfig
       }
 
@@ -446,25 +447,32 @@ wrapKupmiosM qm = do
   liftAff $ runKupmiosM contractEnv ctlBackend qm
 
 runKupmiosM
-  :: forall (a :: Type) (rest :: Row Type)
-   . LogParams rest
+  :: forall (a :: Type) (r :: Row Type)
+   . LogParams r
   -> CtlBackend
   -> KupmiosM a
   -> Aff a
-runKupmiosM params ctlBackend =
-  flip runReaderT (mkKupmiosEnv params ctlBackend) <<< unwrap
-
-mkKupmiosEnv
-  :: forall (rest :: Row Type). LogParams rest -> CtlBackend -> KupmiosEnv
-mkKupmiosEnv params ctlBackend =
-  { config:
-      { ogmiosConfig: ctlBackend.ogmiosConfig
-      , kupoConfig: ctlBackend.kupoConfig
-      , logLevel: params.logLevel
-      , customLogger: params.customLogger
-      , suppressLogs: params.suppressLogs
-      }
-  }
+runKupmiosM params ctlBackend = flip runReaderT env <<< unwrap
+  where
+  env :: KupmiosEnv
+  env =
+    { config
+    , ogmiosRequestRateLimiter: ctlBackend.ogmiosRequestRateLimiter
+    }
+
+  config :: KupmiosConfig
+  config =
+    { ogmios:
+        { serverConfig: ctlBackend.ogmiosConfig
+        , requestRateLimiterCooldown: Just $ Milliseconds 300.0
+        }
+    , kupo:
+        { serverConfig: ctlBackend.kupoConfig
+        }
+    , logLevel: params.logLevel
+    , customLogger: params.customLogger
+    , suppressLogs: params.suppressLogs
+    }
 
 --------------------------------------------------------------------------------
 -- Helpers