From d4831094435b881b03fddabcd7d6fc9a11945259 Mon Sep 17 00:00:00 2001 From: Lyndon Maydwell Date: Sat, 7 Aug 2021 03:05:17 +1000 Subject: [PATCH] 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 | 1 - server/graphql-engine.cabal | 8 +- server/src-exec/Main.hs | 11 +- server/src-lib/Hasura/App.hs | 113 +++--------------- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 2 +- server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 20 +--- .../Hasura/RQL/DDL/Schema/LegacyCatalog.hs | 4 +- server/src-lib/Hasura/RQL/Types/Metadata.hs | 21 +--- server/src-lib/Hasura/RQL/Types/Network.hs | 80 ------------- server/src-lib/Hasura/Server/API/Metadata.hs | 1 - server/src-lib/Hasura/Server/App.hs | 6 +- server/src-lib/Hasura/Server/Migrate.hs | 2 +- server/src-lib/Hasura/Server/Types.hs | 13 -- server/src-test/Hasura/Server/MigrateSpec.hs | 5 +- server/src-test/Main.hs | 4 +- 15 files changed, 38 insertions(+), 253 deletions(-) delete mode 100644 server/src-lib/Hasura/RQL/Types/Network.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 88373d342fb..6268466ca5c 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 8e83b66b06b..d0b6a8a058f 100644 --- a/server/graphql-engine.cabal +++ b/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 diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index dbddaf4aea5..215d5c3f0ef 100644 --- a/server/src-exec/Main.hs +++ b/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 - (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo - httpMgr = manager _gcHttpMgrAndTlsAllowList - tlsAllowlist = allowList _gcHttpMgrAndTlsAllowList + let (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo 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 diff --git a/server/src-lib/Hasura/App.hs b/server/src-lib/Hasura/App.hs index 1a5351f9808..2e1a7098a5b 100644 --- a/server/src-lib/Hasura/App.hs +++ b/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 [] - -- manager' <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings - -- let manager = HttpMgrWithTlsAllowList manager' (TlsAllowList allowList) - manager <- liftIO $ mkMgr + httpManager <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings 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 - 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 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 - rebuildableSchemaCache schemaCacheRef metaVersionRef tlsAllow + pure $ ServeCtx _gcHttpManager instanceId loggers soEnabledLogTypes metadataDbPool latch + 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 - -> Logger Hasura - -> Q.PGPool - -> Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) - -> HTTP.Manager - -> TlsAllowList - -> ServerConfigCtx + => Env.Environment -> Logger Hasura -> Q.PGPool -> Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) + -> HTTP.Manager -> 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 diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 0d287dc75f9..d23661a0ed1 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/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 diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index caf574006e6..5f7d9c97856 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/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 (..), - updateTlsAllowlist) +import Hasura.Server.Types (MaintenanceMode (..)) 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 diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs b/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs index 3df993744fb..c3455d2e8a5 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs +++ b/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 diff --git a/server/src-lib/Hasura/RQL/Types/Metadata.hs b/server/src-lib/Hasura/RQL/Types/Metadata.hs index 318562edbc7..71079e412bc 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata.hs +++ b/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 - -metaTlsAllowlist :: Metadata -> [TlsAllow] -metaTlsAllowlist m = case _metaNetwork m of - (Just m') -> networkTlsAllowlist m' - _ -> [] + emptyApiLimit emptyMetricsConfig mempty mempty emptyQueryTagsConfig 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 - diff --git a/server/src-lib/Hasura/RQL/Types/Network.hs b/server/src-lib/Hasura/RQL/Types/Network.hs deleted file mode 100644 index 0936304c883..00000000000 --- a/server/src-lib/Hasura/RQL/Types/Network.hs +++ /dev/null @@ -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" - diff --git a/server/src-lib/Hasura/Server/API/Metadata.hs b/server/src-lib/Hasura/Server/API/Metadata.hs index 4de9d104d4f..500f4a1e54e 100644 --- a/server/src-lib/Hasura/Server/API/Metadata.hs +++ b/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" diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index b7f32f1dbae..b066ec767d9 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/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 -> diff --git a/server/src-lib/Hasura/Server/Migrate.hs b/server/src-lib/Hasura/Server/Migrate.hs index 229553618dc..25022d2b133 100644 --- a/server/src-lib/Hasura/Server/Migrate.hs +++ b/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 diff --git a/server/src-lib/Hasura/Server/Types.hs b/server/src-lib/Hasura/Server/Types.hs index 3d15ae43640..7727dc09f9a 100644 --- a/server/src-lib/Hasura/Server/Types.hs +++ b/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 diff --git a/server/src-test/Hasura/Server/MigrateSpec.hs b/server/src-test/Hasura/Server/MigrateSpec.hs index 6fc5d5f9185..04c2e67f30c 100644 --- a/server/src-test/Hasura/Server/MigrateSpec.hs +++ b/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 tlsAllowlist) + (,migrationResult) <$> runCacheBuildM (buildRebuildableSchemaCache env metadata) dropAndInit env time = lift $ CacheRefT $ flip modifyMVar \_ -> (runTx pgExecCtx dropHdbCatalogSchema) *> (migrateCatalogAndBuildCache env time) diff --git a/server/src-test/Main.hs b/server/src-test/Main.hs index 54ed509429c..7013050abd6 100644 --- a/server/src-test/Main.hs +++ b/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 - tlsAllowlist <- newEmptyTlsAllowlist - schemaCache <- lift $ lift $ buildRebuildableSchemaCache envMap metadata tlsAllowlist + schemaCache <- lift $ lift $ buildRebuildableSchemaCache envMap metadata pure (metadata, schemaCache) cacheRef <- newMVar schemaCache