graphql-engine/server/src-lib/Hasura/RQL/DDL/Network.hs
Varun Choudhary ea76e01b0f console: support suffix for tls allow list
[GS-392]: https://hasurahq.atlassian.net/browse/GS-392?atlOrigin=eyJpIjoiNWRkNTljNzYxNjVmNDY3MDlhMDU5Y2ZhYzA5YTRkZjUiLCJwIjoiZ2l0aHViLWNvbS1KU1cifQ

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7745
Co-authored-by: Krushan Bauva <31391329+krushanbauva@users.noreply.github.com>
Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>
GitOrigin-RevId: 72c9a2eef1cfaaefa30a7d53764b1c3688b38ae7
2023-02-15 10:26:41 +00:00

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.Network
import Hasura.RQL.Types.SchemaCache.Build
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