Disable TLS checks for actions services with self-signed certificates

https://github.com/hasura/graphql-engine-mono/pull/1595

GitOrigin-RevId: 3834e7d005bfaeaa7cc429c9d662d23b3d903f5c

CHANGELOG.md

@@ -17,6 +17,7 @@
 
 ## v2.0.4
 
+- server: Adding support for TLS allowlist by domain and service id (port)
 - server: Support computed fields in permission check/filter (close #7102)
 - server: support computed fields in query 'order_by' (close #7103)
 - server: log warning if there are errors while executing clean up actions after "drop source" (previously it would throw an error)

server/graphql-engine.cabal

@@ -272,9 +272,12 @@ library
                      -- bigquery support
                      , memory
                      , x509-store
-
+                     , connection
+                     , tls
+                     , x509-validation
+                     , data-default-class
+                     , x509-system
                      , tagged
-
                      -- mysql
                      , mysql
                      , mysql-simple
@@ -481,6 +484,7 @@ library
                      , Hasura.RQL.Types.Metadata.Backend
                      , Hasura.RQL.Types.Metadata.Instances
                      , Hasura.RQL.Types.Metadata.Object
+                     , Hasura.RQL.Types.Network
                      , Hasura.RQL.Types.Permission
                      , Hasura.RQL.Types.QueryCollection
                      , Hasura.RQL.Types.QueryTags

server/src-exec/Main.hs

@@ -57,7 +57,10 @@ runApp :: Env.Environment -> HGEOptions Hasura -> IO ()
 runApp env (HGEOptionsG rci metadataDbUrl hgeCmd) = do
   initTime <- liftIO getCurrentTime
   globalCtx@GlobalCtx{..} <- initGlobalCtx env metadataDbUrl rci
-  let (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo
+  let
+    (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo
+    httpMgr      = manager   _gcHttpMgrAndTlsAllowList
+    tlsAllowlist = allowList _gcHttpMgrAndTlsAllowList
 
   withVersion $$(getVersionFromEnvironment) $ case hgeCmd of
     HCServe serveOptions -> do
@@ -122,14 +125,14 @@ runApp env (HGEOptionsG rci metadataDbUrl hgeCmd) = do
           serverConfigCtx =
             ServerConfigCtx functionPermsCtx remoteSchemaPermsCtx sqlGenCtx maintenanceMode mempty
           cacheBuildParams =
-            CacheBuildParams _gcHttpManager pgSourceResolver serverConfigCtx
+            CacheBuildParams httpMgr pgSourceResolver serverConfigCtx
       runManagedT (mkMinimalPool _gcMetadataDbConnInfo) $ \metadataDbPool -> do
         res <- flip runPGMetadataStorageAppT (metadataDbPool, pgLogger) $
           runMetadataStorageT $ liftEitherM do
           (metadata, _) <- fetchMetadata
-          runAsAdmin _gcHttpManager serverConfigCtx $ do
+          runAsAdmin httpMgr serverConfigCtx $ do
             schemaCache <- runCacheBuild cacheBuildParams $
-                           buildRebuildableSchemaCache env metadata
+                           buildRebuildableSchemaCache env metadata tlsAllowlist
             execQuery env queryBs
               & Tracing.runTraceTWithReporter Tracing.noReporter "execute"
               & runMetadataT metadata

server/src-lib/Hasura/App.hs

@@ -12,19 +12,27 @@ import qualified Control.Exception.Lifted                   as LE
 import qualified Data.Aeson                                 as A
 import qualified Data.ByteString.Char8                      as BC
 import qualified Data.ByteString.Lazy.Char8                 as BLC
+import qualified Data.Default.Class                         as HTTP
 import qualified Data.Environment                           as Env
 import qualified Data.HashMap.Strict                        as HM
 import qualified Data.Set                                   as Set
 import qualified Data.Text                                  as T
 import qualified Data.Time.Clock                            as Clock
+import qualified Data.X509                                  as HTTP
+import qualified Data.X509.CertificateStore                 as HTTP
+import qualified Data.X509.Validation                       as HTTP
 import qualified Data.Yaml                                  as Y
 import qualified Database.PG.Query                          as Q
+import qualified Network.Connection                         as HTTP
 import qualified Network.HTTP.Client                        as HTTP
 import qualified Network.HTTP.Client.TLS                    as HTTP
+import qualified Network.TLS                                as HTTP
+import qualified Network.TLS.Extra                          as TLS
 import qualified Network.Wai.Handler.Warp                   as Warp
 import qualified System.Log.FastLogger                      as FL
 import qualified System.Metrics                             as EKG
 import qualified System.Metrics.Gauge                       as EKG.Gauge
+import qualified System.X509                                as HTTP
 import qualified Text.Mustache.Compile                      as M
 import qualified Web.Spock.Core                             as Spock
 
@@ -40,9 +48,9 @@ import           Control.Monad.Trans.Managed                (ManagedT (..))
 import           Control.Monad.Unique
 import           Data.FileEmbed                             (makeRelativeToProject)
 import           Data.Time.Clock                            (UTCTime)
-#ifndef PROFILING
+
 import           GHC.AssertNF
-#endif
+
 import           Network.HTTP.Client.Extended
 import           Options.Applicative
 import           System.Environment                         (getEnvironment)
@@ -72,6 +80,8 @@ import           Hasura.RQL.DDL.Schema.Cache
 import           Hasura.RQL.DDL.Schema.Cache.Common
 import           Hasura.RQL.DDL.Schema.Catalog
 import           Hasura.RQL.Types
+import           Hasura.RQL.Types.Network                   (TlsAllow (TlsAllow),
+                                                             TlsPermission (SelfSigned))
 import           Hasura.RQL.Types.Run
 import           Hasura.Server.API.Query                    (requiresAdmin, runQueryM)
 import           Hasura.Server.App
@@ -165,13 +175,72 @@ mkPGLogger (Logger logger) (Q.PLERetryMsg msg) =
 -- | Context required for all graphql-engine CLI commands
 data GlobalCtx
   = GlobalCtx
-  { _gcHttpManager             :: !HTTP.Manager
+  { _gcHttpMgrAndTlsAllowList  :: !HttpMgrWithTlsAllowList
   , _gcMetadataDbConnInfo      :: !Q.ConnInfo
   , _gcDefaultPostgresConnInfo :: !(Maybe (UrlConf, Q.ConnInfo), Maybe Int)
     -- ^ --database-url option, @'UrlConf' is required to construct default source configuration
     -- and optional retries
   }
 
+data HttpMgrWithTlsAllowList =
+  HttpMgrWithTlsAllowList
+  { manager   :: HTTP.Manager
+  , allowList :: TlsAllowList
+  }
+
+mkMgr :: IO HttpMgrWithTlsAllowList
+mkMgr = do
+  allowList :: STM.TVar [TlsAllow] <- STM.newTVarIO []
+  systemStore <- HTTP.getSystemCertificateStore
+  let settings = HTTP.mkManagerSettings (tlsSettingsComplex systemStore allowList) Nothing
+  manager <- HTTP.newManager settings
+  pure $ HttpMgrWithTlsAllowList manager (TlsAllowList allowList)
+
+  where
+  tlsSettingsComplex :: HTTP.CertificateStore -> STM.TVar [TlsAllow] -> HTTP.TLSSettings
+  tlsSettingsComplex systemStore = HTTP.TLSSettings . clientParams systemStore
+
+  clientParams :: HTTP.CertificateStore -> STM.TVar [TlsAllow] -> HTTP.ClientParams
+  clientParams systemStore allowList =
+    (HTTP.defaultParamsClient hostName serviceIdBlob)
+      { HTTP.clientSupported = HTTP.def { HTTP.supportedCiphers = TLS.ciphersuite_default } -- supportedCiphers :: [Cipher]	Supported cipher methods. The default is empty, specify a suitable cipher list. ciphersuite_default is often a good choice.  Default: [] -- https://hackage.haskell.org/package/tls-1.5.5/docs/Network-TLS.html#t:Cipher
+      , HTTP.clientShared = HTTP.def { HTTP.sharedCAStore = systemStore }
+      , HTTP.clientHooks =
+        HTTP.def
+          { HTTP.onServerCertificate = (certValidation allowList)
+          } }
+
+  certValidation :: STM.TVar [TlsAllow] -> HTTP.CertificateStore -> HTTP.ValidationCache -> HTTP.ServiceID -> HTTP.CertificateChain -> IO [HTTP.FailedReason]
+  certValidation allowList' certStore validationCache sid chain = do
+    res       <- HTTP.onServerCertificate HTTP.def certStore validationCache sid chain
+    allowList <- STM.readTVarIO allowList'
+    if any (allowed sid res) allowList
+      then pure []
+      else pure res
+
+  -- These always seem to be overwritten when a connection is established
+  -- Should leave as errors in this case in order to validate this assumption.
+  hostName      = error "hostname undefined"
+  serviceIdBlob = error "serviceIdBlob undefined"
+
+  -- Checks that:
+  -- * the service (host) and service-suffix (port) match
+  -- * the error response is permitted
+  allowed :: (String, BC.ByteString) -> [HTTP.FailedReason] -> TlsAllow -> Bool
+  allowed (sHost, sPort) res (TlsAllow aHost aPort aPermit) =
+      (sHost == aHost)
+      && (BC.unpack sPort ==? aPort)
+      && all (\x -> any (($ x) . permitted) (fromMaybe [SelfSigned] aPermit)) res
+      -- TODO: Could clean up this check some more.
+
+  permitted SelfSigned HTTP.SelfSigned       = True
+  permitted SelfSigned (HTTP.NameMismatch _) = True
+  permitted SelfSigned HTTP.LeafNotV3        = True -- TODO: What does this mean????
+  permitted SelfSigned _                     = False
+  -- allowed HTTP.UnknownCA = True -- As described in https://hackage.haskell.org/package/tls-0.8.5/docs/src/Network-TLS-Core.html -- This is taken care of by the system certificate set.
+
+  _ ==? Nothing = True
+  a ==? Just a' = a == a'
 
 initGlobalCtx
   :: (MonadIO m)
@@ -182,7 +251,10 @@ initGlobalCtx
   -- ^ the user's DB URL
   -> m GlobalCtx
 initGlobalCtx env metadataDbUrl defaultPgConnInfo = do
-  httpManager <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings
+  -- allowList  <- liftIO $ STM.newTVarIO []
+  -- manager'   <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings
+  -- let manager = HttpMgrWithTlsAllowList manager' (TlsAllowList allowList)
+  manager <- liftIO $ mkMgr
 
   let PostgresConnInfo dbUrlConf maybeRetries = defaultPgConnInfo
       mkConnInfoFromSource dbUrl = do
@@ -193,7 +265,7 @@ initGlobalCtx env metadataDbUrl defaultPgConnInfo = do
         in (Q.ConnInfo retries . Q.CDDatabaseURI . txtToBs . T.pack) mdbUrl
 
       mkGlobalCtx mdbConnInfo sourceConnInfo =
-        pure $ GlobalCtx httpManager mdbConnInfo (sourceConnInfo, maybeRetries)
+        pure $ GlobalCtx manager mdbConnInfo (sourceConnInfo, maybeRetries)
 
   case (metadataDbUrl, dbUrlConf) of
     (Nothing, Nothing) ->
@@ -228,6 +300,7 @@ data ServeCtx
   , _scSchemaCache     :: !RebuildableSchemaCache
   , _scSchemaCacheRef  :: !SchemaCacheRef
   , _scMetaVersionRef  :: !(STM.TMVar MetadataResourceVersion)
+  , _scTlsAllowList    :: !TlsAllowList
   }
 
 -- | Collection of the LoggerCtx, the regular Logger and the PGLogger
@@ -301,13 +374,17 @@ initialiseServeCtx env GlobalCtx{..} so@ServeOptions{..} = do
         in PostgresConnConfiguration sourceConnInfo Nothing
       sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse
 
-  let serverConfigCtx =
+  let
+    serverConfigCtx =
         ServerConfigCtx soInferFunctionPermissions soEnableRemoteSchemaPermissions
                         sqlGenCtx soEnableMaintenanceMode soExperimentalFeatures
 
+    httpMgr  = manager _gcHttpMgrAndTlsAllowList
+    tlsAllow = allowList _gcHttpMgrAndTlsAllowList
+
   (rebuildableSchemaCache, _) <-
     lift . flip onException (flushLogger loggerCtx) $
-    migrateCatalogSchema env logger metadataDbPool maybeDefaultSourceConfig _gcHttpManager
+    migrateCatalogSchema env logger metadataDbPool maybeDefaultSourceConfig httpMgr tlsAllow
       serverConfigCtx (mkPgSourceResolver pgLogger)
 
 
@@ -323,8 +400,8 @@ initialiseServeCtx env GlobalCtx{..} so@ServeOptions{..} = do
 
   schemaCacheRef <- initialiseCache rebuildableSchemaCache
 
-  pure $ ServeCtx _gcHttpManager instanceId loggers soEnabledLogTypes metadataDbPool latch
-                  rebuildableSchemaCache schemaCacheRef metaVersionRef
+  pure $ ServeCtx httpMgr instanceId loggers soEnabledLogTypes metadataDbPool latch
+                  rebuildableSchemaCache schemaCacheRef metaVersionRef tlsAllow
 
 mkLoggers
   :: (MonadIO m, MonadBaseControl IO m)
@@ -341,12 +418,17 @@ mkLoggers enabledLogs logLevel = do
 -- | helper function to initialize or migrate the @hdb_catalog@ schema (used by pro as well)
 migrateCatalogSchema
   :: (HasVersion, MonadIO m, MonadBaseControl IO m)
-  => Env.Environment -> Logger Hasura -> Q.PGPool -> Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-  -> HTTP.Manager -> ServerConfigCtx
+  => Env.Environment
+  -> Logger Hasura
+  -> Q.PGPool
+  -> Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
+  -> HTTP.Manager
+  -> TlsAllowList
+  -> ServerConfigCtx
   -> SourceResolver
   -> m (RebuildableSchemaCache, UTCTime)
 migrateCatalogSchema env logger pool defaultSourceConfig
-                     httpManager serverConfigCtx
+                     httpManager tlsAllowlist serverConfigCtx
                      sourceResolver = do
   currentTime <- liftIO Clock.getCurrentTime
   initialiseResult <- runExceptT $ do
@@ -369,7 +451,7 @@ migrateCatalogSchema env logger pool defaultSourceConfig
             -- @'CatalogUpdate' re-creates event triggers in the database.
             if version < 43 then CatalogUpdate else CatalogSync
     schemaCache <- runCacheBuild cacheBuildParams $
-                   buildRebuildableSchemaCacheWithReason buildReason env metadata
+                   buildRebuildableSchemaCacheWithReason buildReason env metadata tlsAllowlist
     pure (migrationResult, schemaCache)
 
   (migrationResult, schemaCache) <-
@@ -481,9 +563,9 @@ runHGEServer setupHook env ServeOptions{..} ServeCtx{..} initTime postPollHook s
   -- tool.
   --
   -- NOTE: be sure to compile WITHOUT code coverage, for this to work properly.
-#ifndef PROFILING
+
   liftIO disableAssertNF
-#endif
+
 
   let sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse
       Loggers loggerCtx logger _ = _scLoggers
@@ -520,6 +602,7 @@ runHGEServer setupHook env ServeOptions{..} ServeCtx{..} initTime postPollHook s
              soEnableMaintenanceMode
              soExperimentalFeatures
              _scEnabledLogTypes
+             (tlsAllowList _scTlsAllowList)
 
   let serverConfigCtx =
         ServerConfigCtx soInferFunctionPermissions

server/src-lib/Hasura/RQL/DDL/Metadata.hs

@@ -166,7 +166,7 @@ runReplaceMetadataV2 ReplaceMetadataV2{..} = do
       pure $ Metadata (OMap.singleton defaultSource newDefaultSourceMetadata)
                         _mnsRemoteSchemas _mnsQueryCollections _mnsAllowlist
                         _mnsCustomTypes _mnsActions cronTriggersMetadata (_metaRestEndpoints oldMetadata)
-                        emptyApiLimit emptyMetricsConfig mempty introspectionDisabledRoles queryTagsConfig
+                        emptyApiLimit emptyMetricsConfig mempty introspectionDisabledRoles queryTagsConfig Nothing
   putMetadata metadata
 
   case _rmv2AllowInconsistentMetadata of

server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs

@@ -68,7 +68,8 @@ import           Hasura.RQL.DDL.Schema.Function
 import           Hasura.RQL.DDL.Schema.Table
 import           Hasura.RQL.Types                         hiding (fmFunction, tmTable)
 import           Hasura.SQL.Tag
-import           Hasura.Server.Types                      (MaintenanceMode (..))
+import           Hasura.Server.Types                      (MaintenanceMode (..), TlsAllowList (..),
+                                                           updateTlsAllowlist)
 import           Hasura.Server.Version                    (HasVersion)
 import           Hasura.Session
 
@@ -77,6 +78,7 @@ buildRebuildableSchemaCache
   :: HasVersion
   => Env.Environment
   -> Metadata
+  -> TlsAllowList
   -> CacheBuild RebuildableSchemaCache
 buildRebuildableSchemaCache =
   buildRebuildableSchemaCacheWithReason CatalogSync
@@ -86,10 +88,12 @@ buildRebuildableSchemaCacheWithReason
   => BuildReason
   -> Env.Environment
   -> Metadata
+  -> TlsAllowList
   -> CacheBuild RebuildableSchemaCache
-buildRebuildableSchemaCacheWithReason reason env metadata = do
+buildRebuildableSchemaCacheWithReason reason env metadata tlsAllowlist = do
   result <- flip runReaderT reason $
-    Inc.build (buildSchemaCacheRule env) (metadata, initialInvalidationKeys)
+    Inc.build (buildSchemaCacheRule tlsAllowlist env) (metadata, initialInvalidationKeys)
+
   pure $ RebuildableSchemaCache (Inc.result result) initialInvalidationKeys (Inc.rebuildRule result)
 
 
@@ -153,9 +157,10 @@ buildSchemaCacheRule
      , MonadReader BuildReason m, HasHttpManagerM m, MonadResolveSource m
      , HasServerConfigCtx m
      )
-  => Env.Environment
+  => TlsAllowList
+  -> Env.Environment
   -> (Metadata, InvalidationKeys) `arr` SchemaCache
-buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
+buildSchemaCacheRule tlsAllowlist env = proc (metadata, invalidationKeys) -> do
   invalidationKeysDep <- Inc.newDependency -< invalidationKeys
 
   -- Step 1: Process metadata and collect dependency information.
@@ -443,7 +448,7 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
     buildAndCollectInfo = proc (metadata, invalidationKeys) -> do
       let Metadata sources remoteSchemas collections allowlists
             customTypes actions cronTriggers endpoints apiLimits metricsConfig inheritedRoles
-            _introspectionDisabledRoles queryTagsConfig = metadata
+            _introspectionDisabledRoles queryTagsConfig _tlsWhitelist = metadata
           actionRoles = map _apmRole . _amPermissions =<< OMap.elems actions
           remoteSchemaRoles = map _rspmRole . _rsmPermissions =<< OMap.elems remoteSchemas
           sourceRoles =
@@ -586,6 +591,9 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
 
       cronTriggersMap <- buildCronTriggers -< ((), OMap.elems cronTriggers)
 
+      -- Note: Updates from metadata that include changes to the TLS AllowList will be written here.
+      bindA -< updateTlsAllowlist tlsAllowlist (metaTlsAllowlist metadata)
+
       returnA -< BuildOutputs
         { _boSources         = M.map fst sourcesOutput
         , _boActions         = actionCache

server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs

@@ -341,9 +341,9 @@ fetchMetadataFromHdbTables = liftTx do
 
   -- fetch actions
   actions <- oMapFromL _amName <$> fetchActions
+  cronTriggers <- fetchCronTriggers
 
-  MetadataNoSources fullTableMetaMap functions remoteSchemas collections
-                    allowlist customTypes actions <$> fetchCronTriggers
+  pure $ MetadataNoSources fullTableMetaMap functions remoteSchemas collections allowlist customTypes actions cronTriggers
 
   where
     modMetaMap l f xs = do

server/src-lib/Hasura/RQL/Types/Metadata.hs

@@ -35,6 +35,7 @@ import           Hasura.RQL.Types.Function
 import           Hasura.RQL.Types.GraphqlSchemaIntrospection
 import           Hasura.RQL.Types.Metadata.Backend
 import           Hasura.RQL.Types.Metadata.Instances         ()
+import           Hasura.RQL.Types.Network
 import           Hasura.RQL.Types.Permission
 import           Hasura.RQL.Types.QueryCollection
 import           Hasura.RQL.Types.QueryTags
@@ -333,7 +334,9 @@ data Metadata
   , _metaInheritedRoles                 :: !InheritedRoles
   , _metaSetGraphqlIntrospectionOptions :: !SetGraphqlIntrospectionOptions
   , _metaQueryTagsConfig                :: !QueryTagsConfig
+  , _metaNetwork                        :: !(Maybe Network)
   } deriving (Show, Eq, Generic)
+
 $(makeLenses ''Metadata)
 
 instance FromJSON Metadata where
@@ -344,23 +347,28 @@ instance FromJSON Metadata where
     rawSources <- o .: "sources"
     sources <- oMapFromL getSourceName <$> traverse parseSourceMetadata rawSources
     endpoints <- oMapFromL _ceName <$> o .:? "rest_endpoints" .!= []
+    network <- o .:? "network"
     (remoteSchemas, queryCollections, allowlist, customTypes,
      actions, cronTriggers, apiLimits, metricsConfig, inheritedRoles,
      disabledSchemaIntrospectionRoles, queryTagsConfig) <- parseNonSourcesMetadata o
     pure $ Metadata sources remoteSchemas queryCollections allowlist
            customTypes actions cronTriggers endpoints apiLimits metricsConfig inheritedRoles disabledSchemaIntrospectionRoles
-           queryTagsConfig
+           queryTagsConfig network
     where
       parseSourceMetadata :: Value -> Parser (AB.AnyBackend SourceMetadata)
       parseSourceMetadata = withObject "SourceMetadata" \o -> do
         backendKind <- o .:? "kind" .!= Postgres Vanilla
         AB.parseAnyBackendFromJSON backendKind (Object o)
 
-
 emptyMetadata :: Metadata
 emptyMetadata =
   Metadata mempty mempty mempty mempty emptyCustomTypes mempty mempty mempty
-    emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig
+    emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig Nothing
+
+metaTlsAllowlist :: Metadata -> [TlsAllow]
+metaTlsAllowlist m = case _metaNetwork m of
+  (Just m') -> networkTlsAllowlist m'
+  _         -> []
 
 tableMetadataSetter
   :: (BackendMetadata b)
@@ -442,6 +450,7 @@ metadataToOrdJSON ( Metadata
                     inheritedRoles
                     introspectionDisabledRoles
                     queryTagsConfig
+                    tlsWhitelist
                   ) = AO.object $ [ versionPair , sourcesPair] <>
                       catMaybes [ remoteSchemasPair
                                 , queryCollectionsPair
@@ -455,6 +464,7 @@ metadataToOrdJSON ( Metadata
                                 , inheritedRolesPair
                                 , introspectionDisabledRolesPair
                                 , queryTagsConfigPair
+                                , networkPair tlsWhitelist
                                 ]
   where
     versionPair          = ("version", AO.toOrdered currentMetadataVersion)
@@ -482,6 +492,10 @@ metadataToOrdJSON ( Metadata
         Nothing
         (introspectionDisabledRoles == mempty)
 
+    networkPair :: Maybe Network -> Maybe (Text, AO.Value)
+    networkPair (Just n) = Just ("network", AO.toOrdered n)
+    networkPair _        = Nothing
+
     queryTagsConfigPair = if queryTagsConfig == emptyQueryTagsConfig then Nothing
                           else Just ("query_tags", AO.toOrdered queryTagsConfig)
 
@@ -843,3 +857,4 @@ $(deriveToJSON defaultOptions ''GetCatalogState)
 
 instance FromJSON GetCatalogState where
   parseJSON _ = pure GetCatalogState
+

server/src-lib/Hasura/RQL/Types/Network.hs

@@ -0,0 +1,80 @@
+-- |
+
+module Hasura.RQL.Types.Network where
+
+import           Hasura.Prelude
+
+import qualified Data.Text                 as T
+
+import           Data.Aeson                as A
+import           Test.QuickCheck.Arbitrary as Q
+
+
+data Network
+  = Network
+  { _nwHttp  :: !(Maybe Http)
+  } deriving (Show, Eq, Generic)
+
+networkTlsAllowlist :: Network -> [TlsAllow]
+networkTlsAllowlist (Network (Just (Http l))) = l
+networkTlsAllowlist _                         = []
+
+instance Q.Arbitrary Network where
+  -- TODO: Decide if this should be extended to actual arbitrary networks
+  -- This could prove complicated for testing purposes since the implications
+  -- Are difficult to test.
+  arbitrary = pure (Network Nothing)
+
+instance FromJSON Network where
+  parseJSON = withObject "Network" $ \o -> Network
+    <$> o .:? "http"
+
+instance ToJSON Network where
+  toJSON (Network h) = object ["http" A..= h]
+
+data Http
+  = Http
+  { _hTlsAllowList  :: ![TlsAllow]
+  } deriving (Show, Eq, Generic)
+
+instance FromJSON Http where
+  parseJSON = withObject "HTTP" $ \o -> Http
+    <$> o .:? "tls_allowlist" .!= []
+
+instance ToJSON Http where
+  toJSON (Http t) = object ["tls_allowlist" A..= t]
+
+data TlsAllow
+  = TlsAllow
+  { taHost   :: !String
+  , taSuffix :: !(Maybe String)
+  , taPermit :: !(Maybe [TlsPermission])
+  } deriving (Show, Eq, Generic)
+
+instance FromJSON TlsAllow where
+  parseJSON j = aString j <|> anObject j
+    where
+      aString  = withText "TlsAllow"   $ \s -> pure $ TlsAllow (T.unpack s) Nothing Nothing
+      anObject = withObject "TlsAllow" $ \o -> TlsAllow
+        <$> o .: "host"
+        <*> o .:? "suffix"
+        <*> o .:? "permissions"
+
+instance ToJSON TlsAllow where
+  toJSON (TlsAllow h p a) = object
+    [ "host"        A..= h
+    , "suffix"      A..= p
+    , "permissions" A..= a
+    ]
+
+data TlsPermission
+  = SelfSigned
+  deriving (Show, Eq, Generic, Enum, Bounded)
+
+instance FromJSON TlsPermission where
+  parseJSON (String "self-signed") = pure SelfSigned
+  parseJSON _ = fail $ "TlsPermission expecting one of " <> intercalate ", " (map (show :: TlsPermission -> String) [minBound .. maxBound])
+
+instance ToJSON TlsPermission where
+  toJSON SelfSigned = String "self-signed"
+

server/src-lib/Hasura/Server/API/Metadata.hs

@@ -342,6 +342,7 @@ runMetadataQuery env logger instanceId userInfo httpManager serverConfigCtx sche
             & peelRun (RunCtx userInfo httpManager serverConfigCtx)
             & runExceptT
             & liftEitherM
+
           pure (r, modSchemaCache')
         MaintenanceModeEnabled ->
           throw500 "metadata cannot be modified in maintenance mode"

server/src-lib/Hasura/Server/App.hs

@@ -66,6 +66,7 @@ import           Hasura.HTTP
 import           Hasura.Metadata.Class
 import           Hasura.RQL.DDL.Schema
 import           Hasura.RQL.Types
+import           Hasura.RQL.Types.Network                  (TlsAllow)
 import           Hasura.Server.API.Config                  (runGetConfig)
 import           Hasura.Server.API.Metadata
 import           Hasura.Server.API.Query
@@ -124,6 +125,7 @@ data ServerCtx
   , scExperimentalFeatures         :: !(S.HashSet ExperimentalFeature)
   , scEnabledLogTypes              :: !(S.HashSet (L.EngineLogType L.Hasura))
   -- ^ this is only required for the short-term fix in https://github.com/hasura/graphql-engine-mono/issues/1770
+  , scTlsAllowlist                 :: !(STM.TVar [TlsAllow])
   }
 
 data HandlerCtx
@@ -787,11 +789,12 @@ mkWaiApp
   -> S.HashSet ExperimentalFeature
   -- ^ Set of the enabled experimental features
   -> S.HashSet (L.EngineLogType L.Hasura)
+  -> STM.TVar [TlsAllow]
   -> m HasuraApp
 mkWaiApp setupHook env logger sqlGenCtx enableAL httpManager mode corsCfg enableConsole consoleAssetsDir
          enableTelemetry instanceId apis lqOpts responseErrorsConfig
          liveQueryHook schemaCacheRef ekgStore serverMetrics enableRSPermsCtx functionPermsCtx
-         connectionOptions keepAliveDelay maintenanceMode experimentalFeatures enabledLogTypes = do
+         connectionOptions keepAliveDelay maintenanceMode experimentalFeatures enabledLogTypes tlsWhitelist = do
 
     let getSchemaCache = first lastBuiltSchemaCache <$> readIORef (_scrCache schemaCacheRef)
 
@@ -820,6 +823,7 @@ mkWaiApp setupHook env logger sqlGenCtx enableAL httpManager mode corsCfg enable
                     , scEnableMaintenanceMode        = maintenanceMode
                     , scExperimentalFeatures         = experimentalFeatures
                     , scEnabledLogTypes              = enabledLogTypes
+                    , scTlsAllowlist                 = tlsWhitelist
                     }
 
     spockApp <- liftWithStateless $ \lowerIO ->

server/src-lib/Hasura/Server/Migrate.hs

@@ -281,7 +281,7 @@ migrations maybeDefaultSourceConfig dryRun maintenanceMode =
                     SourceMetadata defaultSource _mnsTables _mnsFunctions defaultSourceConfig
               in Metadata (OMap.singleton defaultSource defaultSourceMetadata)
                    _mnsRemoteSchemas _mnsQueryCollections _mnsAllowlist _mnsCustomTypes _mnsActions _mnsCronTriggers mempty
-                   emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig
+                   emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig Nothing
         liftTx $ insertMetadataInCatalog metadataV3
 
     from43To42 = do

server/src-lib/Hasura/Server/Types.hs

@@ -4,12 +4,14 @@ import           Hasura.Prelude
 
 import           Data.Aeson
 
+import qualified Control.Concurrent.STM        as STM
 import qualified Data.HashSet                  as Set
 import qualified Database.PG.Query             as Q
 import qualified Network.HTTP.Types            as HTTP
 
 import           Hasura.RQL.Types.Common
 import           Hasura.RQL.Types.Function
+import           Hasura.RQL.Types.Network
 import           Hasura.RQL.Types.RemoteSchema
 import           Hasura.Server.Utils
 
@@ -77,3 +79,14 @@ data ServerConfigCtx
   , _sccMaintenanceMode      :: !MaintenanceMode
   , _sccExperimentalFeatures :: !(Set.HashSet ExperimentalFeature)
   } deriving (Show, Eq)
+
+newtype TlsAllowList =
+  TlsAllowList
+  { tlsAllowList :: STM.TVar [TlsAllow]
+  }
+
+newEmptyTlsAllowlist :: MonadIO m => m TlsAllowList
+newEmptyTlsAllowlist = liftIO $ TlsAllowList <$> STM.newTVarIO []
+
+updateTlsAllowlist :: MonadIO m => TlsAllowList -> [TlsAllow] -> m ()
+updateTlsAllowlist (TlsAllowList al) = liftIO . STM.atomically . STM.writeTVar al

server/src-test/Hasura/Server/MigrateSpec.hs

@@ -28,7 +28,7 @@ import           Hasura.RQL.Types
 import           Hasura.Server.API.PGDump
 import           Hasura.Server.Init                  (DowngradeOptions (..))
 import           Hasura.Server.Migrate
-import           Hasura.Server.Types                 (MaintenanceMode (..))
+import           Hasura.Server.Types                 (MaintenanceMode (..), newEmptyTlsAllowlist)
 import           Hasura.Server.Version               (HasVersion)
 import           Hasura.Session
 
@@ -88,7 +88,8 @@ spec
 spec srcConfig pgExecCtx pgConnInfo = do
   let migrateCatalogAndBuildCache env time = do
         (migrationResult, metadata) <- runTx pgExecCtx $ migrateCatalog (Just srcConfig) MaintenanceModeDisabled time
-        (,migrationResult) <$> runCacheBuildM (buildRebuildableSchemaCache env metadata)
+        tlsAllowlist                <- newEmptyTlsAllowlist
+        (,migrationResult) <$> runCacheBuildM (buildRebuildableSchemaCache env metadata tlsAllowlist)
 
       dropAndInit env time = lift $ CacheRefT $ flip modifyMVar \_ ->
         (runTx pgExecCtx dropHdbCatalogSchema) *> (migrateCatalogAndBuildCache env time)

server/src-test/Main.hs

@@ -126,7 +126,9 @@ buildPostgresSpecs maybeUrlTemplate = do
         (metadata, schemaCache) <- run do
           metadata <- snd <$> (liftEitherM . runExceptT . runLazyTx pgContext Q.ReadWrite)
                       (migrateCatalog (Just sourceConfig) maintenanceMode =<< liftIO getCurrentTime)
-          schemaCache <- lift $ lift $ buildRebuildableSchemaCache envMap metadata
+          -- TODO: Decide if this should be passed in via reader
+          tlsAllowlist <- newEmptyTlsAllowlist
+          schemaCache <- lift $ lift $ buildRebuildableSchemaCache envMap metadata tlsAllowlist
           pure (metadata, schemaCache)
 
         cacheRef <- newMVar schemaCache