{-# LANGUAGE TemplateHaskell #-}

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

import Data.Aeson.TH
import Data.HashSet qualified as Set
import Hasura.GraphQL.Execute.Subscription.Options qualified as ES
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.Server.Auth
import Hasura.Server.Auth.JWT
import Hasura.Server.Types (ExperimentalFeature)
import Hasura.Server.Version (Version, currentVersion)

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
showList :: [JWTInfo] -> ShowS
$cshowList :: [JWTInfo] -> ShowS
show :: JWTInfo -> String
$cshow :: JWTInfo -> String
showsPrec :: Int -> JWTInfo -> ShowS
$cshowsPrec :: Int -> JWTInfo -> ShowS
Show, JWTInfo -> JWTInfo -> Bool
(JWTInfo -> JWTInfo -> Bool)
-> (JWTInfo -> JWTInfo -> Bool) -> Eq JWTInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JWTInfo -> JWTInfo -> Bool
$c/= :: JWTInfo -> JWTInfo -> Bool
== :: JWTInfo -> JWTInfo -> Bool
$c== :: JWTInfo -> JWTInfo -> Bool
Eq)

$(deriveToJSON hasuraJSON ''JWTInfo)

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 -> Bool
scfgIsAllowListEnabled :: !Bool,
    ServerConfig -> LiveQueriesOptions
scfgLiveQueries :: !ES.LiveQueriesOptions,
    ServerConfig -> LiveQueriesOptions
scfgStreamingQueries :: !ES.SubscriptionsOptions,
    ServerConfig -> Maybe Text
scfgConsoleAssetsDir :: !(Maybe Text),
    ServerConfig -> HashSet ExperimentalFeature
scfgExperimentalFeatures :: !(Set.HashSet ExperimentalFeature)
  }
  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
showList :: [ServerConfig] -> ShowS
$cshowList :: [ServerConfig] -> ShowS
show :: ServerConfig -> String
$cshow :: ServerConfig -> String
showsPrec :: Int -> ServerConfig -> ShowS
$cshowsPrec :: Int -> ServerConfig -> ShowS
Show, ServerConfig -> ServerConfig -> Bool
(ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> Bool) -> Eq ServerConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerConfig -> ServerConfig -> Bool
$c/= :: ServerConfig -> ServerConfig -> Bool
== :: ServerConfig -> ServerConfig -> Bool
$c== :: ServerConfig -> ServerConfig -> Bool
Eq)

$(deriveToJSON hasuraJSON ''ServerConfig)

runGetConfig ::
  Options.InferFunctionPermissions ->
  Options.RemoteSchemaPermissions ->
  AuthMode ->
  Bool ->
  ES.LiveQueriesOptions ->
  ES.SubscriptionsOptions ->
  Maybe Text ->
  Set.HashSet ExperimentalFeature ->
  ServerConfig
runGetConfig :: InferFunctionPermissions
-> RemoteSchemaPermissions
-> AuthMode
-> Bool
-> LiveQueriesOptions
-> LiveQueriesOptions
-> Maybe Text
-> HashSet ExperimentalFeature
-> ServerConfig
runGetConfig
  InferFunctionPermissions
functionPermsCtx
  RemoteSchemaPermissions
remoteSchemaPermsCtx
  AuthMode
am
  Bool
isAllowListEnabled
  LiveQueriesOptions
liveQueryOpts
  LiveQueriesOptions
streamQueryOpts
  Maybe Text
consoleAssetsDir
  HashSet ExperimentalFeature
experimentalFeatures =
    Version
-> InferFunctionPermissions
-> RemoteSchemaPermissions
-> Bool
-> Bool
-> Bool
-> [JWTInfo]
-> Bool
-> LiveQueriesOptions
-> LiveQueriesOptions
-> Maybe Text
-> HashSet ExperimentalFeature
-> 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)
      Bool
isAllowListEnabled
      LiveQueriesOptions
liveQueryOpts
      LiveQueriesOptions
streamQueryOpts
      Maybe Text
consoleAssetsDir
      HashSet ExperimentalFeature
experimentalFeatures

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 (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