Revert "Disable TLS checks for actions services with self-signed certificates"

Reverts hasura/graphql-engine-mono#1595

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

GitOrigin-RevId: b32adde77b189c14eef0090866d58750d1481b50

CHANGELOG.md

@@ -22,7 +22,6 @@
 
 ## 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,12 +272,9 @@ library
                      -- bigquery support
                      , memory
                      , x509-store
-                     , connection
+
-                     , tls
-                     , x509-validation
-                     , data-default-class
-                     , x509-system
                      , tagged
+
                      -- mysql
                      , mysql
                      , mysql-simple
@@ -484,7 +481,6 @@ 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,10 +57,7 @@ runApp :: Env.Environment -> HGEOptions Hasura -> IO ()
 runApp env (HGEOptionsG rci metadataDbUrl hgeCmd) = do
   initTime <- liftIO getCurrentTime
   globalCtx@GlobalCtx{..} <- initGlobalCtx env metadataDbUrl rci
-  let
+  let (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo
-    (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo
-    httpMgr      = manager   _gcHttpMgrAndTlsAllowList
-    tlsAllowlist = allowList _gcHttpMgrAndTlsAllowList
 
   withVersion $$(getVersionFromEnvironment) $ case hgeCmd of
     HCServe serveOptions -> do
@@ -125,14 +122,14 @@ runApp env (HGEOptionsG rci metadataDbUrl hgeCmd) = do
           serverConfigCtx =
             ServerConfigCtx functionPermsCtx remoteSchemaPermsCtx sqlGenCtx maintenanceMode mempty
           cacheBuildParams =
-            CacheBuildParams httpMgr pgSourceResolver serverConfigCtx
+            CacheBuildParams _gcHttpManager pgSourceResolver serverConfigCtx
       runManagedT (mkMinimalPool _gcMetadataDbConnInfo) $ \metadataDbPool -> do
         res <- flip runPGMetadataStorageAppT (metadataDbPool, pgLogger) $
           runMetadataStorageT $ liftEitherM do
           (metadata, _) <- fetchMetadata
-          runAsAdmin httpMgr serverConfigCtx $ do
+          runAsAdmin _gcHttpManager serverConfigCtx $ do
             schemaCache <- runCacheBuild cacheBuildParams $
-                           buildRebuildableSchemaCache env metadata tlsAllowlist
+                           buildRebuildableSchemaCache env metadata
             execQuery env queryBs
               & Tracing.runTraceTWithReporter Tracing.noReporter "execute"
               & runMetadataT metadata

server/src-lib/Hasura/App.hs

@@ -12,27 +12,19 @@ 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
 
@@ -48,9 +40,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)
@@ -80,8 +72,6 @@ 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
@@ -175,72 +165,13 @@ mkPGLogger (Logger logger) (Q.PLERetryMsg msg) =
 -- | Context required for all graphql-engine CLI commands
 data GlobalCtx
   = GlobalCtx
-  { _gcHttpMgrAndTlsAllowList  :: !HttpMgrWithTlsAllowList
+  { _gcHttpManager             :: !HTTP.Manager
   , _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)
@@ -251,10 +182,7 @@ initGlobalCtx
   -- ^ the user's DB URL
   -> m GlobalCtx
 initGlobalCtx env metadataDbUrl defaultPgConnInfo = do
-  -- allowList  <- liftIO $ STM.newTVarIO []
+  httpManager <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings
-  -- manager'   <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings
-  -- let manager = HttpMgrWithTlsAllowList manager' (TlsAllowList allowList)
-  manager <- liftIO $ mkMgr
 
   let PostgresConnInfo dbUrlConf maybeRetries = defaultPgConnInfo
       mkConnInfoFromSource dbUrl = do
@@ -265,7 +193,7 @@ initGlobalCtx env metadataDbUrl defaultPgConnInfo = do
         in (Q.ConnInfo retries . Q.CDDatabaseURI . txtToBs . T.pack) mdbUrl
 
       mkGlobalCtx mdbConnInfo sourceConnInfo =
-        pure $ GlobalCtx manager mdbConnInfo (sourceConnInfo, maybeRetries)
+        pure $ GlobalCtx httpManager mdbConnInfo (sourceConnInfo, maybeRetries)
 
   case (metadataDbUrl, dbUrlConf) of
     (Nothing, Nothing) ->
@@ -300,7 +228,6 @@ data ServeCtx
   , _scSchemaCache     :: !RebuildableSchemaCache
   , _scSchemaCacheRef  :: !SchemaCacheRef
   , _scMetaVersionRef  :: !(STM.TMVar MetadataResourceVersion)
-  , _scTlsAllowList    :: !TlsAllowList
   }
 
 -- | Collection of the LoggerCtx, the regular Logger and the PGLogger
@@ -374,17 +301,13 @@ initialiseServeCtx env GlobalCtx{..} so@ServeOptions{..} = do
         in PostgresConnConfiguration sourceConnInfo Nothing
       sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse
 
-  let
+  let serverConfigCtx =
-    serverConfigCtx =
         ServerConfigCtx soInferFunctionPermissions soEnableRemoteSchemaPermissions
                         sqlGenCtx soEnableMaintenanceMode soExperimentalFeatures
 
-    httpMgr  = manager _gcHttpMgrAndTlsAllowList
-    tlsAllow = allowList _gcHttpMgrAndTlsAllowList
-
   (rebuildableSchemaCache, _) <-
     lift . flip onException (flushLogger loggerCtx) $
-    migrateCatalogSchema env logger metadataDbPool maybeDefaultSourceConfig httpMgr tlsAllow
+    migrateCatalogSchema env logger metadataDbPool maybeDefaultSourceConfig _gcHttpManager
       serverConfigCtx (mkPgSourceResolver pgLogger)
 
 
@@ -400,8 +323,8 @@ initialiseServeCtx env GlobalCtx{..} so@ServeOptions{..} = do
 
   schemaCacheRef <- initialiseCache rebuildableSchemaCache
 
-  pure $ ServeCtx httpMgr instanceId loggers soEnabledLogTypes metadataDbPool latch
+  pure $ ServeCtx _gcHttpManager instanceId loggers soEnabledLogTypes metadataDbPool latch
-                  rebuildableSchemaCache schemaCacheRef metaVersionRef tlsAllow
+                  rebuildableSchemaCache schemaCacheRef metaVersionRef
 
 mkLoggers
   :: (MonadIO m, MonadBaseControl IO m)
@@ -418,17 +341,12 @@ 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
+  => Env.Environment -> Logger Hasura -> Q.PGPool -> Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-  -> Logger Hasura
+  -> HTTP.Manager -> ServerConfigCtx
-  -> Q.PGPool
-  -> Maybe (SourceConnConfiguration ('Postgres 'Vanilla))
-  -> HTTP.Manager
-  -> TlsAllowList
-  -> ServerConfigCtx
   -> SourceResolver
   -> m (RebuildableSchemaCache, UTCTime)
 migrateCatalogSchema env logger pool defaultSourceConfig
-                     httpManager tlsAllowlist serverConfigCtx
+                     httpManager serverConfigCtx
                      sourceResolver = do
   currentTime <- liftIO Clock.getCurrentTime
   initialiseResult <- runExceptT $ do
@@ -451,7 +369,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 tlsAllowlist
+                   buildRebuildableSchemaCacheWithReason buildReason env metadata
     pure (migrationResult, schemaCache)
 
   (migrationResult, schemaCache) <-
@@ -563,9 +481,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
@@ -602,7 +520,6 @@ 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 Nothing
+                        emptyApiLimit emptyMetricsConfig mempty introspectionDisabledRoles queryTagsConfig
   putMetadata metadata
 
   case _rmv2AllowInconsistentMetadata of

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

@@ -68,8 +68,7 @@ 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 (..), TlsAllowList (..),
+import           Hasura.Server.Types                      (MaintenanceMode (..))
-                                                           updateTlsAllowlist)
 import           Hasura.Server.Version                    (HasVersion)
 import           Hasura.Session
 
@@ -78,7 +77,6 @@ buildRebuildableSchemaCache
   :: HasVersion
   => Env.Environment
   -> Metadata
-  -> TlsAllowList
   -> CacheBuild RebuildableSchemaCache
 buildRebuildableSchemaCache =
   buildRebuildableSchemaCacheWithReason CatalogSync
@@ -88,12 +86,10 @@ buildRebuildableSchemaCacheWithReason
   => BuildReason
   -> Env.Environment
   -> Metadata
-  -> TlsAllowList
   -> CacheBuild RebuildableSchemaCache
-buildRebuildableSchemaCacheWithReason reason env metadata tlsAllowlist = do
+buildRebuildableSchemaCacheWithReason reason env metadata = do
   result <- flip runReaderT reason $
-    Inc.build (buildSchemaCacheRule tlsAllowlist env) (metadata, initialInvalidationKeys)
+    Inc.build (buildSchemaCacheRule env) (metadata, initialInvalidationKeys)
-
   pure $ RebuildableSchemaCache (Inc.result result) initialInvalidationKeys (Inc.rebuildRule result)
 
 
@@ -157,10 +153,9 @@ buildSchemaCacheRule
      , MonadReader BuildReason m, HasHttpManagerM m, MonadResolveSource m
      , HasServerConfigCtx m
      )
-  => TlsAllowList
+  => Env.Environment
-  -> Env.Environment
   -> (Metadata, InvalidationKeys) `arr` SchemaCache
-buildSchemaCacheRule tlsAllowlist env = proc (metadata, invalidationKeys) -> do
+buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
   invalidationKeysDep <- Inc.newDependency -< invalidationKeys
 
   -- Step 1: Process metadata and collect dependency information.
@@ -448,7 +443,7 @@ buildSchemaCacheRule tlsAllowlist 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 _tlsWhitelist = metadata
+            _introspectionDisabledRoles queryTagsConfig = metadata
           actionRoles = map _apmRole . _amPermissions =<< OMap.elems actions
           remoteSchemaRoles = map _rspmRole . _rsmPermissions =<< OMap.elems remoteSchemas
           sourceRoles =
@@ -591,9 +586,6 @@ buildSchemaCacheRule tlsAllowlist 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
 
-  pure $ MetadataNoSources fullTableMetaMap functions remoteSchemas collections allowlist customTypes actions cronTriggers
+  MetadataNoSources fullTableMetaMap functions remoteSchemas collections
+                    allowlist customTypes actions <$> fetchCronTriggers
 
   where
     modMetaMap l f xs = do

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

@@ -35,7 +35,6 @@ 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
@@ -334,9 +333,7 @@ data Metadata
   , _metaInheritedRoles                 :: !InheritedRoles
   , _metaSetGraphqlIntrospectionOptions :: !SetGraphqlIntrospectionOptions
   , _metaQueryTagsConfig                :: !QueryTagsConfig
-  , _metaNetwork                        :: !(Maybe Network)
   } deriving (Show, Eq, Generic)
-
 $(makeLenses ''Metadata)
 
 instance FromJSON Metadata where
@@ -347,28 +344,23 @@ 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 network
+           queryTagsConfig
     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 Nothing
+    emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig
-
-metaTlsAllowlist :: Metadata -> [TlsAllow]
-metaTlsAllowlist m = case _metaNetwork m of
-  (Just m') -> networkTlsAllowlist m'
-  _         -> []
 
 tableMetadataSetter
   :: (BackendMetadata b)
@@ -450,7 +442,6 @@ metadataToOrdJSON ( Metadata
                     inheritedRoles
                     introspectionDisabledRoles
                     queryTagsConfig
-                    tlsWhitelist
                   ) = AO.object $ [ versionPair , sourcesPair] <>
                       catMaybes [ remoteSchemasPair
                                 , queryCollectionsPair
@@ -464,7 +455,6 @@ metadataToOrdJSON ( Metadata
                                 , inheritedRolesPair
                                 , introspectionDisabledRolesPair
                                 , queryTagsConfigPair
-                                , networkPair tlsWhitelist
                                 ]
   where
     versionPair          = ("version", AO.toOrdered currentMetadataVersion)
@@ -492,10 +482,6 @@ 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)
 
@@ -857,4 +843,3 @@ $(deriveToJSON defaultOptions ''GetCatalogState)
 
 instance FromJSON GetCatalogState where
   parseJSON _ = pure GetCatalogState
-

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

@@ -1,80 +0,0 @@
--- |
-
-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,7 +342,6 @@ 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,7 +66,6 @@ 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
@@ -125,7 +124,6 @@ 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
@@ -789,12 +787,11 @@ 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 tlsWhitelist = do
+         connectionOptions keepAliveDelay maintenanceMode experimentalFeatures enabledLogTypes = do
 
     let getSchemaCache = first lastBuiltSchemaCache <$> readIORef (_scrCache schemaCacheRef)
 
@@ -823,7 +820,6 @@ 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 Nothing
+                   emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig
         liftTx $ insertMetadataInCatalog metadataV3
 
     from43To42 = do

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

@@ -4,14 +4,12 @@ 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
 
@@ -79,14 +77,3 @@ 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 (..), newEmptyTlsAllowlist)
+import           Hasura.Server.Types                 (MaintenanceMode (..))
 import           Hasura.Server.Version               (HasVersion)
 import           Hasura.Session
 
@@ -88,8 +88,7 @@ spec
 spec srcConfig pgExecCtx pgConnInfo = do
   let migrateCatalogAndBuildCache env time = do
         (migrationResult, metadata) <- runTx pgExecCtx $ migrateCatalog (Just srcConfig) MaintenanceModeDisabled time
-        tlsAllowlist                <- newEmptyTlsAllowlist
+        (,migrationResult) <$> runCacheBuildM (buildRebuildableSchemaCache env metadata)
-        (,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,9 +126,7 @@ buildPostgresSpecs maybeUrlTemplate = do
         (metadata, schemaCache) <- run do
           metadata <- snd <$> (liftEitherM . runExceptT . runLazyTx pgContext Q.ReadWrite)
                       (migrateCatalog (Just sourceConfig) maintenanceMode =<< liftIO getCurrentTime)
-          -- TODO: Decide if this should be passed in via reader
+          schemaCache <- lift $ lift $ buildRebuildableSchemaCache envMap metadata
-          tlsAllowlist <- newEmptyTlsAllowlist
-          schemaCache <- lift $ lift $ buildRebuildableSchemaCache envMap metadata tlsAllowlist
           pure (metadata, schemaCache)
 
         cacheRef <- newMVar schemaCache