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 :: TlsAllow -> m EncJSON
runAddHostToTLSAllowlist tlsAllowListEntry :: TlsAllow
tlsAllowListEntry@TlsAllow {String
Maybe String
Maybe [TlsPermission]
taPermit :: TlsAllow -> Maybe [TlsPermission]
taSuffix :: TlsAllow -> Maybe String
taHost :: TlsAllow -> String
taPermit :: Maybe [TlsPermission]
taSuffix :: Maybe String
taHost :: String
..} = do
  Network
networkMetadata <- Metadata -> Network
_metaNetwork (Metadata -> Network) -> m Metadata -> m Network
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
taHost) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"key \"host\" cannot be empty"

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> [TlsAllow] -> Bool
checkForHostInTLSAllowlist String
taHost (Network -> [TlsAllow]
tlsList Network
networkMetadata)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"the host " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall t. ToTxt t => t -> Text
dquote (String -> Text
pack String
taHost) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists in the allowlist"

  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (String -> MetadataObjId
MOHostTlsAllowlist String
taHost) (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
      TlsAllow -> MetadataModifier
addHostToTLSAllowList TlsAllow
tlsAllowListEntry

  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    tlsList :: Network -> [TlsAllow]
tlsList Network
nm = Network -> [TlsAllow]
networkTlsAllowlist Network
nm

runDropHostFromTLSAllowlist ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  DropHostFromTLSAllowlist ->
  m EncJSON
runDropHostFromTLSAllowlist :: DropHostFromTLSAllowlist -> m EncJSON
runDropHostFromTLSAllowlist (DropHostFromTLSAllowlist String
hostname) = do
  Network
networkMetadata <- Metadata -> Network
_metaNetwork (Metadata -> Network) -> m Metadata -> m Network
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
hostname) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"hostname cannot be empty"

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> [TlsAllow] -> Bool
checkForHostInTLSAllowlist String
hostname (Network -> [TlsAllow]
networkTlsAllowlist Network
networkMetadata)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"the host " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall t. ToTxt t => t -> Text
dquote (String -> Text
pack String
hostname) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" isn't present in the allowlist"

  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> MetadataModifier
dropHostFromAllowList String
hostname

  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

addHostToTLSAllowList :: TlsAllow -> MetadataModifier
addHostToTLSAllowList :: TlsAllow -> MetadataModifier
addHostToTLSAllowList TlsAllow
tlsaObj = (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ \Metadata
m ->
  Metadata
m {_metaNetwork :: Network
_metaNetwork = [TlsAllow] -> Network
Network ([TlsAllow] -> Network) -> [TlsAllow] -> Network
forall a b. (a -> b) -> a -> b
$ (Metadata -> [TlsAllow]
tlsList Metadata
m) [TlsAllow] -> [TlsAllow] -> [TlsAllow]
forall a. [a] -> [a] -> [a]
++ [TlsAllow
tlsaObj]}
  where
    tlsList :: Metadata -> [TlsAllow]
tlsList Metadata
md = Network -> [TlsAllow]
networkTlsAllowlist (Metadata -> Network
_metaNetwork Metadata
md)

dropHostFromAllowList :: String -> MetadataModifier
dropHostFromAllowList :: String -> MetadataModifier
dropHostFromAllowList String
host = (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ \Metadata
m ->
  Metadata
m {_metaNetwork :: Network
_metaNetwork = [TlsAllow] -> Network
Network ([TlsAllow] -> Network) -> [TlsAllow] -> Network
forall a b. (a -> b) -> a -> b
$ Metadata -> [TlsAllow]
filteredList Metadata
m}
  where
    tlsList :: Metadata -> [TlsAllow]
tlsList Metadata
md = Network -> [TlsAllow]
networkTlsAllowlist (Metadata -> Network
_metaNetwork Metadata
md)

    filteredList :: Metadata -> [TlsAllow]
filteredList Metadata
md = (TlsAllow -> Bool) -> [TlsAllow] -> [TlsAllow]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TlsAllow -> Bool) -> TlsAllow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TlsAllow -> Bool
checkForHostnameInAllowlistObject String
host) (Metadata -> [TlsAllow]
tlsList Metadata
md)

checkForHostnameInAllowlistObject :: String -> TlsAllow -> Bool
checkForHostnameInAllowlistObject :: String -> TlsAllow -> Bool
checkForHostnameInAllowlistObject String
host TlsAllow
tlsa = String
host String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (TlsAllow -> String
taHost TlsAllow
tlsa)

checkForHostInTLSAllowlist :: String -> [TlsAllow] -> Bool
checkForHostInTLSAllowlist :: String -> [TlsAllow] -> Bool
checkForHostInTLSAllowlist String
host [TlsAllow]
tlsAllowList =
  (TlsAllow -> Bool) -> [TlsAllow] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> TlsAllow -> Bool
checkForHostnameInAllowlistObject String
host) [TlsAllow]
tlsAllowList