mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
eac27bbf13
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8855 Co-authored-by: Daniel Harvey <4729125+danieljharvey@users.noreply.github.com> GitOrigin-RevId: 5bde8ff821739c37a2e4435b57a5a623bc66de42
92 lines
3.2 KiB
Haskell
92 lines
3.2 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
|