{-# LANGUAGE DeriveAnyClass #-}

-- | API related to server configuration
module Hasura.Server.API.Config
-- required by pro
  ( ServerConfig (..),
    runGetConfig,
  )
where

import Data.Aeson qualified as J
import Data.HashSet qualified as Set
import Hasura.GraphQL.Execute.Subscription.Options qualified as ES
import Hasura.Prelude
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.Server.Auth
import Hasura.Server.Auth.JWT
import Hasura.Server.Init.Config (API (METRICS), AllowListStatus)
import Hasura.Server.Init.FeatureFlag (FeatureFlag (..))
import Hasura.Server.Types (ExperimentalFeature)
import Hasura.Server.Version (Version, currentVersion)

data FeatureFlagInfo = FeatureFlagInfo
  { FeatureFlagInfo -> Text
ffiName :: Text,
    FeatureFlagInfo -> Text
ffiDescription :: Text,
    FeatureFlagInfo -> Bool
ffiEnabled :: Bool
  }
  deriving (Int -> FeatureFlagInfo -> ShowS
[FeatureFlagInfo] -> ShowS
FeatureFlagInfo -> String
(Int -> FeatureFlagInfo -> ShowS)
-> (FeatureFlagInfo -> String)
-> ([FeatureFlagInfo] -> ShowS)
-> Show FeatureFlagInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeatureFlagInfo -> ShowS
showsPrec :: Int -> FeatureFlagInfo -> ShowS
$cshow :: FeatureFlagInfo -> String
show :: FeatureFlagInfo -> String
$cshowList :: [FeatureFlagInfo] -> ShowS
showList :: [FeatureFlagInfo] -> ShowS
Show, FeatureFlagInfo -> FeatureFlagInfo -> Bool
(FeatureFlagInfo -> FeatureFlagInfo -> Bool)
-> (FeatureFlagInfo -> FeatureFlagInfo -> Bool)
-> Eq FeatureFlagInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeatureFlagInfo -> FeatureFlagInfo -> Bool
== :: FeatureFlagInfo -> FeatureFlagInfo -> Bool
$c/= :: FeatureFlagInfo -> FeatureFlagInfo -> Bool
/= :: FeatureFlagInfo -> FeatureFlagInfo -> Bool
Eq, (forall x. FeatureFlagInfo -> Rep FeatureFlagInfo x)
-> (forall x. Rep FeatureFlagInfo x -> FeatureFlagInfo)
-> Generic FeatureFlagInfo
forall x. Rep FeatureFlagInfo x -> FeatureFlagInfo
forall x. FeatureFlagInfo -> Rep FeatureFlagInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FeatureFlagInfo -> Rep FeatureFlagInfo x
from :: forall x. FeatureFlagInfo -> Rep FeatureFlagInfo x
$cto :: forall x. Rep FeatureFlagInfo x -> FeatureFlagInfo
to :: forall x. Rep FeatureFlagInfo x -> FeatureFlagInfo
Generic, Eq FeatureFlagInfo
Eq FeatureFlagInfo
-> (Int -> FeatureFlagInfo -> Int)
-> (FeatureFlagInfo -> Int)
-> Hashable FeatureFlagInfo
Int -> FeatureFlagInfo -> Int
FeatureFlagInfo -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FeatureFlagInfo -> Int
hashWithSalt :: Int -> FeatureFlagInfo -> Int
$chash :: FeatureFlagInfo -> Int
hash :: FeatureFlagInfo -> Int
Hashable)

instance J.ToJSON FeatureFlagInfo where
  toJSON :: FeatureFlagInfo -> Value
toJSON = Options -> FeatureFlagInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: FeatureFlagInfo -> Encoding
toEncoding = Options -> FeatureFlagInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data JWTInfo = JWTInfo
  { JWTInfo -> JWTNamespace
jwtiClaimsNamespace :: !JWTNamespace,
    JWTInfo -> JWTClaimsFormat
jwtiClaimsFormat :: !JWTClaimsFormat,
    JWTInfo -> Maybe JWTCustomClaimsMap
jwtiClaimsMap :: !(Maybe JWTCustomClaimsMap)
  }
  deriving (Int -> JWTInfo -> ShowS
[JWTInfo] -> ShowS
JWTInfo -> String
(Int -> JWTInfo -> ShowS)
-> (JWTInfo -> String) -> ([JWTInfo] -> ShowS) -> Show JWTInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JWTInfo -> ShowS
showsPrec :: Int -> JWTInfo -> ShowS
$cshow :: JWTInfo -> String
show :: JWTInfo -> String
$cshowList :: [JWTInfo] -> ShowS
showList :: [JWTInfo] -> ShowS
Show, JWTInfo -> JWTInfo -> Bool
(JWTInfo -> JWTInfo -> Bool)
-> (JWTInfo -> JWTInfo -> Bool) -> Eq JWTInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JWTInfo -> JWTInfo -> Bool
== :: JWTInfo -> JWTInfo -> Bool
$c/= :: JWTInfo -> JWTInfo -> Bool
/= :: JWTInfo -> JWTInfo -> Bool
Eq, (forall x. JWTInfo -> Rep JWTInfo x)
-> (forall x. Rep JWTInfo x -> JWTInfo) -> Generic JWTInfo
forall x. Rep JWTInfo x -> JWTInfo
forall x. JWTInfo -> Rep JWTInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JWTInfo -> Rep JWTInfo x
from :: forall x. JWTInfo -> Rep JWTInfo x
$cto :: forall x. Rep JWTInfo x -> JWTInfo
to :: forall x. Rep JWTInfo x -> JWTInfo
Generic)

instance J.ToJSON JWTInfo where
  toJSON :: JWTInfo -> Value
toJSON = Options -> JWTInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: JWTInfo -> Encoding
toEncoding = Options -> JWTInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data ServerConfig = ServerConfig
  { ServerConfig -> Version
scfgVersion :: !Version,
    ServerConfig -> InferFunctionPermissions
scfgIsFunctionPermissionsInferred :: !Options.InferFunctionPermissions,
    ServerConfig -> RemoteSchemaPermissions
scfgIsRemoteSchemaPermissionsEnabled :: !Options.RemoteSchemaPermissions,
    ServerConfig -> Bool
scfgIsAdminSecretSet :: !Bool,
    ServerConfig -> Bool
scfgIsAuthHookSet :: !Bool,
    ServerConfig -> Bool
scfgIsJwtSet :: !Bool,
    ServerConfig -> [JWTInfo]
scfgJwt :: ![JWTInfo],
    ServerConfig -> AllowListStatus
scfgIsAllowListEnabled :: !AllowListStatus,
    ServerConfig -> LiveQueriesOptions
scfgLiveQueries :: !ES.LiveQueriesOptions,
    ServerConfig -> LiveQueriesOptions
scfgStreamingQueries :: !ES.SubscriptionsOptions,
    ServerConfig -> Maybe Text
scfgConsoleAssetsDir :: !(Maybe Text),
    ServerConfig -> HashSet ExperimentalFeature
scfgExperimentalFeatures :: !(Set.HashSet ExperimentalFeature),
    ServerConfig -> Bool
scfgIsPrometheusMetricsEnabled :: !Bool,
    ServerConfig -> NamingCase
scfgDefaultNamingConvention :: !NamingCase,
    ServerConfig -> HashSet FeatureFlagInfo
scfgFeatureFlags :: !(Set.HashSet FeatureFlagInfo)
  }
  deriving (Int -> ServerConfig -> ShowS
[ServerConfig] -> ShowS
ServerConfig -> String
(Int -> ServerConfig -> ShowS)
-> (ServerConfig -> String)
-> ([ServerConfig] -> ShowS)
-> Show ServerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerConfig -> ShowS
showsPrec :: Int -> ServerConfig -> ShowS
$cshow :: ServerConfig -> String
show :: ServerConfig -> String
$cshowList :: [ServerConfig] -> ShowS
showList :: [ServerConfig] -> ShowS
Show, ServerConfig -> ServerConfig -> Bool
(ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> Bool) -> Eq ServerConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerConfig -> ServerConfig -> Bool
== :: ServerConfig -> ServerConfig -> Bool
$c/= :: ServerConfig -> ServerConfig -> Bool
/= :: ServerConfig -> ServerConfig -> Bool
Eq, (forall x. ServerConfig -> Rep ServerConfig x)
-> (forall x. Rep ServerConfig x -> ServerConfig)
-> Generic ServerConfig
forall x. Rep ServerConfig x -> ServerConfig
forall x. ServerConfig -> Rep ServerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerConfig -> Rep ServerConfig x
from :: forall x. ServerConfig -> Rep ServerConfig x
$cto :: forall x. Rep ServerConfig x -> ServerConfig
to :: forall x. Rep ServerConfig x -> ServerConfig
Generic)

instance J.ToJSON ServerConfig where
  toJSON :: ServerConfig -> Value
toJSON = Options -> ServerConfig -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: ServerConfig -> Encoding
toEncoding = Options -> ServerConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

runGetConfig ::
  Options.InferFunctionPermissions ->
  Options.RemoteSchemaPermissions ->
  AuthMode ->
  AllowListStatus ->
  ES.LiveQueriesOptions ->
  ES.SubscriptionsOptions ->
  Maybe Text ->
  Set.HashSet ExperimentalFeature ->
  Set.HashSet API ->
  NamingCase ->
  [(FeatureFlag, Text, Bool)] ->
  ServerConfig
runGetConfig :: InferFunctionPermissions
-> RemoteSchemaPermissions
-> AuthMode
-> AllowListStatus
-> LiveQueriesOptions
-> LiveQueriesOptions
-> Maybe Text
-> HashSet ExperimentalFeature
-> HashSet API
-> NamingCase
-> [(FeatureFlag, Text, Bool)]
-> ServerConfig
runGetConfig
  InferFunctionPermissions
functionPermsCtx
  RemoteSchemaPermissions
remoteSchemaPermsCtx
  AuthMode
am
  AllowListStatus
allowListStatus
  LiveQueriesOptions
liveQueryOpts
  LiveQueriesOptions
streamQueryOpts
  Maybe Text
consoleAssetsDir
  HashSet ExperimentalFeature
experimentalFeatures
  HashSet API
enabledAPIs
  NamingCase
defaultNamingConvention
  [(FeatureFlag, Text, Bool)]
featureFlags =
    Version
-> InferFunctionPermissions
-> RemoteSchemaPermissions
-> Bool
-> Bool
-> Bool
-> [JWTInfo]
-> AllowListStatus
-> LiveQueriesOptions
-> LiveQueriesOptions
-> Maybe Text
-> HashSet ExperimentalFeature
-> Bool
-> NamingCase
-> HashSet FeatureFlagInfo
-> ServerConfig
ServerConfig
      Version
currentVersion
      InferFunctionPermissions
functionPermsCtx
      RemoteSchemaPermissions
remoteSchemaPermsCtx
      (AuthMode -> Bool
isAdminSecretSet AuthMode
am)
      (AuthMode -> Bool
isAuthHookSet AuthMode
am)
      (AuthMode -> Bool
isJWTSet AuthMode
am)
      (AuthMode -> [JWTInfo]
getJWTInfo AuthMode
am)
      AllowListStatus
allowListStatus
      LiveQueriesOptions
liveQueryOpts
      LiveQueriesOptions
streamQueryOpts
      Maybe Text
consoleAssetsDir
      HashSet ExperimentalFeature
experimentalFeatures
      Bool
isPrometheusMetricsEnabled
      NamingCase
defaultNamingConvention
      HashSet FeatureFlagInfo
featureFlagSettings
    where
      isPrometheusMetricsEnabled :: Bool
isPrometheusMetricsEnabled = API
METRICS API -> HashSet API -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet API
enabledAPIs
      featureFlagSettings :: HashSet FeatureFlagInfo
featureFlagSettings =
        [FeatureFlagInfo] -> HashSet FeatureFlagInfo
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList
          ([FeatureFlagInfo] -> HashSet FeatureFlagInfo)
-> [FeatureFlagInfo] -> HashSet FeatureFlagInfo
forall a b. (a -> b) -> a -> b
$ ( \(FeatureFlag {Text
ffIdentifier :: Text
ffIdentifier :: FeatureFlag -> Text
ffIdentifier}, Text
description, Bool
enabled) ->
                FeatureFlagInfo
                  { ffiName :: Text
ffiName = Text
ffIdentifier,
                    ffiEnabled :: Bool
ffiEnabled = Bool
enabled,
                    ffiDescription :: Text
ffiDescription = Text
description
                  }
            )
          ((FeatureFlag, Text, Bool) -> FeatureFlagInfo)
-> [(FeatureFlag, Text, Bool)] -> [FeatureFlagInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FeatureFlag, Text, Bool)]
featureFlags

isAdminSecretSet :: AuthMode -> Bool
isAdminSecretSet :: AuthMode -> Bool
isAdminSecretSet = \case
  AuthMode
AMNoAuth -> Bool
False
  AuthMode
_ -> Bool
True

isAuthHookSet :: AuthMode -> Bool
isAuthHookSet :: AuthMode -> Bool
isAuthHookSet = \case
  AMAdminSecretAndHook HashSet AdminSecretHash
_ AuthHook
_ -> Bool
True
  AuthMode
_ -> Bool
False

isJWTSet :: AuthMode -> Bool
isJWTSet :: AuthMode -> Bool
isJWTSet = \case
  AMAdminSecretAndJWT {} -> Bool
True
  AuthMode
_ -> Bool
False

getJWTInfo :: AuthMode -> [JWTInfo]
getJWTInfo :: AuthMode -> [JWTInfo]
getJWTInfo (AMAdminSecretAndJWT HashSet AdminSecretHash
_ [JWTCtx]
jwtCtxs Maybe RoleName
_) =
  let f :: JWTCtx -> JWTInfo
f JWTCtx
jwtCtx = case JWTCtx -> JWTClaims
jcxClaims JWTCtx
jwtCtx of
        JCNamespace JWTNamespace
namespace JWTClaimsFormat
claimsFormat ->
          JWTNamespace
-> JWTClaimsFormat -> Maybe JWTCustomClaimsMap -> JWTInfo
JWTInfo JWTNamespace
namespace JWTClaimsFormat
claimsFormat Maybe JWTCustomClaimsMap
forall a. Maybe a
Nothing
        JCMap JWTCustomClaimsMap
claimsMap ->
          JWTNamespace
-> JWTClaimsFormat -> Maybe JWTCustomClaimsMap -> JWTInfo
JWTInfo (Text -> JWTNamespace
ClaimNs Text
defaultClaimsNamespace) JWTClaimsFormat
defaultClaimsFormat (Maybe JWTCustomClaimsMap -> JWTInfo)
-> Maybe JWTCustomClaimsMap -> JWTInfo
forall a b. (a -> b) -> a -> b
$ JWTCustomClaimsMap -> Maybe JWTCustomClaimsMap
forall a. a -> Maybe a
Just JWTCustomClaimsMap
claimsMap
   in (JWTCtx -> JWTInfo) -> [JWTCtx] -> [JWTInfo]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JWTCtx -> JWTInfo
f [JWTCtx]
jwtCtxs
getJWTInfo AuthMode
_ = [JWTInfo]
forall a. Monoid a => a
mempty