graphql-engine/server/src-lib/Hasura/RQL/DDL/Network.hs
Antoine Leblanc 3cbcbd9291 Remove RQL/Types.hs
## Description

This PR removes `RQL.Types`, which was now only re-exporting a bunch of unrelated modules.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4363
GitOrigin-RevId: 894f29a19bff70b3dad8abc5d9858434d5065417
2022-04-27 13:58:47 +00:00

83 lines
2.6 KiB
Haskell

module Hasura.RQL.DDL.Network
( checkForHostnameInAllowlistObject,
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.Metadata.Object
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 (checkForHostInTLSAllowlist taHost (tlsList networkMetadata)) $ do
throw400 AlreadyExists $
"the host " <> dquote (pack taHost) <> " already exists in the allowlist"
withNewInconsistentObjsCheck $
buildSchemaCacheFor (MOHostTlsAllowlist taHost) $
addHostToTLSAllowList tlsAllowListEntry
pure successMsg
where
tlsList nm = networkTlsAllowlist nm
runDropHostFromTLSAllowlist ::
(QErrM m, CacheRWM m, MetadataM m) =>
DropHostFromTLSAllowlist ->
m EncJSON
runDropHostFromTLSAllowlist (DropHostFromTLSAllowlist hostname) = do
networkMetadata <- _metaNetwork <$> getMetadata
when (null hostname) $ do
throw400 BadRequest $ "hostname cannot be empty"
unless (checkForHostInTLSAllowlist hostname (networkTlsAllowlist networkMetadata)) $ do
throw400 NotExists $
"the host " <> dquote (pack hostname) <> " isn't present in the allowlist"
withNewInconsistentObjsCheck $
buildSchemaCache $
dropHostFromAllowList hostname
pure successMsg
addHostToTLSAllowList :: TlsAllow -> MetadataModifier
addHostToTLSAllowList tlsaObj = MetadataModifier $ \m ->
m {_metaNetwork = Network $ (tlsList m) ++ [tlsaObj]}
where
tlsList md = networkTlsAllowlist (_metaNetwork md)
dropHostFromAllowList :: String -> MetadataModifier
dropHostFromAllowList host = MetadataModifier $ \m ->
m {_metaNetwork = Network $ filteredList m}
where
tlsList md = networkTlsAllowlist (_metaNetwork md)
filteredList md = filter (not . checkForHostnameInAllowlistObject host) (tlsList md)
checkForHostnameInAllowlistObject :: String -> TlsAllow -> Bool
checkForHostnameInAllowlistObject host tlsa = host == (taHost tlsa)
checkForHostInTLSAllowlist :: String -> [TlsAllow] -> Bool
checkForHostInTLSAllowlist host tlsAllowList =
any (checkForHostnameInAllowlistObject host) tlsAllowList