mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
b81d22f583
The connection handler in websocket transport was not using the 'UserAuthentication' interface to resolve user info. Fix resolving user info in websocket transport to use the common 'UserAuthentication' interface
282 lines
8.6 KiB
Haskell
282 lines
8.6 KiB
Haskell
module Hasura.Server.Auth
|
|
( getUserInfo
|
|
, getUserInfoWithExpTime
|
|
, AuthMode(..)
|
|
, mkAuthMode
|
|
, AdminSecret (..)
|
|
, AuthHookType(..)
|
|
, AuthHookG (..)
|
|
, AuthHook
|
|
-- JWT related
|
|
, RawJWT
|
|
, JWTConfig (..)
|
|
, JWTCtx (..)
|
|
, JWKSet (..)
|
|
, processJwt
|
|
, updateJwkRef
|
|
, jwkRefreshCtrl
|
|
, UserAuthentication (..)
|
|
) where
|
|
|
|
import Control.Exception (try)
|
|
import Control.Lens
|
|
import Data.Aeson
|
|
import Data.IORef (newIORef)
|
|
import Data.Time.Clock (UTCTime)
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.Text as T
|
|
import qualified Network.HTTP.Client as H
|
|
import qualified Network.HTTP.Types as N
|
|
import qualified Network.Wreq as Wreq
|
|
|
|
import Hasura.HTTP
|
|
import Hasura.Logging
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types
|
|
import Hasura.Server.Auth.JWT
|
|
import Hasura.Server.Logging
|
|
import Hasura.Server.Utils
|
|
|
|
-- | Typeclass representing the @UserInfo@ authorization and resolving effect
|
|
class (Monad m) => UserAuthentication m where
|
|
resolveUserInfo
|
|
:: Logger Hasura
|
|
-> H.Manager
|
|
-> [N.Header]
|
|
-- ^ request headers
|
|
-> AuthMode
|
|
-> m (Either QErr (UserInfo, Maybe UTCTime))
|
|
|
|
newtype AdminSecret
|
|
= AdminSecret { getAdminSecret :: T.Text }
|
|
deriving (Show, Eq)
|
|
|
|
data AuthHookType
|
|
= AHTGet
|
|
| AHTPost
|
|
deriving (Eq)
|
|
|
|
instance Show AuthHookType where
|
|
show AHTGet = "GET"
|
|
show AHTPost = "POST"
|
|
|
|
data AuthHookG a b
|
|
= AuthHookG
|
|
{ ahUrl :: !a
|
|
, ahType :: !b
|
|
} deriving (Show, Eq)
|
|
|
|
type AuthHook = AuthHookG T.Text AuthHookType
|
|
|
|
data AuthMode
|
|
= AMNoAuth
|
|
| AMAdminSecret !AdminSecret !(Maybe RoleName)
|
|
| AMAdminSecretAndHook !AdminSecret !AuthHook
|
|
| AMAdminSecretAndJWT !AdminSecret !JWTCtx !(Maybe RoleName)
|
|
deriving (Show, Eq)
|
|
|
|
mkAuthMode
|
|
:: ( MonadIO m
|
|
, MonadError T.Text m
|
|
)
|
|
=> Maybe AdminSecret
|
|
-> Maybe AuthHook
|
|
-> Maybe JWTConfig
|
|
-> Maybe RoleName
|
|
-> H.Manager
|
|
-> Logger Hasura
|
|
-> m AuthMode
|
|
mkAuthMode mAdminSecret mWebHook mJwtSecret mUnAuthRole httpManager logger =
|
|
case (mAdminSecret, mWebHook, mJwtSecret) of
|
|
(Nothing, Nothing, Nothing) -> return AMNoAuth
|
|
(Just key, Nothing, Nothing) -> return $ AMAdminSecret key mUnAuthRole
|
|
(Just key, Just hook, Nothing) -> unAuthRoleNotReqForWebHook >>
|
|
return (AMAdminSecretAndHook key hook)
|
|
(Just key, Nothing, Just jwtConf) -> do
|
|
jwtCtx <- mkJwtCtx jwtConf httpManager logger
|
|
return $ AMAdminSecretAndJWT key jwtCtx mUnAuthRole
|
|
|
|
(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"
|
|
unAuthRoleNotReqForWebHook =
|
|
when (isJust mUnAuthRole) $ throwError $
|
|
"Fatal Error: --unauthorized-role (HASURA_GRAPHQL_UNAUTHORIZED_ROLE) is not allowed"
|
|
<> " when --auth-hook (HASURA_GRAPHQL_AUTH_HOOK) is set"
|
|
|
|
mkJwtCtx
|
|
:: ( MonadIO m
|
|
, MonadError T.Text m
|
|
)
|
|
=> JWTConfig
|
|
-> H.Manager
|
|
-> Logger Hasura
|
|
-> m JWTCtx
|
|
mkJwtCtx conf httpManager logger = do
|
|
jwkRef <- case jcKeyOrUrl conf of
|
|
Left jwk -> liftIO $ newIORef (JWKSet [jwk])
|
|
Right url -> do
|
|
ref <- liftIO $ newIORef $ JWKSet []
|
|
mTime <- updateJwkRef logger httpManager url ref
|
|
case mTime of
|
|
Nothing -> return ref
|
|
Just t -> do
|
|
jwkRefreshCtrl logger httpManager url ref t
|
|
return ref
|
|
let claimsFmt = fromMaybe JCFJson (jcClaimsFormat conf)
|
|
return $ JWTCtx jwkRef (jcClaimNs conf) (jcAudience conf) claimsFmt (jcIssuer conf)
|
|
|
|
mkUserInfoFromResp
|
|
:: (MonadIO m, MonadError QErr m)
|
|
=> Logger Hasura
|
|
-> T.Text
|
|
-> N.StdMethod
|
|
-> N.Status
|
|
-> BL.ByteString
|
|
-> m UserInfo
|
|
mkUserInfoFromResp logger url method statusCode respBody
|
|
| statusCode == N.status200 =
|
|
case eitherDecode respBody of
|
|
Left e -> do
|
|
logError
|
|
throw500 $ "Invalid response from authorization hook: " <> T.pack e
|
|
Right rawHeaders -> getUserInfoFromHdrs rawHeaders
|
|
|
|
| statusCode == N.status401 = do
|
|
logError
|
|
throw401 "Authentication hook unauthorized this request"
|
|
|
|
| otherwise = do
|
|
logError
|
|
throw500 "Invalid response from authorization hook"
|
|
where
|
|
getUserInfoFromHdrs rawHeaders = do
|
|
let usrVars = mkUserVars $ Map.toList rawHeaders
|
|
case roleFromVars usrVars of
|
|
Nothing -> do
|
|
logError
|
|
throw500 "missing x-hasura-role key in webhook response"
|
|
Just rn -> do
|
|
logWebHookResp LevelInfo Nothing
|
|
return $ mkUserInfo rn usrVars
|
|
|
|
logError =
|
|
logWebHookResp LevelError $ Just respBody
|
|
|
|
logWebHookResp logLevel mResp =
|
|
unLogger logger $ WebHookLog logLevel (Just statusCode)
|
|
url method Nothing $ fmap (bsToTxt . BL.toStrict) mResp
|
|
|
|
userInfoFromAuthHook
|
|
:: (MonadIO m, MonadError QErr m)
|
|
=> Logger Hasura
|
|
-> H.Manager
|
|
-> AuthHook
|
|
-> [N.Header]
|
|
-> m UserInfo
|
|
userInfoFromAuthHook logger manager hook reqHeaders = do
|
|
res <- liftIO $ try $ bool withGET withPOST isPost
|
|
resp <- either logAndThrow return res
|
|
let status = resp ^. Wreq.responseStatus
|
|
respBody = resp ^. Wreq.responseBody
|
|
|
|
mkUserInfoFromResp logger urlT method status respBody
|
|
where
|
|
mkOptions = wreqOptions manager
|
|
AuthHookG urlT ty = hook
|
|
isPost = case ty of
|
|
AHTPost -> True
|
|
AHTGet -> False
|
|
method = bool N.GET N.POST isPost
|
|
|
|
withGET = Wreq.getWith (mkOptions filteredHeaders) $
|
|
T.unpack urlT
|
|
|
|
contentType = ("Content-Type", "application/json")
|
|
postHdrsPayload = J.toJSON $ Map.fromList $ hdrsToText reqHeaders
|
|
withPOST = Wreq.postWith (mkOptions [contentType]) (T.unpack urlT) $
|
|
object ["headers" J..= postHdrsPayload]
|
|
|
|
logAndThrow err = do
|
|
unLogger logger $
|
|
WebHookLog LevelError Nothing urlT method
|
|
(Just $ HttpException err) Nothing
|
|
throw500 "Internal Server Error"
|
|
|
|
filteredHeaders = flip filter reqHeaders $ \(n, _) ->
|
|
n `notElem` commonClientHeadersIgnored
|
|
|
|
getUserInfo
|
|
:: (MonadIO m, MonadError QErr m)
|
|
=> Logger Hasura
|
|
-> H.Manager
|
|
-> [N.Header]
|
|
-> AuthMode
|
|
-> m UserInfo
|
|
getUserInfo l m r a = fst <$> getUserInfoWithExpTime l m r a
|
|
|
|
getUserInfoWithExpTime
|
|
:: (MonadIO m, MonadError QErr m)
|
|
=> Logger Hasura
|
|
-> H.Manager
|
|
-> [N.Header]
|
|
-> AuthMode
|
|
-> m (UserInfo, Maybe UTCTime)
|
|
getUserInfoWithExpTime logger manager rawHeaders = \case
|
|
|
|
AMNoAuth -> return (userInfoFromHeaders, Nothing)
|
|
|
|
AMAdminSecret adminScrt unAuthRole ->
|
|
case adminSecretM of
|
|
Just givenAdminScrt ->
|
|
withNoExpTime $ userInfoWhenAdminSecret adminScrt givenAdminScrt
|
|
Nothing ->
|
|
withNoExpTime $ userInfoWhenNoAdminSecret unAuthRole
|
|
|
|
AMAdminSecretAndHook accKey hook ->
|
|
whenAdminSecretAbsent accKey $
|
|
withNoExpTime $ userInfoFromAuthHook logger manager hook rawHeaders
|
|
|
|
AMAdminSecretAndJWT accKey jwtSecret unAuthRole ->
|
|
whenAdminSecretAbsent accKey (processJwt jwtSecret rawHeaders unAuthRole)
|
|
|
|
where
|
|
-- when admin secret is absent, run the action to retrieve UserInfo, otherwise
|
|
-- adminsecret override
|
|
whenAdminSecretAbsent ak action =
|
|
maybe action (withNoExpTime . userInfoWhenAdminSecret ak) adminSecretM
|
|
|
|
adminSecretM= foldl1 (<|>) $
|
|
map (`getVarVal` usrVars) [adminSecretHeader, deprecatedAccessKeyHeader]
|
|
|
|
usrVars = mkUserVars $ hdrsToText rawHeaders
|
|
|
|
userInfoWhenAdminSecret key reqKey = do
|
|
when (reqKey /= getAdminSecret key) $ throw401 $
|
|
"invalid " <> adminSecretHeader <> "/" <> deprecatedAccessKeyHeader
|
|
return userInfoFromHeaders
|
|
|
|
userInfoWhenNoAdminSecret = \case
|
|
Nothing -> throw401 $ adminSecretHeader <> "/"
|
|
<> deprecatedAccessKeyHeader <> " required, but not found"
|
|
Just role -> return $ mkUserInfo role usrVars
|
|
|
|
withNoExpTime a = (, Nothing) <$> a
|
|
|
|
userInfoFromHeaders =
|
|
case roleFromVars usrVars of
|
|
Just rn -> mkUserInfo rn usrVars
|
|
Nothing -> mkUserInfo adminRole usrVars
|