graphql-engine/server/src-lib/Hasura/Server/Auth.hs
Robert 11a454c2d6 server, pro: actually reformat the code-base using ormolu
This commit applies ormolu to the whole Haskell code base by running `make format`.

For in-flight branches, simply merging changes from `main` will result in merge conflicts.
To avoid this, update your branch using the following instructions. Replace `<format-commit>`
by the hash of *this* commit.

$ git checkout my-feature-branch
$ git merge <format-commit>^    # and resolve conflicts normally
$ make format
$ git commit -a -m "reformat with ormolu"
$ git merge -s ours post-ormolu

https://github.com/hasura/graphql-engine-mono/pull/2404

GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
2021-09-23 22:57:37 +00:00

266 lines
9.7 KiB
Haskell

{-# LANGUAGE DerivingStrategies #-}
module Hasura.Server.Auth
( getUserInfoWithExpTime,
AuthMode (..),
setupAuthMode,
AdminSecretHash,
hashAdminSecret,
-- * WebHook related
AuthHookType (..),
AuthHookG (..),
AuthHook,
-- * JWT related
RawJWT,
JWTConfig (..),
JWTCtx (..),
JWKSet (..),
processJwt,
updateJwkRef,
UserAuthentication (..),
-- * Exposed for testing
getUserInfoWithExpTime_,
)
where
import Control.Concurrent.Extended (ForkableMonadIO, forkManagedT)
import Control.Monad.Morph (hoist)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Managed (ManagedT)
import Crypto.Hash qualified as Crypto
import Data.IORef (newIORef)
import Data.Text.Encoding qualified as T
import Data.Time.Clock (UTCTime)
import Hasura.Base.Error
import Hasura.GraphQL.Transport.HTTP.Protocol (ReqsText)
import Hasura.Logging
import Hasura.Prelude
import Hasura.Server.Auth.JWT hiding (processJwt_)
import Hasura.Server.Auth.WebHook
import Hasura.Server.Utils
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client qualified as H
import Network.HTTP.Types qualified as N
-- | Typeclass representing the @UserInfo@ authorization and resolving effect
class (Monad m) => UserAuthentication m where
resolveUserInfo ::
HasVersion =>
Logger Hasura ->
H.Manager ->
-- | request headers
[N.Header] ->
AuthMode ->
Maybe ReqsText ->
m (Either QErr (UserInfo, Maybe UTCTime))
-- | The hashed admin password. 'hashAdminSecret' is our public interface for
-- constructing the secret.
--
-- To prevent misuse and leaking we keep this opaque and don't provide
-- instances that could leak information. Likewise for 'AuthMode'.
--
-- Although this exists only in memory we store only a hash of the admin secret
-- primarily in order to:
--
-- - prevent theoretical timing attacks from a naive `==` check
-- - prevent misuse or inadvertent leaking of the secret
newtype AdminSecretHash = AdminSecretHash (Crypto.Digest Crypto.SHA512)
deriving (Ord, Eq)
-- We don't want to be able to leak the secret hash. This is a dummy instance
-- to support 'Show AuthMode' which we want for testing.
instance Show AdminSecretHash where
show _ = "(error \"AdminSecretHash hidden\")"
hashAdminSecret :: Text -> AdminSecretHash
hashAdminSecret = AdminSecretHash . Crypto.hash . T.encodeUtf8
-- | The methods we'll use to derive roles for authenticating requests.
--
-- @Maybe RoleName@ below is the optionally-defined role for the
-- unauthenticated (anonymous) user.
--
-- See: https://hasura.io/docs/latest/graphql/core/auth/authentication/unauthenticated-access.html
data AuthMode
= AMNoAuth
| AMAdminSecret !AdminSecretHash !(Maybe RoleName)
| AMAdminSecretAndHook !AdminSecretHash !AuthHook
| AMAdminSecretAndJWT !AdminSecretHash !JWTCtx !(Maybe RoleName)
deriving (Show, Eq)
-- | Validate the user's requested authentication configuration, launching any
-- required maintenance threads for JWT etc.
--
-- This must only be run once, on launch.
setupAuthMode ::
( HasVersion,
ForkableMonadIO m,
Tracing.HasReporter m
) =>
Maybe AdminSecretHash ->
Maybe AuthHook ->
Maybe JWTConfig ->
Maybe RoleName ->
H.Manager ->
Logger Hasura ->
ExceptT Text (ManagedT m) AuthMode
setupAuthMode mAdminSecretHash mWebHook mJwtSecret mUnAuthRole httpManager logger =
case (mAdminSecretHash, mWebHook, mJwtSecret) of
(Just hash, Nothing, Nothing) -> return $ AMAdminSecret hash mUnAuthRole
(Just hash, Nothing, Just jwtConf) -> do
jwtCtx <- mkJwtCtx jwtConf
return $ AMAdminSecretAndJWT hash jwtCtx mUnAuthRole
-- Nothing below this case uses unauth role. Throw a fatal error if we would otherwise ignore
-- that parameter, lest users misunderstand their auth configuration:
_
| isJust mUnAuthRole ->
throwError $
"Fatal Error: --unauthorized-role (HASURA_GRAPHQL_UNAUTHORIZED_ROLE)"
<> requiresAdminScrtMsg
<> " and is not allowed when --auth-hook (HASURA_GRAPHQL_AUTH_HOOK) is set"
(Nothing, Nothing, Nothing) -> return AMNoAuth
(Just hash, Just hook, Nothing) -> return $ AMAdminSecretAndHook hash hook
(Nothing, Just _, Nothing) ->
throwError $
"Fatal Error : --auth-hook (HASURA_GRAPHQL_AUTH_HOOK)" <> requiresAdminScrtMsg
(Nothing, Nothing, Just _) ->
throwError $
"Fatal Error : --jwt-secret (HASURA_GRAPHQL_JWT_SECRET)" <> requiresAdminScrtMsg
(Nothing, Just _, Just _) ->
throwError
"Fatal Error: Both webhook and JWT mode cannot be enabled at the same time"
(Just _, Just _, Just _) ->
throwError
"Fatal Error: Both webhook and JWT mode cannot be enabled at the same time"
where
requiresAdminScrtMsg =
" requires --admin-secret (HASURA_GRAPHQL_ADMIN_SECRET) or "
<> " --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set"
mkJwtCtx ::
( HasVersion,
ForkableMonadIO m,
Tracing.HasReporter m
) =>
JWTConfig ->
ExceptT Text (ManagedT m) JWTCtx
mkJwtCtx JWTConfig {..} = do
jwkRef <- case jcKeyOrUrl of
Left jwk -> liftIO $ newIORef (JWKSet [jwk])
Right url -> getJwkFromUrl url
let jwtHeader = fromMaybe JHAuthorization jcHeader
return $ JWTCtx jwkRef jcAudience jcIssuer jcClaims jcAllowedSkew jwtHeader
where
-- if we can't find any expiry time for the JWK (either in @Expires@ header or @Cache-Control@
-- header), do not start a background thread for refreshing the JWK
getJwkFromUrl url = do
ref <- liftIO $ newIORef $ JWKSet []
maybeExpiry <- hoist lift $ withJwkError $ Tracing.runTraceT "jwk init" $ updateJwkRef logger httpManager url ref
case maybeExpiry of
Nothing -> return ref
Just time -> do
void . lift $
forkManagedT "jwkRefreshCtrl" logger $
jwkRefreshCtrl logger httpManager url ref (convertDuration time)
return ref
withJwkError act = do
res <- runExceptT act
onLeft res $ \case
-- when fetching JWK initially, except expiry parsing error, all errors are critical
JFEHttpException _ msg -> throwError msg
JFEHttpError _ _ _ e -> throwError e
JFEJwkParseError _ e -> throwError e
JFEExpiryParseError _ _ -> return Nothing
-- | Authenticate the request using the headers and the configured 'AuthMode'.
getUserInfoWithExpTime ::
forall m.
(HasVersion, MonadIO m, MonadBaseControl IO m, MonadError QErr m, Tracing.MonadTrace m) =>
Logger Hasura ->
H.Manager ->
[N.Header] ->
AuthMode ->
Maybe ReqsText ->
m (UserInfo, Maybe UTCTime)
getUserInfoWithExpTime = getUserInfoWithExpTime_ userInfoFromAuthHook processJwt
-- Broken out for testing with mocks:
getUserInfoWithExpTime_ ::
forall m _Manager _Logger_Hasura.
(MonadIO m, MonadError QErr m) =>
-- | mock 'userInfoFromAuthHook'
( _Logger_Hasura ->
_Manager ->
AuthHook ->
[N.Header] ->
Maybe ReqsText ->
m (UserInfo, Maybe UTCTime)
) ->
-- | mock 'processJwt'
(JWTCtx -> [N.Header] -> Maybe RoleName -> m (UserInfo, Maybe UTCTime)) ->
_Logger_Hasura ->
_Manager ->
[N.Header] ->
AuthMode ->
Maybe ReqsText ->
m (UserInfo, Maybe UTCTime)
getUserInfoWithExpTime_ userInfoFromAuthHook_ processJwt_ logger manager rawHeaders authMode reqs = case authMode of
AMNoAuth -> withNoExpTime $ mkUserInfoFallbackAdminRole UAuthNotSet
-- If hasura was started with an admin secret we:
-- - check if a secret was sent in the request
-- - if so, check it and authorize as admin else fail
-- - if not proceed with either webhook or JWT auth if configured
AMAdminSecret realAdminSecretHash maybeUnauthRole ->
checkingSecretIfSent realAdminSecretHash $
withNoExpTime $
-- Consider unauthorized role, if not found raise admin secret header required exception
case maybeUnauthRole of
Nothing ->
throw401 $
adminSecretHeader <> "/"
<> deprecatedAccessKeyHeader
<> " required, but not found"
Just unAuthRole ->
mkUserInfo (URBPreDetermined unAuthRole) UAdminSecretNotSent sessionVariables
-- this is the case that actually ends up consuming the request AST
AMAdminSecretAndHook realAdminSecretHash hook ->
checkingSecretIfSent realAdminSecretHash $ userInfoFromAuthHook_ logger manager hook rawHeaders reqs
AMAdminSecretAndJWT realAdminSecretHash jwtSecret unAuthRole ->
checkingSecretIfSent realAdminSecretHash $ processJwt_ jwtSecret rawHeaders unAuthRole
where
-- CAREFUL!:
mkUserInfoFallbackAdminRole adminSecretState =
mkUserInfo
(URBFromSessionVariablesFallback adminRoleName)
adminSecretState
sessionVariables
sessionVariables = mkSessionVariablesHeaders rawHeaders
checkingSecretIfSent ::
AdminSecretHash -> m (UserInfo, Maybe UTCTime) -> m (UserInfo, Maybe UTCTime)
checkingSecretIfSent realAdminSecretHash actionIfNoAdminSecret = do
let maybeRequestAdminSecret =
foldl1 (<|>) $
map
(`getSessionVariableValue` sessionVariables)
[adminSecretHeader, deprecatedAccessKeyHeader]
-- when admin secret is absent, run the action to retrieve UserInfo
case maybeRequestAdminSecret of
Nothing -> actionIfNoAdminSecret
Just requestAdminSecret -> do
when (hashAdminSecret requestAdminSecret /= realAdminSecretHash) $
throw401 $
"invalid " <> adminSecretHeader <> "/" <> deprecatedAccessKeyHeader
withNoExpTime $ mkUserInfoFallbackAdminRole UAdminSecretSent
withNoExpTime a = (,Nothing) <$> a