harmonize network manager handling

## Description

### I want to speak to the `Manager`

Oh boy. This PR is both fairly straightforward and overreaching, so let's break it down.

For most network access, we need a [`HTTP.Manager`](https://hackage.haskell.org/package/http-client-0.1.0.0/docs/Network-HTTP-Client-Manager.html). It is created only once, at the top level, when starting the engine, and is then threaded through the application to wherever we need to make a network call. As of main, the way we do this is not standardized: most of the GraphQL execution code passes it "manually" as a function argument throughout the code. We also have a custom monad constraint, `HasHttpManagerM`, that describes a monad's ability to provide a manager. And, finally, several parts of the code store the manager in some kind of argument structure, such as `RunT`'s `RunCtx`.

This PR's first goal is to harmonize all of this: we always create the manager at the root, and we already have it when we do our very first `runReaderT`. Wouldn't it make sense for the rest of the code to not manually pass it anywhere, to not store it anywhere, but to always rely on the current monad providing it? This is, in short, what this PR does: it implements a constraint on the base monads, so that they provide the manager, and removes most explicit passing from the code.

### First come, first served

One way this PR goes a tiny bit further than "just" doing the aforementioned harmonization is that it starts the process of implementing the "Services oriented architecture" roughly outlined in this [draft document](https://docs.google.com/document/d/1FAigqrST0juU1WcT4HIxJxe1iEBwTuBZodTaeUvsKqQ/edit?usp=sharing). Instead of using the existing `HasHTTPManagerM`, this PR revamps it into the `ProvidesNetwork` service.

The idea is, again, that we should make all "external" dependencies of the engine, all things that the core of the engine doesn't care about, a "service". This allows us to define clear APIs for features, to choose different implementations based on which version of the engine we're running, harmonizes our many scattered monadic constraints... Which is why this service is called "Network": we can refine it, moving forward, to be the constraint that defines how all network communication is to operate, instead of relying on disparate classes constraint or hardcoded decisions. A comment in the code clarifies this intent.

### Side-effects? In my Haskell?

This PR also unavoidably touches some other aspects of the codebase. One such example: it introduces `Hasura.App.AppContext`, named after `HasuraPro.Context.AppContext`: a name for the reader structure at the base level. It also transforms `Handler` from a type alias to a newtype, as `Handler` is where we actually enforce HTTP limits; but without `Handler` being a distinct type, any code path could simply do a `runExceptT $ runReader` and forget to enforce them.

(As a rule of thumb, i am starting to consider any straggling `runReaderT` or `runExceptT` as a code smell: we should not stack / unstack monads haphazardly, and every layer should be an opaque `newtype` with a corresponding run function.)

## Further work

In several places, i have left TODOs when i have encountered things that suggest that we should do further unrelated cleanups. I'll write down the follow-up steps, either in the aforementioned document or on slack. But, in short, at a glance, in approximate order, we could:

- delete `ExecutionCtx` as it is only a subset of `ServerCtx`, and remove one more `runReaderT` call
- delete `ServerConfigCtx` as it is only a subset of `ServerCtx`, and remove it from `RunCtx`
- remove `ServerCtx` from `HandlerCtx`, and make it part of `AppContext`, or even make it the `AppContext` altogether (since, at least for the OSS version, `AppContext` is there again only a subset)
- remove `CacheBuildParams` and `CacheBuild` altogether, as they're just a distinct stack that is a `ReaderT` on top of `IO` that contains, you guessed it, the same thing as `ServerCtx`
- move `RunT` out of `RQL.Types` and rename it, since after the previous cleanups **it only contains `UserInfo`**; it could be bundled with the authentication service, made a small implementation detail in `Hasura.Server.Auth`
-  rename `PGMetadaStorageT` to something a bit more accurate, such as `App`, and enforce its IO base

This would significantly simply our complex stack. From there, or in parallel, we can start moving existing dependencies as Services. For the purpose of supporting read replicas entitlement, we could move `MonadResolveSource` to a `SourceResolver` service, as attempted in #7653, and transform `UserAuthenticationM` into a `Authentication` service.

PR-URL: hasura/graphql-engine-mono#7736
GitOrigin-RevId: 68cce710eb9e7d752bda1ba0c49541d24df8209f

server/graphql-engine.cabal

@@ -756,6 +756,8 @@ library
                      , Hasura.Server.Migrate.Internal
                      , Hasura.Server.Auth.JWT.Internal
                      , Hasura.Server.Auth.JWT.Logging
+                     , Hasura.Services
+                     , Hasura.Services.Network
                      , Hasura.RemoteSchema.Metadata.Base
                      , Hasura.RemoteSchema.Metadata.Customization
                      , Hasura.RemoteSchema.Metadata.Permission
@@ -987,7 +989,6 @@ library
                      , Hasura.Tracing.TraceId
                      , Hasura.QueryTags
                      , Network.HTTP.Client.Transformable
-                     , Network.HTTP.Client.Manager
                      , Network.HTTP.Client.DynamicTlsPermissions
                      , Network.HTTP.Client.Restricted
                      , Network.HTTP.Client.Blocklisting

server/lib/test-harness/src/Harness/GraphqlEngine.hs

@@ -317,24 +317,29 @@ runApp serveOptions = do
   env <- Env.getEnvironment
   initTime <- liftIO getCurrentTime
   globalCtx <- App.initGlobalCtx env metadataDbUrl rci
-  (ekgStore, serverMetrics) <- liftIO do
-    store <- EKG.newStore @TestMetricsSpec
-    serverMetrics <- liftIO . createServerMetrics $ EKG.subset ServerSubset store
-    pure (EKG.subset EKG.emptyOf store, serverMetrics)
+  (ekgStore, serverMetrics) <-
+    liftIO $ do
+      store <- EKG.newStore @TestMetricsSpec
+      serverMetrics <-
+        liftIO $ createServerMetrics $ EKG.subset ServerSubset store
+      pure (EKG.subset EKG.emptyOf store, serverMetrics)
   prometheusMetrics <- makeDummyPrometheusMetrics
-  let managedServerCtx = App.initialiseServerCtx env globalCtx serveOptions Nothing serverMetrics prometheusMetrics sampleAlways (FeatureFlag.checkFeatureFlag env)
+  let featureFlag = FeatureFlag.checkFeatureFlag env
+      managedServerCtx = App.initialiseServerCtx env globalCtx serveOptions Nothing serverMetrics prometheusMetrics sampleAlways featureFlag
   runManagedT managedServerCtx \serverCtx@ServerCtx {..} -> do
     let Loggers _ _ pgLogger = scLoggers
-    flip App.runPGMetadataStorageAppT (scMetadataDbPool, pgLogger) . lowerManagedT $
-      App.runHGEServer
-        (const $ pure ())
-        env
-        serveOptions
-        serverCtx
-        initTime
-        Nothing
-        ekgStore
-        (FeatureFlag.checkFeatureFlag env)
+        appContext = App.AppContext scManager pgLogger scMetadataDbPool
+    flip App.runPGMetadataStorageAppT appContext $
+      lowerManagedT $
+        App.runHGEServer
+          (const $ pure ())
+          env
+          serveOptions
+          serverCtx
+          initTime
+          Nothing
+          ekgStore
+          featureFlag
 
 -- | Used only for 'runApp' above.
 data TestMetricsSpec name metricType tags

server/src-emit-metadata-openapi/Main.hs

@@ -1,11 +1,9 @@
 module Main (main) where
 
 import Data.Aeson.Encode.Pretty (encodePretty)
-import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Lazy.Char8 qualified as LBS
 import Hasura.Server.MetadataOpenAPI (metadataOpenAPI)
 import Prelude
 
 main :: IO ()
-main = do
-  LBS.putStr $ encodePretty metadataOpenAPI
-  putStrLn ""
+main = LBS.putStrLn $ encodePretty metadataOpenAPI

server/src-exec/Main.hs

@@ -97,7 +97,10 @@ runApp env (HGEOptions rci metadataDbUrl hgeCmd) = do
           C.forkImmortal "ourIdleGC" logger $
             GC.ourIdleGC logger (seconds 0.3) (seconds 10) (seconds 60)
 
-        flip runPGMetadataStorageAppT (scMetadataDbPool, pgLogger) . lowerManagedT $ do
+        -- TODO: why don't we just run a reader with ServerCtx from here?
+        -- the AppContext doesn't add any new information
+        let appContext = AppContext scManager pgLogger scMetadataDbPool
+        flip runPGMetadataStorageAppT appContext . lowerManagedT $ do
           runHGEServer (const $ pure ()) env serveOptions serverCtx initTime Nothing ekgStore (FeatureFlag.checkFeatureFlag env)
     HCExport -> do
       GlobalCtx {..} <- initGlobalCtx env metadataDbUrl rci

server/src-lib/Hasura/App.hs

@@ -3,11 +3,16 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
--- | Imported by 'server/src-exec/Main.hs'.
+-- | Defines the CE version of the engine.
+--
+-- This module contains everything that is required to run the community edition
+-- of the engine: the base application monad and the implementation of all its
+-- behaviour classes.
 module Hasura.App
   ( ExitCode (AuthConfigurationError, DatabaseMigrationError, DowngradeProcessError, MetadataCleanError, MetadataExportError, SchemaCacheInitError),
     ExitException (ExitException),
     GlobalCtx (..),
+    AppContext (..),
     PGMetadataStorageAppT (runPGMetadataStorageAppT),
     accessDeniedErrMsg,
     flushLogger,
@@ -140,13 +145,13 @@ import Hasura.Server.SchemaUpdate
 import Hasura.Server.Telemetry
 import Hasura.Server.Types
 import Hasura.Server.Version
+import Hasura.Services
 import Hasura.Session
 import Hasura.ShutdownLatch
 import Hasura.Tracing qualified as Tracing
 import Network.HTTP.Client qualified as HTTP
 import Network.HTTP.Client.Blocklisting (Blocklist)
 import Network.HTTP.Client.CreateManager (mkHttpManager)
-import Network.HTTP.Client.Manager (HasHttpManagerM (..))
 import Network.Wai (Application)
 import Network.Wai.Handler.Warp qualified as Warp
 import Options.Applicative
@@ -267,8 +272,17 @@ initGlobalCtx env metadataDbUrl defaultPgConnInfo = do
       let mdConnInfo = mkConnInfoFromMDb mdUrl
       mkGlobalCtx mdConnInfo (Just (dbUrl, srcConnInfo))
 
+-- | Base application context.
+--
+-- This defines all base information required to run the engine.
+data AppContext = AppContext
+  { _acHTTPManager :: HTTP.Manager,
+    _acPGLogger :: PG.PGLogger,
+    _acPGPool :: PG.PGPool
+  }
+
 -- | An application with Postgres database as a metadata storage
-newtype PGMetadataStorageAppT m a = PGMetadataStorageAppT {runPGMetadataStorageAppT :: (PG.PGPool, PG.PGLogger) -> m a}
+newtype PGMetadataStorageAppT m a = PGMetadataStorageAppT {runPGMetadataStorageAppT :: AppContext -> m a}
   deriving
     ( Functor,
       Applicative,
@@ -278,17 +292,19 @@ newtype PGMetadataStorageAppT m a = PGMetadataStorageAppT {runPGMetadataStorageA
       MonadCatch,
       MonadThrow,
       MonadMask,
-      HasHttpManagerM,
       HasServerConfigCtx,
-      MonadReader (PG.PGPool, PG.PGLogger),
+      MonadReader AppContext,
       MonadBase b,
       MonadBaseControl b
     )
-    via (ReaderT (PG.PGPool, PG.PGLogger) m)
+    via (ReaderT AppContext m)
   deriving
     ( MonadTrans
     )
-    via (ReaderT (PG.PGPool, PG.PGLogger))
+    via (ReaderT AppContext)
+
+instance Monad m => ProvidesNetwork (PGMetadataStorageAppT m) where
+  askHTTPManager = asks _acHTTPManager
 
 resolvePostgresConnInfo ::
   (MonadIO m) => Env.Environment -> UrlConf -> Maybe Int -> m PG.ConnInfo
@@ -596,7 +612,8 @@ runHGEServer ::
     MonadMetadataStorageQueryAPI m,
     MonadResolveSource m,
     EB.MonadQueryTags m,
-    MonadEventLogCleanup m
+    MonadEventLogCleanup m,
+    ProvidesHasuraServices m
   ) =>
   (ServerCtx -> Spock.SpockT m ()) ->
   Env.Environment ->
@@ -687,7 +704,8 @@ mkHGEServer ::
     MonadMetadataStorageQueryAPI m,
     MonadResolveSource m,
     EB.MonadQueryTags m,
-    MonadEventLogCleanup m
+    MonadEventLogCleanup m,
+    ProvidesHasuraServices m
   ) =>
   (ServerCtx -> Spock.SpockT m ()) ->
   Env.Environment ->
@@ -765,7 +783,6 @@ mkHGEServer setupHook env ServeOptions {..} serverCtx@ServerCtx {..} ekgStore ch
   _ <-
     startSchemaSyncProcessorThread
       logger
-      scManager
       scMetaVersionRef
       cacheRef
       scInstanceId
@@ -1006,7 +1023,6 @@ mkHGEServer setupHook env ServeOptions {..} serverCtx@ServerCtx {..} ekgStore ch
               logger
               (getSchemaCache cacheRef)
               (leActionEvents lockedEventsCtx)
-              scManager
               scPrometheusMetrics
               sleepTime
               Nothing
@@ -1137,7 +1153,7 @@ instance (MonadIO m) => WS.MonadWSLog (PGMetadataStorageAppT m) where
   logWSLog logger = unLogger logger
 
 instance (Monad m) => MonadResolveSource (PGMetadataStorageAppT m) where
-  getPGSourceResolver = mkPgSourceResolver <$> asks snd
+  getPGSourceResolver = mkPgSourceResolver <$> asks _acPGLogger
   getMSSQLSourceResolver = return mkMSSQLSourceResolver
 
 instance (Monad m) => EB.MonadQueryTags (PGMetadataStorageAppT m) where
@@ -1153,7 +1169,7 @@ runInSeparateTx ::
   PG.TxE QErr a ->
   PGMetadataStorageAppT m (Either QErr a)
 runInSeparateTx tx = do
-  pool <- asks fst
+  pool <- asks _acPGPool
   liftIO $ runExceptT $ PG.runTx pool (PG.RepeatableRead, Nothing) tx
 
 notifySchemaCacheSyncTx :: MetadataResourceVersion -> InstanceId -> CacheInvalidations -> PG.TxE QErr ()

server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs

@@ -46,11 +46,11 @@ import Hasura.SQL.Backend (BackendSourceKind (..), BackendType (..))
 import Hasura.SQL.Types (CollectableType (..))
 import Hasura.Server.Migrate.Version (SourceCatalogMigrationState (..))
 import Hasura.Server.Utils qualified as HSU
+import Hasura.Services.Network
 import Hasura.Session (SessionVariable, mkSessionVariable)
 import Hasura.Tracing (ignoreTraceT)
 import Language.GraphQL.Draft.Syntax qualified as GQL
 import Network.HTTP.Client qualified as HTTP
-import Network.HTTP.Client.Manager
 import Servant.Client.Core.HasClient ((//))
 import Servant.Client.Generic (genericClient)
 import Witch qualified
@@ -82,7 +82,7 @@ resolveBackendInfo' ::
     ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr,
     MonadIO m,
     MonadBaseControl IO m,
-    HasHttpManagerM m
+    ProvidesNetwork m
   ) =>
   Logger Hasura ->
   (Inc.Dependency (Maybe (HashMap DC.DataConnectorName Inc.InvalidationKey)), InsOrdHashMap DC.DataConnectorName DC.DataConnectorOptions) `arr` HashMap DC.DataConnectorName DC.DataConnectorInfo
@@ -103,12 +103,12 @@ resolveBackendInfo' logger = proc (invalidationKeys, optionsMap) -> do
         ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr,
         MonadIO m,
         MonadBaseControl IO m,
-        HasHttpManagerM m
+        ProvidesNetwork m
       ) =>
       (Inc.Dependency (Maybe (HashMap DC.DataConnectorName Inc.InvalidationKey)), DC.DataConnectorName, DC.DataConnectorOptions) `arr` Maybe DC.DataConnectorInfo
     getDataConnectorCapabilitiesIfNeeded = Inc.cache proc (invalidationKeys, dataConnectorName, dataConnectorOptions) -> do
       let metadataObj = MetadataObject (MODataConnectorAgent dataConnectorName) $ J.toJSON dataConnectorName
-      httpMgr <- bindA -< askHttpManager
+      httpMgr <- bindA -< askHTTPManager
       Inc.dependOn -< Inc.selectMaybeD (Inc.ConstS dataConnectorName) invalidationKeys
       (|
         withRecordInconsistency

server/src-lib/Hasura/GraphQL/Execute.hs

@@ -59,19 +59,21 @@ import Hasura.SQL.Backend
 import Hasura.Server.Init qualified as Init
 import Hasura.Server.Prometheus (PrometheusMetrics)
 import Hasura.Server.Types (ReadOnlyMode (..), RequestId (..))
+import Hasura.Services
 import Hasura.Session
 import Hasura.Tracing qualified as Tracing
 import Language.GraphQL.Draft.Syntax qualified as G
-import Network.HTTP.Client qualified as HTTP
 import Network.HTTP.Types qualified as HTTP
 
 -- | Execution context
+--
+-- TODO: can this be deduplicated with Run? is there anything in here that isn't
+-- already in the stack?
 data ExecutionCtx = ExecutionCtx
   { _ecxLogger :: L.Logger L.Hasura,
     _ecxSqlGenCtx :: SQLGenCtx,
     _ecxSchemaCache :: SchemaCache,
     _ecxSchemaCacheVer :: SchemaCacheVer,
-    _ecxHttpManager :: HTTP.Manager,
     _ecxEnableAllowList :: Init.AllowListStatus,
     _ecxReadOnlyMode :: ReadOnlyMode,
     _ecxPrometheusMetrics :: PrometheusMetrics
@@ -310,6 +312,8 @@ checkQueryInAllowlist allowListStatus allowlistMode userInfo req schemaCache =
 
 -- | Construct a 'ResolvedExecutionPlan' from a 'GQLReqParsed' and a
 -- bunch of metadata.
+--
+-- Labelling it as inlineable fixed a performance regression on GHC 8.10.7.
 {-# INLINEABLE getResolvedExecPlan #-}
 getResolvedExecPlan ::
   forall m.
@@ -319,7 +323,8 @@ getResolvedExecPlan ::
     MonadBaseControl IO m,
     Tracing.MonadTrace m,
     EC.MonadGQLExecutionCheck m,
-    EB.MonadQueryTags m
+    EB.MonadQueryTags m,
+    ProvidesNetwork m
   ) =>
   Env.Environment ->
   L.Logger L.Hasura ->
@@ -330,7 +335,6 @@ getResolvedExecPlan ::
   SchemaCache ->
   SchemaCacheVer ->
   ET.GraphQLQueryType ->
-  HTTP.Manager ->
   [HTTP.Header] ->
   GQLReqUnparsed ->
   SingleOperation -> -- the first step of the execution plan
@@ -347,7 +351,6 @@ getResolvedExecPlan
   sc
   _scVer
   queryType
-  httpManager
   reqHeaders
   reqUnparsed
   queryParts -- the first step of the execution plan
@@ -366,7 +369,6 @@ getResolvedExecPlan
               prometheusMetrics
               gCtx
               userInfo
-              httpManager
               reqHeaders
               directives
               inlinedSelSet
@@ -387,7 +389,6 @@ getResolvedExecPlan
               gCtx
               sqlGenCtx
               userInfo
-              httpManager
               reqHeaders
               directives
               inlinedSelSet