mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-14 17:02:49 +03:00
pro/server: add user_id of the collaborator in http_log
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7154 GitOrigin-RevId: 6f60a7c7be5b083e6adf6c3ab9991142f62434df
This commit is contained in:
Naveen Naidu
hasura-bot
parent
f2dd4a5eb7
commit
282e94b2de
@ -1034,9 +1034,9 @@ instance (MonadIO m) => HttpLog (PGMetadataStorageAppT m) where
|
||||
|
||||
emptyExtraHttpLogMetadata = ()
|
||||
|
||||
buildExtraHttpLogMetadata _ = ()
|
||||
buildExtraHttpLogMetadata _ _ = ()
|
||||
|
||||
logHttpError logger loggingSettings userInfoM reqId waiReq req qErr headers =
|
||||
logHttpError logger loggingSettings userInfoM reqId waiReq req qErr headers _ =
|
||||
unLogger logger $
|
||||
mkHttpLog $
|
||||
mkHttpErrorLogContext userInfoM loggingSettings reqId waiReq req qErr Nothing Nothing headers
|
||||
@ -1052,7 +1052,9 @@ instance (Monad m) => MonadExecuteQuery (PGMetadataStorageAppT m) where
|
||||
|
||||
instance (MonadIO m, MonadBaseControl IO m) => UserAuthentication (Tracing.TraceT (PGMetadataStorageAppT m)) where
|
||||
resolveUserInfo logger manager headers authMode reqs =
|
||||
runExceptT $ getUserInfoWithExpTime logger manager headers authMode reqs
|
||||
runExceptT $ do
|
||||
(a, b, c) <- getUserInfoWithExpTime logger manager headers authMode reqs
|
||||
pure $ (a, b, c, ExtraUserInfo Nothing)
|
||||
|
||||
accessDeniedErrMsg :: Text
|
||||
accessDeniedErrMsg =
|
||||
|
||||
@ -727,7 +727,6 @@ runGQBatched ::
|
||||
MonadQueryLog m,
|
||||
MonadTrace m,
|
||||
MonadExecuteQuery m,
|
||||
HttpLog m,
|
||||
MonadMetadataStorage (MetadataStorageT m),
|
||||
EB.MonadQueryTags m,
|
||||
HasResourceLimits m
|
||||
@ -742,13 +741,13 @@ runGQBatched ::
|
||||
E.GraphQLQueryType ->
|
||||
-- | the batched request with unparsed GraphQL query
|
||||
GQLBatchedReqs (GQLReq GQLQueryText) ->
|
||||
m (HttpLogMetadata m, HttpResponse EncJSON)
|
||||
m (HttpLogGraphQLInfo, HttpResponse EncJSON)
|
||||
runGQBatched env logger reqId responseErrorsConfig userInfo ipAddress reqHdrs queryType query =
|
||||
case query of
|
||||
GQLSingleRequest req -> do
|
||||
(gqlQueryOperationLog, httpResp) <- runGQ env logger reqId userInfo ipAddress reqHdrs queryType req
|
||||
let httpLoggingMetadata = buildHttpLogMetadata @m (PQHSetSingleton (gqolParameterizedQueryHash gqlQueryOperationLog)) L.RequestModeSingle (Just (GQLSingleRequest (GQLQueryOperationSuccess gqlQueryOperationLog)))
|
||||
pure (httpLoggingMetadata, snd <$> httpResp)
|
||||
let httpLoggingGQInfo = (CommonHttpLogMetadata L.RequestModeSingle (Just (GQLSingleRequest (GQLQueryOperationSuccess gqlQueryOperationLog))), (PQHSetSingleton (gqolParameterizedQueryHash gqlQueryOperationLog)))
|
||||
pure (httpLoggingGQInfo, snd <$> httpResp)
|
||||
GQLBatchedReqs reqs -> do
|
||||
-- It's unclear what we should do if we receive multiple
|
||||
-- responses with distinct headers, so just do the simplest thing
|
||||
@ -771,7 +770,7 @@ runGQBatched env logger reqId responseErrorsConfig userInfo ipAddress reqHdrs qu
|
||||
)
|
||||
responses
|
||||
parameterizedQueryHashes = map gqolParameterizedQueryHash requestsOperationLogs
|
||||
httpLoggingMetadata = buildHttpLogMetadata @m (PQHSetBatched parameterizedQueryHashes) L.RequestModeBatched (Just (GQLBatchedReqs batchOperationLogs))
|
||||
pure (httpLoggingMetadata, removeHeaders (map ((fmap snd) . snd) responses))
|
||||
httpLoggingGQInfo = (CommonHttpLogMetadata L.RequestModeBatched ((Just (GQLBatchedReqs batchOperationLogs))), PQHSetBatched parameterizedQueryHashes)
|
||||
pure (httpLoggingGQInfo, removeHeaders (map ((fmap snd) . snd) responses))
|
||||
where
|
||||
try = flip catchError (pure . Left) . fmap Right
|
||||
|
||||
@ -1125,7 +1125,7 @@ onConnInit logger manager wsConn authMode connParamsM onConnInitErrAction keepAl
|
||||
logWSEvent logger wsConn $ EConnErr connErr
|
||||
liftIO $ onConnInitErrAction wsConn connErr WS.ConnInitFailed
|
||||
-- we're ignoring the auth headers as headers are irrelevant in websockets
|
||||
Right (userInfo, expTimeM, _authHeaders) -> do
|
||||
Right (userInfo, expTimeM, _authHeaders, _) -> do
|
||||
let !csInit = CSInitialised $ WsClientState userInfo expTimeM paramHeaders ipAddress
|
||||
liftIO $ do
|
||||
$assertNFHere csInit -- so we don't write thunks to mutable vars
|
||||
|
||||
@ -156,13 +156,13 @@ data APIResp
|
||||
-- | API request handlers for different endpoints
|
||||
data APIHandler m a where
|
||||
-- | A simple GET request
|
||||
AHGet :: !(Handler m (HttpLogMetadata m, APIResp)) -> APIHandler m void
|
||||
AHGet :: !(Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m void
|
||||
-- | A simple POST request that expects a request body from which an 'a' can be extracted
|
||||
AHPost :: !(a -> Handler m (HttpLogMetadata m, APIResp)) -> APIHandler m a
|
||||
AHPost :: !(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
|
||||
-- | A general GraphQL request (query or mutation) for which the content of the query
|
||||
-- is made available to the handler for authentication.
|
||||
-- This is a more specific version of the 'AHPost' constructor.
|
||||
AHGraphQLRequest :: !(GH.ReqsText -> Handler m (HttpLogMetadata m, APIResp)) -> APIHandler m GH.ReqsText
|
||||
AHGraphQLRequest :: !(GH.ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m GH.ReqsText
|
||||
|
||||
boolToText :: Bool -> Text
|
||||
boolToText = bool "false" "true"
|
||||
@ -171,13 +171,13 @@ isAdminSecretSet :: AuthMode -> Text
|
||||
isAdminSecretSet AMNoAuth = boolToText False
|
||||
isAdminSecretSet _ = boolToText True
|
||||
|
||||
mkGetHandler :: Handler m (HttpLogMetadata m, APIResp) -> APIHandler m ()
|
||||
mkGetHandler :: Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
|
||||
mkGetHandler = AHGet
|
||||
|
||||
mkPostHandler :: (a -> Handler m (HttpLogMetadata m, APIResp)) -> APIHandler m a
|
||||
mkPostHandler :: (a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
|
||||
mkPostHandler = AHPost
|
||||
|
||||
mkGQLRequestHandler :: (GH.ReqsText -> Handler m (HttpLogMetadata m, APIResp)) -> APIHandler m GH.ReqsText
|
||||
mkGQLRequestHandler :: (GH.ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m GH.ReqsText
|
||||
mkGQLRequestHandler = AHGraphQLRequest
|
||||
|
||||
mkAPIRespHandler :: (Functor m) => (a -> Handler m (HttpResponse EncJSON)) -> (a -> Handler m APIResp)
|
||||
@ -266,7 +266,15 @@ mapActionT ::
|
||||
mapActionT f tma = MTC.restoreT . pure =<< MTC.liftWith (\run -> f (run tma))
|
||||
|
||||
mkSpockAction ::
|
||||
(MonadIO m, MonadBaseControl IO m, FromJSON a, UserAuthentication (Tracing.TraceT m), HttpLog m, Tracing.HasReporter m, HasResourceLimits m) =>
|
||||
forall m a.
|
||||
( MonadIO m,
|
||||
MonadBaseControl IO m,
|
||||
FromJSON a,
|
||||
UserAuthentication (Tracing.TraceT m),
|
||||
HttpLog m,
|
||||
Tracing.HasReporter m,
|
||||
HasResourceLimits m
|
||||
) =>
|
||||
ServerCtx ->
|
||||
-- | `QErr` JSON encoder function
|
||||
(Bool -> QErr -> Value) ->
|
||||
@ -288,10 +296,10 @@ mkSpockAction serverCtx@ServerCtx {..} qErrEncoder qErrModifier apiHandler = do
|
||||
handlerLimit <- lift askHTTPHandlerLimit
|
||||
|
||||
let runTraceT ::
|
||||
forall m a.
|
||||
(MonadIO m, Tracing.HasReporter m) =>
|
||||
Tracing.TraceT m a ->
|
||||
m a
|
||||
forall m1 a1.
|
||||
(MonadIO m1, Tracing.HasReporter m1) =>
|
||||
Tracing.TraceT m1 a1 ->
|
||||
m1 a1
|
||||
runTraceT =
|
||||
maybe
|
||||
Tracing.runTraceT
|
||||
@ -300,22 +308,23 @@ mkSpockAction serverCtx@ServerCtx {..} qErrEncoder qErrModifier apiHandler = do
|
||||
(fromString (B8.unpack pathInfo))
|
||||
|
||||
runHandler ::
|
||||
MonadBaseControl IO m =>
|
||||
MonadBaseControl IO m2 =>
|
||||
HandlerCtx ->
|
||||
ReaderT HandlerCtx (MetadataStorageT m) a ->
|
||||
m (Either QErr a)
|
||||
ReaderT HandlerCtx (MetadataStorageT m2) a2 ->
|
||||
m2 (Either QErr a2)
|
||||
runHandler handlerCtx handler =
|
||||
runMetadataStorageT $ flip runReaderT handlerCtx $ runResourceLimits handlerLimit $ handler
|
||||
|
||||
getInfo parsedRequest = do
|
||||
authenticationResp <- lift (resolveUserInfo scLogger scManager headers scAuthMode parsedRequest)
|
||||
authInfo <- onLeft authenticationResp (logErrorAndResp Nothing requestId req (reqBody, Nothing) False origHeaders . qErrModifier)
|
||||
let (userInfo, _, authHeaders) = authInfo
|
||||
authInfo <- onLeft authenticationResp (logErrorAndResp Nothing requestId req (reqBody, Nothing) False origHeaders (ExtraUserInfo Nothing) . qErrModifier)
|
||||
let (userInfo, _, authHeaders, extraUserInfo) = authInfo
|
||||
pure
|
||||
( userInfo,
|
||||
authHeaders,
|
||||
HandlerCtx serverCtx userInfo headers requestId ipAddress,
|
||||
shouldIncludeInternal (_uiRole userInfo) scResponseInternalErrorsConfig
|
||||
shouldIncludeInternal (_uiRole userInfo) scResponseInternalErrorsConfig,
|
||||
extraUserInfo
|
||||
)
|
||||
|
||||
mapActionT runTraceT $ do
|
||||
@ -323,31 +332,31 @@ mkSpockAction serverCtx@ServerCtx {..} qErrEncoder qErrModifier apiHandler = do
|
||||
-- can correlate requests and traces
|
||||
lift $ Tracing.attachMetadata [("request_id", unRequestId requestId)]
|
||||
|
||||
(serviceTime, (result, userInfo, authHeaders, includeInternal, queryJSON)) <- withElapsedTime $ case apiHandler of
|
||||
(serviceTime, (result, userInfo, authHeaders, includeInternal, queryJSON, extraUserInfo)) <- withElapsedTime $ case apiHandler of
|
||||
-- in the case of a simple get/post we don't have to send the webhook anything
|
||||
AHGet handler -> do
|
||||
(userInfo, authHeaders, handlerState, includeInternal) <- getInfo Nothing
|
||||
(userInfo, authHeaders, handlerState, includeInternal, extraUserInfo) <- getInfo Nothing
|
||||
res <- lift $ runHandler handlerState handler
|
||||
pure (res, userInfo, authHeaders, includeInternal, Nothing)
|
||||
pure (res, userInfo, authHeaders, includeInternal, Nothing, extraUserInfo)
|
||||
AHPost handler -> do
|
||||
(userInfo, authHeaders, handlerState, includeInternal) <- getInfo Nothing
|
||||
(userInfo, authHeaders, handlerState, includeInternal, extraUserInfo) <- getInfo Nothing
|
||||
(queryJSON, parsedReq) <-
|
||||
runExcept (parseBody reqBody) `onLeft` \e ->
|
||||
logErrorAndResp (Just userInfo) requestId req (reqBody, Nothing) includeInternal origHeaders $ qErrModifier e
|
||||
runExcept (parseBody reqBody) `onLeft` \e -> do
|
||||
logErrorAndResp (Just userInfo) requestId req (reqBody, Nothing) includeInternal origHeaders extraUserInfo (qErrModifier e)
|
||||
res <- lift $ runHandler handlerState $ handler parsedReq
|
||||
pure (res, userInfo, authHeaders, includeInternal, Just queryJSON)
|
||||
pure (res, userInfo, authHeaders, includeInternal, Just queryJSON, extraUserInfo)
|
||||
-- in this case we parse the request _first_ and then send the request to the webhook for auth
|
||||
AHGraphQLRequest handler -> do
|
||||
(queryJSON, parsedReq) <-
|
||||
runExcept (parseBody reqBody) `onLeft` \e -> do
|
||||
-- if the request fails to parse, call the webhook without a request body
|
||||
-- TODO should we signal this to the webhook somehow?
|
||||
(userInfo, _, _, _) <- getInfo Nothing
|
||||
logErrorAndResp (Just userInfo) requestId req (reqBody, Nothing) False origHeaders $ qErrModifier e
|
||||
(userInfo, authHeaders, handlerState, includeInternal) <- getInfo (Just parsedReq)
|
||||
(userInfo, _, _, _, extraUserInfo) <- getInfo Nothing
|
||||
logErrorAndResp (Just userInfo) requestId req (reqBody, Nothing) False origHeaders extraUserInfo (qErrModifier e)
|
||||
(userInfo, authHeaders, handlerState, includeInternal, extraUserInfo) <- getInfo (Just parsedReq)
|
||||
|
||||
res <- lift $ runHandler handlerState $ handler parsedReq
|
||||
pure (res, userInfo, authHeaders, includeInternal, Just queryJSON)
|
||||
pure (res, userInfo, authHeaders, includeInternal, Just queryJSON, extraUserInfo)
|
||||
|
||||
-- apply the error modifier
|
||||
let modResult = fmapL qErrModifier result
|
||||
@ -355,22 +364,26 @@ mkSpockAction serverCtx@ServerCtx {..} qErrEncoder qErrModifier apiHandler = do
|
||||
-- log and return result
|
||||
case modResult of
|
||||
Left err ->
|
||||
logErrorAndResp (Just userInfo) requestId req (reqBody, queryJSON) includeInternal headers err
|
||||
Right (httpLoggingMetadata, res) ->
|
||||
logSuccessAndResp (Just userInfo) requestId req (reqBody, queryJSON) res (Just (ioWaitTime, serviceTime)) origHeaders authHeaders httpLoggingMetadata
|
||||
logErrorAndResp (Just userInfo) requestId req (reqBody, queryJSON) includeInternal headers extraUserInfo err
|
||||
Right (httpLogGraphQLInfo, res) -> do
|
||||
let httpLogMetadata = buildHttpLogMetadata @m httpLogGraphQLInfo extraUserInfo
|
||||
logSuccessAndResp (Just userInfo) requestId req (reqBody, queryJSON) res (Just (ioWaitTime, serviceTime)) origHeaders authHeaders httpLogMetadata
|
||||
where
|
||||
logErrorAndResp ::
|
||||
(MonadIO m, HttpLog m) =>
|
||||
forall m3 a3 ctx.
|
||||
(MonadIO m3, HttpLog m3) =>
|
||||
Maybe UserInfo ->
|
||||
RequestId ->
|
||||
Wai.Request ->
|
||||
(BL.ByteString, Maybe Value) ->
|
||||
Bool ->
|
||||
[HTTP.Header] ->
|
||||
ExtraUserInfo ->
|
||||
QErr ->
|
||||
Spock.ActionCtxT ctx m a
|
||||
logErrorAndResp userInfo reqId waiReq req includeInternal headers qErr = do
|
||||
lift $ logHttpError scLogger scLoggingSettings userInfo reqId waiReq req qErr headers
|
||||
Spock.ActionCtxT ctx m3 a3
|
||||
logErrorAndResp userInfo reqId waiReq req includeInternal headers extraUserInfo qErr = do
|
||||
let httpLogMetadata = buildHttpLogMetadata @m3 emptyHttpLogGraphQLInfo extraUserInfo
|
||||
lift $ logHttpError scLogger scLoggingSettings userInfo reqId waiReq req qErr headers httpLogMetadata
|
||||
Spock.setStatus $ qeStatus qErr
|
||||
Spock.json $ qErrEncoder includeInternal qErr
|
||||
|
||||
@ -551,14 +564,13 @@ v1Alpha1GQHandler ::
|
||||
GH.MonadExecuteQuery m,
|
||||
MonadError QErr m,
|
||||
MonadReader HandlerCtx m,
|
||||
HttpLog m,
|
||||
MonadMetadataStorage (MetadataStorageT m),
|
||||
EB.MonadQueryTags m,
|
||||
HasResourceLimits m
|
||||
) =>
|
||||
E.GraphQLQueryType ->
|
||||
GH.GQLBatchedReqs (GH.GQLReq GH.GQLQueryText) ->
|
||||
m (HttpLogMetadata m, HttpResponse EncJSON)
|
||||
m (HttpLogGraphQLInfo, HttpResponse EncJSON)
|
||||
v1Alpha1GQHandler queryType query = do
|
||||
userInfo <- asks hcUser
|
||||
reqHeaders <- asks hcReqHeaders
|
||||
@ -596,7 +608,6 @@ v1GQHandler ::
|
||||
MonadQueryLog m,
|
||||
Tracing.MonadTrace m,
|
||||
GH.MonadExecuteQuery m,
|
||||
HttpLog m,
|
||||
MonadError QErr m,
|
||||
MonadReader HandlerCtx m,
|
||||
MonadMetadataStorage (MetadataStorageT m),
|
||||
@ -604,7 +615,7 @@ v1GQHandler ::
|
||||
HasResourceLimits m
|
||||
) =>
|
||||
GH.GQLBatchedReqs (GH.GQLReq GH.GQLQueryText) ->
|
||||
m (HttpLogMetadata m, HttpResponse EncJSON)
|
||||
m (HttpLogGraphQLInfo, HttpResponse EncJSON)
|
||||
v1GQHandler = v1Alpha1GQHandler E.QueryHasura
|
||||
|
||||
v1GQRelayHandler ::
|
||||
@ -613,7 +624,6 @@ v1GQRelayHandler ::
|
||||
E.MonadGQLExecutionCheck m,
|
||||
MonadQueryLog m,
|
||||
Tracing.MonadTrace m,
|
||||
HttpLog m,
|
||||
GH.MonadExecuteQuery m,
|
||||
MonadError QErr m,
|
||||
MonadReader HandlerCtx m,
|
||||
@ -622,7 +632,7 @@ v1GQRelayHandler ::
|
||||
HasResourceLimits m
|
||||
) =>
|
||||
GH.GQLBatchedReqs (GH.GQLReq GH.GQLQueryText) ->
|
||||
m (HttpLogMetadata m, HttpResponse EncJSON)
|
||||
m (HttpLogGraphQLInfo, HttpResponse EncJSON)
|
||||
v1GQRelayHandler = v1Alpha1GQHandler E.QueryRelay
|
||||
|
||||
gqlExplainHandler ::
|
||||
@ -730,7 +740,7 @@ configApiGetHandler serverCtx@ServerCtx {..} consoleAssetsDir =
|
||||
scExperimentalFeatures
|
||||
scEnabledAPIs
|
||||
scDefaultNamingConvention
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue res) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue res) [])
|
||||
|
||||
data HasuraApp = HasuraApp
|
||||
{ _hapApplication :: !Wai.Application,
|
||||
@ -990,12 +1000,11 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir consoleSentry
|
||||
MonadQueryLog n,
|
||||
GH.MonadExecuteQuery n,
|
||||
MonadMetadataStorage (MetadataStorageT n),
|
||||
HttpLog n,
|
||||
EB.MonadQueryTags n,
|
||||
HasResourceLimits n
|
||||
) =>
|
||||
RestRequest Spock.SpockMethod ->
|
||||
Handler (Tracing.TraceT n) (HttpLogMetadata n, APIResp)
|
||||
Handler (Tracing.TraceT n) (HttpLogGraphQLInfo, APIResp)
|
||||
customEndpointHandler restReq = do
|
||||
scRef <- asks (scCacheRef . hcServerCtx)
|
||||
endpoints <- liftIO $ scEndpoints <$> getSchemaCache scRef
|
||||
@ -1043,23 +1052,23 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir consoleSentry
|
||||
|
||||
Spock.post "v1/query" $
|
||||
spockAction encodeQErr id $ do
|
||||
mkPostHandler $ fmap (emptyHttpLogMetadata @m,) <$> mkAPIRespHandler v1QueryHandler
|
||||
mkPostHandler $ fmap (emptyHttpLogGraphQLInfo,) <$> mkAPIRespHandler v1QueryHandler
|
||||
|
||||
Spock.post "v1/metadata" $
|
||||
spockAction encodeQErr id $
|
||||
mkPostHandler $
|
||||
fmap (emptyHttpLogMetadata @m,) <$> mkAPIRespHandler v1MetadataHandler
|
||||
fmap (emptyHttpLogGraphQLInfo,) <$> mkAPIRespHandler v1MetadataHandler
|
||||
|
||||
Spock.post "v2/query" $
|
||||
spockAction encodeQErr id $
|
||||
mkPostHandler $
|
||||
fmap (emptyHttpLogMetadata @m,) <$> mkAPIRespHandler v2QueryHandler
|
||||
fmap (emptyHttpLogGraphQLInfo,) <$> mkAPIRespHandler v2QueryHandler
|
||||
|
||||
when enablePGDump $
|
||||
Spock.post "v1alpha1/pg_dump" $
|
||||
spockAction encodeQErr id $
|
||||
mkPostHandler $
|
||||
fmap (emptyHttpLogMetadata @m,) <$> v1Alpha1PGDumpHandler
|
||||
fmap (emptyHttpLogGraphQLInfo,) <$> v1Alpha1PGDumpHandler
|
||||
|
||||
when enableConfig $ runConfigApiHandler serverCtx consoleAssetsDir
|
||||
|
||||
@ -1099,38 +1108,38 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir consoleSentry
|
||||
mkGetHandler $ do
|
||||
onlyAdmin
|
||||
respJ <- liftIO $ EKG.sampleAll $ scEkgStore serverCtx
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue $ EKG.sampleToJson respJ) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue $ EKG.sampleToJson respJ) [])
|
||||
-- This deprecated endpoint used to show the query plan cache pre-PDV.
|
||||
-- Eventually this endpoint can be removed.
|
||||
Spock.get "dev/plan_cache" $
|
||||
spockAction encodeQErr id $
|
||||
mkGetHandler $ do
|
||||
onlyAdmin
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue J.Null) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue J.Null) [])
|
||||
Spock.get "dev/subscriptions" $
|
||||
spockAction encodeQErr id $
|
||||
mkGetHandler $ do
|
||||
onlyAdmin
|
||||
respJ <- liftIO $ ES.dumpSubscriptionsState False $ scSubscriptionState serverCtx
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue respJ) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue respJ) [])
|
||||
Spock.get "dev/subscriptions/extended" $
|
||||
spockAction encodeQErr id $
|
||||
mkGetHandler $ do
|
||||
onlyAdmin
|
||||
respJ <- liftIO $ ES.dumpSubscriptionsState True $ scSubscriptionState serverCtx
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue respJ) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue respJ) [])
|
||||
Spock.get "dev/dataconnector/schema" $
|
||||
spockAction encodeQErr id $
|
||||
mkGetHandler $ do
|
||||
onlyAdmin
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue openApiSchema) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue openApiSchema) [])
|
||||
Spock.get "api/swagger/json" $
|
||||
spockAction encodeQErr id $
|
||||
mkGetHandler $ do
|
||||
onlyAdmin
|
||||
sc <- liftIO $ getSchemaCache $ scCacheRef serverCtx
|
||||
json <- buildOpenAPI sc
|
||||
return (emptyHttpLogMetadata @m, JSONResp $ HttpResponse (encJFromJValue json) [])
|
||||
return (emptyHttpLogGraphQLInfo, JSONResp $ HttpResponse (encJFromJValue json) [])
|
||||
|
||||
forM_ [Spock.GET, Spock.POST] $ \m -> Spock.hookAny m $ \_ -> do
|
||||
req <- Spock.request
|
||||
@ -1155,7 +1164,7 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir consoleSentry
|
||||
let headers = Wai.requestHeaders req
|
||||
(reqId, _newHeaders) <- getRequestId headers
|
||||
lift $
|
||||
logHttpError logger (scLoggingSettings serverCtx) Nothing reqId req (reqBody, Nothing) err headers
|
||||
logHttpError logger (scLoggingSettings serverCtx) Nothing reqId req (reqBody, Nothing) err headers (emptyHttpLogMetadata @m)
|
||||
|
||||
spockAction ::
|
||||
forall a n.
|
||||
@ -1171,7 +1180,7 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir consoleSentry
|
||||
gqlExplainAction = do
|
||||
spockAction encodeQErr id $
|
||||
mkPostHandler $
|
||||
fmap (emptyHttpLogMetadata @m,) <$> mkAPIRespHandler gqlExplainHandler
|
||||
fmap (emptyHttpLogGraphQLInfo,) <$> mkAPIRespHandler gqlExplainHandler
|
||||
enableGraphQL = isGraphQLEnabled serverCtx
|
||||
enableMetadata = isMetadataEnabled serverCtx
|
||||
enablePGDump = isPGDumpEnabled serverCtx
|
||||
@ -1195,6 +1204,7 @@ httpApp setupHook corsCfg serverCtx enableConsole consoleAssetsDir consoleSentry
|
||||
either (raiseGenericApiError logger (scLoggingSettings serverCtx) headers . internalError . T.pack) Spock.html consoleHtml
|
||||
|
||||
raiseGenericApiError ::
|
||||
forall m.
|
||||
(MonadIO m, HttpLog m) =>
|
||||
L.Logger L.Hasura ->
|
||||
LoggingSettings ->
|
||||
@ -1205,7 +1215,7 @@ raiseGenericApiError logger loggingSetting headers qErr = do
|
||||
req <- Spock.request
|
||||
reqBody <- liftIO $ Wai.strictRequestBody req
|
||||
(reqId, _newHeaders) <- getRequestId $ Wai.requestHeaders req
|
||||
lift $ logHttpError logger loggingSetting Nothing reqId req (reqBody, Nothing) qErr headers
|
||||
lift $ logHttpError logger loggingSetting Nothing reqId req (reqBody, Nothing) qErr headers (emptyHttpLogMetadata @m)
|
||||
setHeader jsonHeader
|
||||
Spock.setStatus $ qeStatus qErr
|
||||
Spock.lazyBytes $ encode qErr
|
||||
|
||||
@ -60,7 +60,7 @@ class (Monad m) => UserAuthentication m where
|
||||
[HTTP.Header] ->
|
||||
AuthMode ->
|
||||
Maybe ReqsText ->
|
||||
m (Either QErr (UserInfo, Maybe UTCTime, [HTTP.Header]))
|
||||
m (Either QErr (UserInfo, Maybe UTCTime, [HTTP.Header], ExtraUserInfo))
|
||||
|
||||
-- | The hashed admin password. 'hashAdminSecret' is our public interface for
|
||||
-- constructing the secret.
|
||||
|
||||
@ -30,6 +30,8 @@ module Hasura.Server.Logging
|
||||
LoggingSettings (..),
|
||||
SchemaSyncThreadType (..),
|
||||
SchemaSyncLog (..),
|
||||
HttpLogGraphQLInfo,
|
||||
emptyHttpLogGraphQLInfo,
|
||||
)
|
||||
where
|
||||
|
||||
@ -204,6 +206,13 @@ data CommonHttpLogMetadata = CommonHttpLogMetadata
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
-- The information from the GraphQL layer that needs to be included in the http-log.
|
||||
-- This info is used to construct 'HttpLogMetadata m'
|
||||
type HttpLogGraphQLInfo = (CommonHttpLogMetadata, ParameterizedQueryHashList)
|
||||
|
||||
emptyHttpLogGraphQLInfo :: HttpLogGraphQLInfo
|
||||
emptyHttpLogGraphQLInfo = (CommonHttpLogMetadata RequestModeNonBatchable Nothing, PQHSetEmpty)
|
||||
|
||||
-- | The http-log metadata attached to HTTP requests running in the monad 'm', split into a
|
||||
-- common portion that is present regardless of 'm', and a monad-specific one defined in the
|
||||
-- 'HttpLog' instance.
|
||||
@ -215,12 +224,11 @@ type HttpLogMetadata m = (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
|
||||
buildHttpLogMetadata ::
|
||||
forall m.
|
||||
HttpLog m =>
|
||||
ParameterizedQueryHashList ->
|
||||
RequestMode ->
|
||||
Maybe (GH.GQLBatchedReqs GQLBatchQueryOperationLog) ->
|
||||
HttpLogGraphQLInfo ->
|
||||
ExtraUserInfo ->
|
||||
HttpLogMetadata m
|
||||
buildHttpLogMetadata paramQueryHashList requestMode batchQueryOperationLog =
|
||||
(CommonHttpLogMetadata requestMode batchQueryOperationLog, buildExtraHttpLogMetadata @m paramQueryHashList)
|
||||
buildHttpLogMetadata (commonHttpLogMetadata, paramQueryHashList) extraUserInfo =
|
||||
(commonHttpLogMetadata, buildExtraHttpLogMetadata @m paramQueryHashList extraUserInfo)
|
||||
|
||||
-- | synonym for clarity, writing `emptyHttpLogMetadata @m` instead of `def @(HttpLogMetadata m)`
|
||||
emptyHttpLogMetadata :: forall m. HttpLog m => HttpLogMetadata m
|
||||
@ -276,7 +284,7 @@ class Monad m => HttpLog m where
|
||||
|
||||
emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata m
|
||||
|
||||
buildExtraHttpLogMetadata :: ParameterizedQueryHashList -> ExtraHttpLogMetadata m
|
||||
buildExtraHttpLogMetadata :: ParameterizedQueryHashList -> ExtraUserInfo -> ExtraHttpLogMetadata m
|
||||
|
||||
logHttpError ::
|
||||
-- | the logger
|
||||
@ -295,6 +303,7 @@ class Monad m => HttpLog m where
|
||||
QErr ->
|
||||
-- | list of request headers
|
||||
[HTTP.Header] ->
|
||||
HttpLogMetadata m ->
|
||||
m ()
|
||||
|
||||
logHttpSuccess ::
|
||||
@ -330,7 +339,7 @@ instance HttpLog m => HttpLog (TraceT m) where
|
||||
buildExtraHttpLogMetadata a = buildExtraHttpLogMetadata @m a
|
||||
emptyExtraHttpLogMetadata = emptyExtraHttpLogMetadata @m
|
||||
|
||||
logHttpError a b c d e f g h = lift $ logHttpError a b c d e f g h
|
||||
logHttpError a b c d e f g h i = lift $ logHttpError a b c d e f g h i
|
||||
|
||||
logHttpSuccess a b c d e f g h i j k l = lift $ logHttpSuccess a b c d e f g h i j k l
|
||||
|
||||
@ -340,7 +349,7 @@ instance HttpLog m => HttpLog (ReaderT r m) where
|
||||
buildExtraHttpLogMetadata a = buildExtraHttpLogMetadata @m a
|
||||
emptyExtraHttpLogMetadata = emptyExtraHttpLogMetadata @m
|
||||
|
||||
logHttpError a b c d e f g h = lift $ logHttpError a b c d e f g h
|
||||
logHttpError a b c d e f g h i = lift $ logHttpError a b c d e f g h i
|
||||
|
||||
logHttpSuccess a b c d e f g h i j k l = lift $ logHttpSuccess a b c d e f g h i j k l
|
||||
|
||||
@ -350,7 +359,7 @@ instance HttpLog m => HttpLog (MetadataStorageT m) where
|
||||
buildExtraHttpLogMetadata a = buildExtraHttpLogMetadata @m a
|
||||
emptyExtraHttpLogMetadata = emptyExtraHttpLogMetadata @m
|
||||
|
||||
logHttpError a b c d e f g h = lift $ logHttpError a b c d e f g h
|
||||
logHttpError a b c d e f g h i = lift $ logHttpError a b c d e f g h i
|
||||
|
||||
logHttpSuccess a b c d e f g h i j k l = lift $ logHttpSuccess a b c d e f g h i j k l
|
||||
|
||||
|
||||
@ -99,7 +99,6 @@ runCustomEndpoint ::
|
||||
MonadQueryLog m,
|
||||
GH.MonadExecuteQuery m,
|
||||
MonadMetadataStorage (MetadataStorageT m),
|
||||
HttpLog m,
|
||||
EB.MonadQueryTags m,
|
||||
HasResourceLimits m
|
||||
) =>
|
||||
@ -111,7 +110,7 @@ runCustomEndpoint ::
|
||||
Wai.IpAddress ->
|
||||
RestRequest EndpointMethod ->
|
||||
EndpointTrie GQLQueryWithText ->
|
||||
m (HttpLogMetadata m, HttpResponse EncJSON)
|
||||
m (HttpLogGraphQLInfo, HttpResponse EncJSON)
|
||||
runCustomEndpoint env execCtx requestId userInfo reqHeaders ipAddress RestRequest {..} endpoints = do
|
||||
-- First match the path to an endpoint.
|
||||
case matchPath reqMethod (T.split (== '/') reqPath) endpoints of
|
||||
@ -143,9 +142,8 @@ runCustomEndpoint env execCtx requestId userInfo reqHeaders ipAddress RestReques
|
||||
-- through to the /v1/graphql endpoint.
|
||||
(httpLoggingMetadata, handlerResp) <- flip runReaderT execCtx $ do
|
||||
(gqlOperationLog, resp) <- GH.runGQ env (E._ecxLogger execCtx) requestId userInfo ipAddress reqHeaders E.QueryHasura (mkPassthroughRequest queryx resolvedVariables)
|
||||
let httpLogMetadata =
|
||||
buildHttpLogMetadata @m (PQHSetSingleton (gqolParameterizedQueryHash gqlOperationLog)) RequestModeNonBatchable Nothing
|
||||
return (httpLogMetadata, fst <$> resp)
|
||||
let httpLoggingGQInfo = (CommonHttpLogMetadata RequestModeNonBatchable Nothing, (PQHSetSingleton (gqolParameterizedQueryHash gqlOperationLog)))
|
||||
return (httpLoggingGQInfo, fst <$> resp)
|
||||
case sequence handlerResp of
|
||||
Just resp -> pure (httpLoggingMetadata, fmap encodeHTTPResp resp)
|
||||
-- a Nothing value here indicates a failure to parse the cached request from redis.
|
||||
|
||||
@ -25,6 +25,7 @@ module Hasura.Session
|
||||
mkUserInfo,
|
||||
adminUserInfo,
|
||||
BackendOnlyFieldAccess (..),
|
||||
ExtraUserInfo (..),
|
||||
)
|
||||
where
|
||||
|
||||
@ -202,6 +203,10 @@ instance (UserInfoM m) => UserInfoM (StateT s m) where
|
||||
instance (UserInfoM m) => UserInfoM (TraceT m) where
|
||||
askUserInfo = lift askUserInfo
|
||||
|
||||
-- | extra information used to identify a Hasura User
|
||||
data ExtraUserInfo = ExtraUserInfo {_euiUserId :: Maybe Text}
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
askCurRole :: (UserInfoM m) => m RoleName
|
||||
askCurRole = _uiRole <$> askUserInfo
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user