module Hasura.Session
  ( SessionVariable,
    mkSessionVariable,
    SessionVariables,
    filterSessionVariables,
    SessionVariableValue,
    sessionVariableToText,
    sessionVariableToGraphQLName,
    mkSessionVariablesText,
    mkSessionVariablesHeaders,
    sessionVariablesToHeaders,
    getSessionVariableValue,
    getSessionVariablesSet,
    getSessionVariables,
    UserAdminSecret (..),
    UserRoleBuild (..),
    UserInfo (..),
    UserInfoM (..),
    askCurRole,
    mkUserInfo,
    adminUserInfo,
    BackendOnlyFieldAccess (..),
    ExtraUserInfo (..),
    maybeRoleFromSessionVariables,
  )
where

import Data.CaseInsensitive qualified as CI
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as Set
import Data.Text qualified as T
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Roles (RoleName, adminRoleName, mkRoleName, roleNameToTxt)
import Hasura.RQL.Types.Session (BackendOnlyFieldAccess (..), ExtraUserInfo (..), SessionVariable (..), SessionVariableValue, SessionVariables (..), UserInfo (..), UserInfoM (..), UserRoleBuild (..), mkSessionVariable, mkSessionVariablesText, sessionVariableToText)
import Hasura.Server.Utils
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP

-- | Converts a `SessionVariable` value to a GraphQL name.
-- This will fail if the session variable contains characters that are not valid
-- for a graphql names. It is the caller's responsibility to decide what to do
-- in such a case.
sessionVariableToGraphQLName :: SessionVariable -> Maybe G.Name
sessionVariableToGraphQLName :: SessionVariable -> Maybe Name
sessionVariableToGraphQLName = Text -> Maybe Name
G.mkName (Text -> Maybe Name)
-> (SessionVariable -> Text) -> SessionVariable -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"-" Text
"_" (Text -> Text)
-> (SessionVariable -> Text) -> SessionVariable -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariable -> Text
sessionVariableToText

filterSessionVariables ::
  (SessionVariable -> SessionVariableValue -> Bool) ->
  SessionVariables ->
  SessionVariables
filterSessionVariables :: (SessionVariable -> Text -> Bool)
-> SessionVariables -> SessionVariables
filterSessionVariables SessionVariable -> Text -> Bool
f = HashMap SessionVariable Text -> SessionVariables
SessionVariables (HashMap SessionVariable Text -> SessionVariables)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> SessionVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> Text -> Bool)
-> HashMap SessionVariable Text -> HashMap SessionVariable Text
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey SessionVariable -> Text -> Bool
f (HashMap SessionVariable Text -> HashMap SessionVariable Text)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> HashMap SessionVariable Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> HashMap SessionVariable Text
unSessionVariables

mkSessionVariablesHeaders :: [HTTP.Header] -> SessionVariables
mkSessionVariablesHeaders :: [Header] -> SessionVariables
mkSessionVariablesHeaders =
  HashMap SessionVariable Text -> SessionVariables
SessionVariables
    (HashMap SessionVariable Text -> SessionVariables)
-> ([Header] -> HashMap SessionVariable Text)
-> [Header]
-> SessionVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SessionVariable, Text)] -> HashMap SessionVariable Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    ([(SessionVariable, Text)] -> HashMap SessionVariable Text)
-> ([Header] -> [(SessionVariable, Text)])
-> [Header]
-> HashMap SessionVariable Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI Text, Text) -> (SessionVariable, Text))
-> [(CI Text, Text)] -> [(SessionVariable, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((CI Text -> SessionVariable)
-> (CI Text, Text) -> (SessionVariable, Text)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first CI Text -> SessionVariable
SessionVariable)
    ([(CI Text, Text)] -> [(SessionVariable, Text)])
-> ([Header] -> [(CI Text, Text)])
-> [Header]
-> [(SessionVariable, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI Text, Text) -> Bool) -> [(CI Text, Text)] -> [(CI Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
isSessionVariable (Text -> Bool)
-> ((CI Text, Text) -> Text) -> (CI Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text)
-> ((CI Text, Text) -> CI Text) -> (CI Text, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI Text, Text) -> CI Text
forall a b. (a, b) -> a
fst) -- Only x-hasura-* headers
    ([(CI Text, Text)] -> [(CI Text, Text)])
-> ([Header] -> [(CI Text, Text)]) -> [Header] -> [(CI Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> (CI Text, Text)) -> [Header] -> [(CI Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Text) -> CI ByteString -> CI Text
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
bsToTxt (CI ByteString -> CI Text)
-> (ByteString -> Text) -> Header -> (CI Text, Text)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ByteString -> Text
bsToTxt)

sessionVariablesToHeaders :: SessionVariables -> [HTTP.Header]
sessionVariablesToHeaders :: SessionVariables -> [Header]
sessionVariablesToHeaders =
  ((SessionVariable, Text) -> Header)
-> [(SessionVariable, Text)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map (((Text -> ByteString) -> CI Text -> CI ByteString
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map Text -> ByteString
txtToBs (CI Text -> CI ByteString)
-> (SessionVariable -> CI Text) -> SessionVariable -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariable -> CI Text
unSessionVariable) (SessionVariable -> CI ByteString)
-> (Text -> ByteString) -> (SessionVariable, Text) -> Header
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> ByteString
txtToBs)
    ([(SessionVariable, Text)] -> [Header])
-> (SessionVariables -> [(SessionVariable, Text)])
-> SessionVariables
-> [Header]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap SessionVariable Text -> [(SessionVariable, Text)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    (HashMap SessionVariable Text -> [(SessionVariable, Text)])
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> [(SessionVariable, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> HashMap SessionVariable Text
unSessionVariables

getSessionVariables :: SessionVariables -> [Text]
getSessionVariables :: SessionVariables -> [Text]
getSessionVariables = (SessionVariable -> Text) -> [SessionVariable] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SessionVariable -> Text
sessionVariableToText ([SessionVariable] -> [Text])
-> (SessionVariables -> [SessionVariable])
-> SessionVariables
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap SessionVariable Text -> [SessionVariable]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap SessionVariable Text -> [SessionVariable])
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> [SessionVariable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> HashMap SessionVariable Text
unSessionVariables

getSessionVariablesSet :: SessionVariables -> Set.HashSet SessionVariable
getSessionVariablesSet :: SessionVariables -> HashSet SessionVariable
getSessionVariablesSet = HashMap SessionVariable Text -> HashSet SessionVariable
forall k a. HashMap k a -> HashSet k
HashMap.keysSet (HashMap SessionVariable Text -> HashSet SessionVariable)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> HashSet SessionVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> HashMap SessionVariable Text
unSessionVariables

getSessionVariableValue :: SessionVariable -> SessionVariables -> Maybe SessionVariableValue
getSessionVariableValue :: SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
k = SessionVariable -> HashMap SessionVariable Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SessionVariable
k (HashMap SessionVariable Text -> Maybe Text)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> HashMap SessionVariable Text
unSessionVariables

-- | Represent the admin secret state; whether the secret is sent
-- in the request or if actually authorization is not configured.
data UserAdminSecret
  = UAdminSecretSent
  | UAdminSecretNotSent
  | UAuthNotSet
  deriving (Int -> UserAdminSecret -> ShowS
[UserAdminSecret] -> ShowS
UserAdminSecret -> String
(Int -> UserAdminSecret -> ShowS)
-> (UserAdminSecret -> String)
-> ([UserAdminSecret] -> ShowS)
-> Show UserAdminSecret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserAdminSecret -> ShowS
showsPrec :: Int -> UserAdminSecret -> ShowS
$cshow :: UserAdminSecret -> String
show :: UserAdminSecret -> String
$cshowList :: [UserAdminSecret] -> ShowS
showList :: [UserAdminSecret] -> ShowS
Show, UserAdminSecret -> UserAdminSecret -> Bool
(UserAdminSecret -> UserAdminSecret -> Bool)
-> (UserAdminSecret -> UserAdminSecret -> Bool)
-> Eq UserAdminSecret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserAdminSecret -> UserAdminSecret -> Bool
== :: UserAdminSecret -> UserAdminSecret -> Bool
$c/= :: UserAdminSecret -> UserAdminSecret -> Bool
/= :: UserAdminSecret -> UserAdminSecret -> Bool
Eq)

askCurRole :: (UserInfoM m) => m RoleName
askCurRole :: forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole = UserInfo -> RoleName
_uiRole (UserInfo -> RoleName) -> m UserInfo -> m RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo

-- | Build @'UserInfo' from @'SessionVariables'
mkUserInfo ::
  forall m.
  (MonadError QErr m) =>
  UserRoleBuild ->
  UserAdminSecret ->
  SessionVariables ->
  m UserInfo
mkUserInfo :: forall (m :: * -> *).
MonadError QErr m =>
UserRoleBuild -> UserAdminSecret -> SessionVariables -> m UserInfo
mkUserInfo UserRoleBuild
roleBuild UserAdminSecret
userAdminSecret SessionVariables
sessionVariables = do
  RoleName
roleName <- case UserRoleBuild
roleBuild of
    UserRoleBuild
URBFromSessionVariables ->
      Maybe RoleName -> m RoleName -> m RoleName
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe RoleName
maybeSessionRole
        (m RoleName -> m RoleName) -> m RoleName -> m RoleName
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m RoleName
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidParams
        (Text -> m RoleName) -> Text -> m RoleName
forall a b. (a -> b) -> a -> b
$ Text
forall a. IsString a => a
userRoleHeader
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found in session variables"
    URBFromSessionVariablesFallback RoleName
roleName' -> RoleName -> m RoleName
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RoleName -> m RoleName) -> RoleName -> m RoleName
forall a b. (a -> b) -> a -> b
$ RoleName -> Maybe RoleName -> RoleName
forall a. a -> Maybe a -> a
fromMaybe RoleName
roleName' Maybe RoleName
maybeSessionRole
    URBPreDetermined RoleName
roleName' -> RoleName -> m RoleName
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RoleName
roleName'
  BackendOnlyFieldAccess
backendOnlyFieldAccess <- m BackendOnlyFieldAccess
getBackendOnlyFieldAccess
  let modifiedSession :: SessionVariables
modifiedSession = RoleName -> SessionVariables -> SessionVariables
modifySessionVariables RoleName
roleName SessionVariables
sessionVariables
  UserInfo -> m UserInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserInfo -> m UserInfo) -> UserInfo -> m UserInfo
forall a b. (a -> b) -> a -> b
$ RoleName -> SessionVariables -> BackendOnlyFieldAccess -> UserInfo
UserInfo RoleName
roleName SessionVariables
modifiedSession BackendOnlyFieldAccess
backendOnlyFieldAccess
  where
    maybeSessionRole :: Maybe RoleName
maybeSessionRole = SessionVariables -> Maybe RoleName
maybeRoleFromSessionVariables SessionVariables
sessionVariables

    modifySessionVariables :: RoleName -> SessionVariables -> SessionVariables
    modifySessionVariables :: RoleName -> SessionVariables -> SessionVariables
modifySessionVariables RoleName
roleName =
      HashMap SessionVariable Text -> SessionVariables
SessionVariables
        (HashMap SessionVariable Text -> SessionVariables)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> SessionVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariable
-> Text
-> HashMap SessionVariable Text
-> HashMap SessionVariable Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert SessionVariable
forall a. IsString a => a
userRoleHeader (RoleName -> Text
roleNameToTxt RoleName
roleName)
        (HashMap SessionVariable Text -> HashMap SessionVariable Text)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> HashMap SessionVariable Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariable
-> HashMap SessionVariable Text -> HashMap SessionVariable Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete SessionVariable
forall a. IsString a => a
adminSecretHeader
        (HashMap SessionVariable Text -> HashMap SessionVariable Text)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> HashMap SessionVariable Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariable
-> HashMap SessionVariable Text -> HashMap SessionVariable Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete SessionVariable
forall a. IsString a => a
deprecatedAccessKeyHeader
        (HashMap SessionVariable Text -> HashMap SessionVariable Text)
-> (SessionVariables -> HashMap SessionVariable Text)
-> SessionVariables
-> HashMap SessionVariable Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionVariables -> HashMap SessionVariable Text
unSessionVariables

    getBackendOnlyFieldAccess :: m BackendOnlyFieldAccess
    getBackendOnlyFieldAccess :: m BackendOnlyFieldAccess
getBackendOnlyFieldAccess = case UserAdminSecret
userAdminSecret of
      UserAdminSecret
UAdminSecretNotSent -> BackendOnlyFieldAccess -> m BackendOnlyFieldAccess
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackendOnlyFieldAccess
BOFADisallowed
      UserAdminSecret
UAdminSecretSent -> m BackendOnlyFieldAccess
lookForBackendOnlyPermissionsConfig
      UserAdminSecret
UAuthNotSet -> m BackendOnlyFieldAccess
lookForBackendOnlyPermissionsConfig
      where
        lookForBackendOnlyPermissionsConfig :: m BackendOnlyFieldAccess
lookForBackendOnlyPermissionsConfig =
          case SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
forall a. IsString a => a
useBackendOnlyPermissionsHeader SessionVariables
sessionVariables of
            Maybe Text
Nothing -> BackendOnlyFieldAccess -> m BackendOnlyFieldAccess
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackendOnlyFieldAccess
BOFADisallowed
            Just Text
varVal ->
              case String -> Either String Bool
parseStringAsBool (Text -> String
T.unpack Text
varVal) of
                Left String
err ->
                  Code -> Text -> m BackendOnlyFieldAccess
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest
                    (Text -> m BackendOnlyFieldAccess)
-> Text -> m BackendOnlyFieldAccess
forall a b. (a -> b) -> a -> b
$ Text
forall a. IsString a => a
useBackendOnlyPermissionsHeader
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
                Right Bool
privilege -> BackendOnlyFieldAccess -> m BackendOnlyFieldAccess
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackendOnlyFieldAccess -> m BackendOnlyFieldAccess)
-> BackendOnlyFieldAccess -> m BackendOnlyFieldAccess
forall a b. (a -> b) -> a -> b
$ if Bool
privilege then BackendOnlyFieldAccess
BOFAAllowed else BackendOnlyFieldAccess
BOFADisallowed

maybeRoleFromSessionVariables :: SessionVariables -> Maybe RoleName
maybeRoleFromSessionVariables :: SessionVariables -> Maybe RoleName
maybeRoleFromSessionVariables SessionVariables
sessionVariables =
  -- returns Nothing if x-hasura-role is an empty string
  SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
forall a. IsString a => a
userRoleHeader SessionVariables
sessionVariables Maybe Text -> (Text -> Maybe RoleName) -> Maybe RoleName
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe RoleName
mkRoleName

adminUserInfo :: UserInfo
adminUserInfo :: UserInfo
adminUserInfo = RoleName -> SessionVariables -> BackendOnlyFieldAccess -> UserInfo
UserInfo RoleName
adminRoleName SessionVariables
forall a. Monoid a => a
mempty BackendOnlyFieldAccess
BOFADisallowed