mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
e0c0043e76
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9284 GitOrigin-RevId: 2f2cf2ad01900a54e4bdb970205ac0ef313c7e00
104 lines
3.3 KiB
Haskell
104 lines
3.3 KiB
Haskell
module Hasura.RQL.DDL.Network
|
|
( checkForHostnameWithSuffixInAllowlistObject,
|
|
dropHostFromAllowList,
|
|
runAddHostToTLSAllowlist,
|
|
runDropHostFromTLSAllowlist,
|
|
)
|
|
where
|
|
|
|
import Data.Text (pack)
|
|
import Data.Text.Extended
|
|
import Hasura.Base.Error
|
|
import Hasura.EncJSON
|
|
import Hasura.Metadata.Class ()
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Metadata
|
|
import Hasura.RQL.Types.SchemaCache.Build
|
|
import Network.Types.Extended
|
|
|
|
runAddHostToTLSAllowlist ::
|
|
(QErrM m, CacheRWM m, MetadataM m) =>
|
|
TlsAllow ->
|
|
m EncJSON
|
|
runAddHostToTLSAllowlist tlsAllowListEntry@TlsAllow {..} = do
|
|
networkMetadata <- _metaNetwork <$> getMetadata
|
|
|
|
when (null taHost) $ do
|
|
throw400 BadRequest $ "key \"host\" cannot be empty"
|
|
|
|
when (checkForHostWithSuffixInTLSAllowlist taHost taSuffix (tlsList networkMetadata)) $ do
|
|
case taSuffix of
|
|
Nothing ->
|
|
throw400 AlreadyExists
|
|
$ "the host "
|
|
<> dquote (pack taHost)
|
|
<> " already exists in the allowlist"
|
|
Just suffix ->
|
|
throw400 AlreadyExists
|
|
$ "the host "
|
|
<> dquote (pack taHost)
|
|
<> " with suffix "
|
|
<> dquote (pack suffix)
|
|
<> " already exists in the allowlist"
|
|
|
|
withNewInconsistentObjsCheck
|
|
$ buildSchemaCache
|
|
$ addHostToTLSAllowList tlsAllowListEntry
|
|
|
|
pure successMsg
|
|
where
|
|
tlsList nm = networkTlsAllowlist nm
|
|
|
|
runDropHostFromTLSAllowlist ::
|
|
(QErrM m, CacheRWM m, MetadataM m) =>
|
|
DropHostFromTLSAllowlist ->
|
|
m EncJSON
|
|
runDropHostFromTLSAllowlist (DropHostFromTLSAllowlist hostname maybeSuffix) = do
|
|
networkMetadata <- _metaNetwork <$> getMetadata
|
|
|
|
when (null hostname) $ do
|
|
throw400 BadRequest $ "hostname cannot be empty"
|
|
|
|
unless (checkForHostWithSuffixInTLSAllowlist hostname maybeSuffix (networkTlsAllowlist networkMetadata)) $ do
|
|
case maybeSuffix of
|
|
Nothing ->
|
|
throw400 NotExists
|
|
$ "the host "
|
|
<> dquote (pack hostname)
|
|
<> " isn't present in the allowlist"
|
|
Just suffix ->
|
|
throw400 NotExists
|
|
$ "the host "
|
|
<> dquote (pack hostname)
|
|
<> " with suffix "
|
|
<> dquote (pack suffix)
|
|
<> " isn't present in the allowlist"
|
|
|
|
withNewInconsistentObjsCheck
|
|
$ buildSchemaCache
|
|
$ dropHostFromAllowList hostname maybeSuffix
|
|
|
|
pure successMsg
|
|
|
|
addHostToTLSAllowList :: TlsAllow -> MetadataModifier
|
|
addHostToTLSAllowList tlsaObj = MetadataModifier $ \m ->
|
|
m {_metaNetwork = Network $ (tlsList m) ++ [tlsaObj]}
|
|
where
|
|
tlsList md = networkTlsAllowlist (_metaNetwork md)
|
|
|
|
dropHostFromAllowList :: String -> Maybe String -> MetadataModifier
|
|
dropHostFromAllowList host maybeSuffix = MetadataModifier $ \m ->
|
|
m {_metaNetwork = Network $ filteredList m}
|
|
where
|
|
tlsList md = networkTlsAllowlist (_metaNetwork md)
|
|
|
|
filteredList md = filter (not . checkForHostnameWithSuffixInAllowlistObject host maybeSuffix) (tlsList md)
|
|
|
|
checkForHostnameWithSuffixInAllowlistObject :: String -> Maybe String -> TlsAllow -> Bool
|
|
checkForHostnameWithSuffixInAllowlistObject host maybeSuffix tlsa = host == (taHost tlsa) && maybeSuffix == (taSuffix tlsa)
|
|
|
|
checkForHostWithSuffixInTLSAllowlist :: String -> Maybe String -> [TlsAllow] -> Bool
|
|
checkForHostWithSuffixInTLSAllowlist host maybeSuffix tlsAllowList =
|
|
any (checkForHostnameWithSuffixInAllowlistObject host maybeSuffix) tlsAllowList
|