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
This commit is contained in:
Lyndon Maydwell 2021-08-07 03:05:17 +10:00 committed by hasura-bot
parent bdf0954c9d
commit d483109443
15 changed files with 38 additions and 253 deletions

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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"

View File

@ -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 ->

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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