diff --git a/CHANGELOG.md b/CHANGELOG.md index 164adc53986..d66f6e10f15 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,8 +8,9 @@ - server: bugfix to allow HASURA_GRAPHQL_QUERY_PLAN_CACHE_SIZE of 0 (#5363) - server: support only a bounded plan cache, with a default size of 4000 (closes #5363) -- console: update sidebar icons for different action and trigger types +- server: add logs for action handlers - server: add request/response sizes in event triggers (and scheduled trigger) logs +- console: update sidebar icons for different action and trigger types ## `v1.3.0` diff --git a/server/src-lib/Hasura/App.hs b/server/src-lib/Hasura/App.hs index 2897707bc78..b50767a070b 100644 --- a/server/src-lib/Hasura/App.hs +++ b/server/src-lib/Hasura/App.hs @@ -378,7 +378,7 @@ runHGEServer env ServeOptions{..} InitCtx{..} pgExecCtx initTime shutdownApp pos -- start a backgroud thread to handle async actions asyncActionsThread <- C.forkImmortal "asyncActionsProcessor" logger $ - asyncActionsProcessor env (_scrCache cacheRef) _icPgPool _icHttpManager + asyncActionsProcessor env logger (_scrCache cacheRef) _icPgPool _icHttpManager -- start a background thread to create new cron events void $ liftIO $ C.forkImmortal "runCronEventsGenerator" logger $ @@ -604,13 +604,13 @@ execQuery env queryBs = do instance Tracing.HasReporter AppM instance HttpLog AppM where - logHttpError logger userInfoM reqId httpReq req qErr headers = + logHttpError logger userInfoM reqId waiReq req qErr headers = unLogger logger $ mkHttpLog $ - mkHttpErrorLogContext userInfoM reqId httpReq qErr req Nothing Nothing headers + mkHttpErrorLogContext userInfoM reqId waiReq req qErr Nothing Nothing headers - logHttpSuccess logger userInfoM reqId httpReq _ _ compressedResponse qTime cType headers = + logHttpSuccess logger userInfoM reqId waiReq _reqBody _response compressedResponse qTime cType headers = unLogger logger $ mkHttpLog $ - mkHttpAccessLogContext userInfoM reqId httpReq compressedResponse qTime cType headers + mkHttpAccessLogContext userInfoM reqId waiReq compressedResponse qTime cType headers instance MonadExecuteQuery AppM where executeQuery _ _ _ pgCtx _txAccess tx = diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index d8750028611..bc642e60832 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -223,6 +223,7 @@ getResolvedExecPlan , Tracing.MonadTrace tx ) => Env.Environment + -> L.Logger L.Hasura -> PGExecCtx -> EP.PlanCache -> UserInfo @@ -234,7 +235,7 @@ getResolvedExecPlan -> [HTTP.Header] -> (GQLReqUnparsed, GQLReqParsed) -> m (Telem.CacheHit, GQExecPlanResolved tx) -getResolvedExecPlan env pgExecCtx planCache userInfo sqlGenCtx +getResolvedExecPlan env logger pgExecCtx planCache userInfo sqlGenCtx sc scVer queryType httpManager reqHeaders (reqUnparsed, reqParsed) = do planM <- liftIO $ EP.getPlan scVer (_uiRole userInfo) operationNameM queryStr @@ -263,15 +264,15 @@ getResolvedExecPlan env pgExecCtx planCache userInfo sqlGenCtx forM partialExecPlan $ \(gCtx, rootSelSet) -> case rootSelSet of VQ.RMutation selSet -> do - (tx, respHeaders) <- getMutOp env gCtx sqlGenCtx userInfo httpManager reqHeaders selSet + (tx, respHeaders) <- getMutOp env logger gCtx sqlGenCtx userInfo httpManager reqHeaders selSet pure $ ExOpMutation respHeaders tx VQ.RQuery selSet -> do - (queryTx, plan, genSql, asts) <- getQueryOp env gCtx sqlGenCtx httpManager reqHeaders userInfo + (queryTx, plan, genSql, asts) <- getQueryOp env logger gCtx sqlGenCtx httpManager reqHeaders userInfo queryReusability (allowQueryActionExecuter httpManager reqHeaders) selSet traverse_ (addPlanToCache . flip EP.RPQuery asts) plan return $ ExOpQuery queryTx (Just genSql) asts VQ.RSubscription fields -> do - (lqOp, plan) <- getSubsOp env pgExecCtx gCtx sqlGenCtx userInfo queryReusability + (lqOp, plan) <- getSubsOp env logger pgExecCtx gCtx sqlGenCtx userInfo queryReusability (restrictActionExecuter "query actions cannot be run as a subscription") fields traverse_ (addPlanToCache . EP.RPSubs) plan return $ ExOpSubs lqOp @@ -286,18 +287,20 @@ type E m = , OrdByCtx , InsCtxMap , SQLGenCtx + , L.Logger L.Hasura ) (ExceptT QErr m) runE :: (MonadError QErr m) - => GCtx + => L.Logger L.Hasura + -> GCtx -> SQLGenCtx -> UserInfo -> E m a -> m a -runE ctx sqlGenCtx userInfo action = do +runE logger ctx sqlGenCtx userInfo action = do res <- runExceptT $ runReaderT action - (userInfo, queryCtxMap, mutationCtxMap, typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx) + (userInfo, queryCtxMap, mutationCtxMap, typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx, logger) either throwError return res where queryCtxMap = _gQueryCtxMap ctx @@ -317,6 +320,7 @@ getQueryOp , Tracing.MonadTrace tx ) => Env.Environment + -> L.Logger L.Hasura -> GCtx -> SQLGenCtx -> HTTP.Manager @@ -326,8 +330,8 @@ getQueryOp -> QueryActionExecuter -> VQ.ObjectSelectionSet -> m (tx EncJSON, Maybe EQ.ReusableQueryPlan, EQ.GeneratedSqlMap, [GR.QueryRootFldUnresolved]) -getQueryOp env gCtx sqlGenCtx manager reqHdrs userInfo queryReusability actionExecuter selSet = - runE gCtx sqlGenCtx userInfo $ EQ.convertQuerySelSet env manager reqHdrs queryReusability selSet actionExecuter +getQueryOp env logger gCtx sqlGenCtx manager reqHdrs userInfo queryReusability actionExecuter selSet = + runE logger gCtx sqlGenCtx userInfo $ EQ.convertQuerySelSet env manager reqHdrs queryReusability selSet actionExecuter resolveMutSelSet :: ( HasVersion @@ -341,6 +345,7 @@ resolveMutSelSet , Has InsCtxMap r , Has HTTP.Manager r , Has [HTTP.Header] r + , Has (L.Logger L.Hasura) r , MonadIO m , Tracing.MonadTrace m , MonadIO tx @@ -377,6 +382,7 @@ getMutOp , Tracing.MonadTrace tx ) => Env.Environment + -> L.Logger L.Hasura -> GCtx -> SQLGenCtx -> UserInfo @@ -384,14 +390,14 @@ getMutOp -> [HTTP.Header] -> VQ.ObjectSelectionSet -> m (tx EncJSON, HTTP.ResponseHeaders) -getMutOp env ctx sqlGenCtx userInfo manager reqHeaders selSet = +getMutOp env logger ctx sqlGenCtx userInfo manager reqHeaders selSet = peelReaderT $ resolveMutSelSet env selSet where peelReaderT action = runReaderT action ( userInfo, queryCtxMap, mutationCtxMap , typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx - , manager, reqHeaders + , manager, reqHeaders, logger ) where queryCtxMap = _gQueryCtxMap ctx @@ -408,6 +414,7 @@ getSubsOp , Tracing.MonadTrace m ) => Env.Environment + -> L.Logger L.Hasura -> PGExecCtx -> GCtx -> SQLGenCtx @@ -416,8 +423,8 @@ getSubsOp -> QueryActionExecuter -> VQ.ObjectSelectionSet -> m (EL.LiveQueryPlan, Maybe EL.ReusableLiveQueryPlan) -getSubsOp env pgExecCtx gCtx sqlGenCtx userInfo queryReusability actionExecuter = - runE gCtx sqlGenCtx userInfo . +getSubsOp env logger pgExecCtx gCtx sqlGenCtx userInfo queryReusability actionExecuter = + runE logger gCtx sqlGenCtx userInfo . EL.buildLiveQueryPlan env pgExecCtx queryReusability actionExecuter execRemoteGQ diff --git a/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs b/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs index 4ad27c6054d..e9cf84c71c0 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs @@ -50,6 +50,7 @@ import Data.UUID (UUID) import qualified Hasura.GraphQL.Resolve as GR import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH import qualified Hasura.GraphQL.Validate as GV +import qualified Hasura.Logging as L import qualified Hasura.SQL.DML as S import qualified Hasura.Tracing as Tracing @@ -277,6 +278,7 @@ buildLiveQueryPlan , Has OrdByCtx r , Has QueryCtxMap r , Has SQLGenCtx r + , Has (L.Logger L.Hasura) r , MonadIO m , Tracing.MonadTrace m , HasVersion diff --git a/server/src-lib/Hasura/GraphQL/Execute/Query.hs b/server/src-lib/Hasura/GraphQL/Execute/Query.hs index decb87c0f88..24f6b19dafb 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Query.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Query.hs @@ -26,6 +26,7 @@ import qualified Hasura.GraphQL.Resolve as R import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH import qualified Hasura.GraphQL.Validate as GV import qualified Hasura.GraphQL.Validate.SelectionSet as V +import qualified Hasura.Logging as L import qualified Hasura.SQL.DML as S import qualified Hasura.Tracing as Tracing @@ -203,6 +204,7 @@ convertQuerySelSet , Has OrdByCtx r , Has SQLGenCtx r , Has UserInfo r + , Has (L.Logger L.Hasura) r , HasVersion , MonadIO m , Tracing.MonadTrace m @@ -302,11 +304,11 @@ mkLazyRespTx , MonadTx tx , Tracing.MonadTrace tx ) - => Env.Environment - -> HTTP.Manager - -> [N.Header] - -> UserInfo - -> [(G.Alias, ResolvedQuery)] + => Env.Environment + -> HTTP.Manager + -> [N.Header] + -> UserInfo + -> [(G.Alias, ResolvedQuery)] -> m (tx EncJSON) mkLazyRespTx env manager reqHdrs userInfo resolved = do pure $ fmap encJFromAssocList $ forM resolved $ \(alias, node) -> do diff --git a/server/src-lib/Hasura/GraphQL/Explain.hs b/server/src-lib/Hasura/GraphQL/Explain.hs index 535c811a3a3..85b482d2fef 100644 --- a/server/src-lib/Hasura/GraphQL/Explain.hs +++ b/server/src-lib/Hasura/GraphQL/Explain.hs @@ -29,6 +29,7 @@ import qualified Hasura.GraphQL.Resolve as RS import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH import qualified Hasura.GraphQL.Validate as GV import qualified Hasura.GraphQL.Validate.SelectionSet as GV +import qualified Hasura.Logging as L import qualified Hasura.SQL.DML as S import qualified Hasura.Tracing as Tracing @@ -90,20 +91,21 @@ getSessVarVal userInfo sessVar = explainField :: (MonadError QErr m, MonadTx m, HasVersion, MonadIO m, Tracing.MonadTrace m) => Env.Environment + -> L.Logger L.Hasura -> UserInfo -> GCtx -> SQLGenCtx -> QueryActionExecuter -> GV.Field -> m FieldPlan -explainField env userInfo gCtx sqlGenCtx actionExecuter fld = +explainField env logger userInfo gCtx sqlGenCtx actionExecuter fld = case fName of "__type" -> return $ FieldPlan fName Nothing Nothing "__schema" -> return $ FieldPlan fName Nothing Nothing "__typename" -> return $ FieldPlan fName Nothing Nothing _ -> do unresolvedAST <- - runExplain (queryCtxMap, userInfo, fldMap, orderByCtx, sqlGenCtx) $ + runExplain (logger, queryCtxMap, userInfo, fldMap, orderByCtx, sqlGenCtx) $ evalReusabilityT $ RS.queryFldToPGAST env fld actionExecuter resolvedAST <- RS.traverseQueryRootFldAST (resolveVal userInfo) unresolvedAST let (query, remoteJoins) = RS.toPGQuery resolvedAST @@ -133,6 +135,7 @@ explainGQLQuery , Tracing.MonadTrace tx ) => Env.Environment + -> L.Logger L.Hasura -> PGExecCtx -> (tx EncJSON -> m EncJSON) -> SchemaCache @@ -140,7 +143,7 @@ explainGQLQuery -> QueryActionExecuter -> GQLExplain -> m EncJSON -explainGQLQuery env pgExecCtx runInTx sc sqlGenCtx actionExecuter (GQLExplain query userVarsRaw maybeIsRelay) = do +explainGQLQuery env logger pgExecCtx runInTx sc sqlGenCtx actionExecuter (GQLExplain query userVarsRaw maybeIsRelay) = do -- NOTE!: we will be executing what follows as though admin role. See e.g. -- notes in explainField: userInfo <- mkUserInfo (URBFromSessionVariablesFallback adminRoleName) UAdminSecretSent sessionVariables @@ -155,11 +158,11 @@ explainGQLQuery env pgExecCtx runInTx sc sqlGenCtx actionExecuter (GQLExplain qu case rootSelSet of GV.RQuery selSet -> runInTx $ encJFromJValue . map snd <$> - GV.traverseObjectSelectionSet selSet (explainField env userInfo gCtx sqlGenCtx actionExecuter) + GV.traverseObjectSelectionSet selSet (explainField env logger userInfo gCtx sqlGenCtx actionExecuter) GV.RMutation _ -> throw400 InvalidParams "only queries can be explained" GV.RSubscription fields -> do - (plan, _) <- E.getSubsOp env pgExecCtx gCtx sqlGenCtx userInfo + (plan, _) <- E.getSubsOp env logger pgExecCtx gCtx sqlGenCtx userInfo queryReusability actionExecuter fields runInTx $ encJFromJValue <$> E.explainLiveQueryPlan plan where diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 9d51c709183..ac7d1f6e087 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -42,6 +42,7 @@ import qualified Hasura.GraphQL.Resolve.Mutation as RM import qualified Hasura.GraphQL.Resolve.Select as RS import qualified Hasura.GraphQL.Schema.Common as GS import qualified Hasura.GraphQL.Validate as V +import qualified Hasura.Logging as L import qualified Hasura.RQL.DML.RemoteJoin as RR import qualified Hasura.RQL.DML.Select as DS import qualified Hasura.SQL.DML as S @@ -107,6 +108,7 @@ queryFldToPGAST , Has SQLGenCtx r , Has UserInfo r , Has QueryCtxMap r + , Has (L.Logger L.Hasura) r , HasVersion , MonadIO m , Tracing.MonadTrace m @@ -175,6 +177,7 @@ mutFldToTx , Has InsCtxMap r , Has HTTP.Manager r , Has [HTTP.Header] r + , Has (L.Logger L.Hasura) r , MonadIO m , Tracing.MonadTrace m , MonadIO tx diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 002af5c34eb..5eea760108d 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -17,8 +17,9 @@ import Hasura.Prelude import Control.Concurrent (threadDelay) import Control.Exception (try) import Control.Lens -import Control.Monad.Trans.Control (MonadBaseControl) +import Control.Monad.Trans.Control (MonadBaseControl) import Data.Has +import Data.Int (Int64) import Data.IORef import qualified Control.Concurrent.Async.Lifted.Safe as LA @@ -40,7 +41,8 @@ import qualified Network.Wreq as Wreq import qualified Hasura.GraphQL.Resolve.Select as GRS import qualified Hasura.RQL.DML.RemoteJoin as RJ import qualified Hasura.RQL.DML.Select as RS -import qualified Hasura.Tracing as Tracing +import qualified Hasura.Tracing as Tracing +import qualified Hasura.Logging as L import Hasura.EncJSON import Hasura.GraphQL.Resolve.Context @@ -118,6 +120,17 @@ data ActionInternalError } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ActionInternalError) +-- * Action handler logging related +data ActionHandlerLog + = ActionHandlerLog + { _ahlRequestSize :: !Int64 + , _ahlResponseSize :: !Int64 + } deriving (Show) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True} ''ActionHandlerLog) + +instance L.ToEngineLog ActionHandlerLog L.Hasura where + toEngineLog ahl = (L.LevelInfo, L.ELTActionHandler, J.toJSON ahl) + resolveActionMutation :: ( HasVersion , MonadReusability m @@ -129,6 +142,7 @@ resolveActionMutation , Has SQLGenCtx r , Has HTTP.Manager r , Has [HTTP.Header] r + , Has (L.Logger L.Hasura) r , Tracing.MonadTrace m , MonadIO tx , MonadTx tx @@ -158,6 +172,7 @@ resolveActionMutationSync , Has SQLGenCtx r , Has HTTP.Manager r , Has [HTTP.Header] r + , Has (L.Logger L.Hasura) r , Tracing.MonadTrace m , MonadIO tx , MonadTx tx @@ -226,6 +241,7 @@ resolveActionQuery , Has FieldMap r , Has OrdByCtx r , Has SQLGenCtx r + , Has (L.Logger L.Hasura) r , Tracing.MonadTrace m ) => Env.Environment @@ -387,19 +403,20 @@ data ActionLogItem -- | Process async actions from hdb_catalog.hdb_action_log table. This functions is executed in a background thread. -- See Note [Async action architecture] above asyncActionsProcessor - :: forall m void - . ( HasVersion - , MonadIO m - , MonadBaseControl IO m - , LA.Forall (LA.Pure m) - , Tracing.HasReporter m - ) + :: forall m void . + ( HasVersion + , MonadIO m + , MonadBaseControl IO m + , LA.Forall (LA.Pure m) + , Tracing.HasReporter m + ) => Env.Environment + -> L.Logger L.Hasura -> IORef (RebuildableSchemaCache Run, SchemaCacheVer) -> Q.PGPool -> HTTP.Manager -> m void -asyncActionsProcessor env cacheRef pgPool httpManager = forever $ do +asyncActionsProcessor env logger cacheRef pgPool httpManager = forever $ do asyncInvocations <- liftIO getUndeliveredEvents actionCache <- scActions . lastBuiltSchemaCache . fst <$> liftIO (readIORef cacheRef) LA.mapConcurrently_ (callHandler actionCache) asyncInvocations @@ -424,10 +441,10 @@ asyncActionsProcessor env cacheRef pgPool httpManager = forever $ do confHeaders = _adHeaders definition outputType = _adOutputType definition actionContext = ActionContext actionName - eitherRes <- runExceptT $ + eitherRes <- runExceptT $ flip runReaderT logger $ callWebhook env httpManager outputType outputFields reqHeaders confHeaders - forwardClientHeaders webhookUrl $ - ActionWebhookPayload actionContext sessionVariables inputPayload + forwardClientHeaders webhookUrl $ + ActionWebhookPayload actionContext sessionVariables inputPayload liftIO $ case eitherRes of Left e -> setError actionId e Right (responsePayload, _) -> setCompleted actionId $ J.toJSON responsePayload @@ -482,7 +499,14 @@ asyncActionsProcessor env cacheRef pgPool httpManager = forever $ do getUndeliveredEvents = runTx undeliveredEventsQuery callWebhook - :: forall m. (HasVersion, MonadIO m, MonadError QErr m, Tracing.MonadTrace m) + :: forall m r. + ( HasVersion + , MonadIO m + , MonadError QErr m + , Tracing.MonadTrace m + , MonadReader r m + , Has (L.Logger L.Hasura) r + ) => Env.Environment -> HTTP.Manager -> GraphQLType @@ -502,12 +526,14 @@ callWebhook env manager outputType outputFields reqHeaders confHeaders -- and client headers where configuration headers are preferred hdrs = contentType : (Map.toList . Map.fromList) (resolvedConfHeaders <> clientHeaders) postPayload = J.toJSON actionWebhookPayload + requestBody = J.encode postPayload + requestBodySize = BL.length requestBody url = unResolvedWebhook resolvedWebhook httpResponse <- do initReq <- liftIO $ HTTP.parseRequest (T.unpack url) let req = initReq { HTTP.method = "POST" , HTTP.requestHeaders = addDefaultHeaders hdrs - , HTTP.requestBody = HTTP.RequestBodyLBS (J.encode postPayload) + , HTTP.requestBody = HTTP.RequestBodyLBS requestBody } Tracing.tracedHttpRequest req \req' -> liftIO . try $ HTTP.httpLbs req' manager @@ -520,10 +546,16 @@ callWebhook env manager outputType outputFields reqHeaders confHeaders Right responseWreq -> do let responseBody = responseWreq ^. Wreq.responseBody + responseBodySize = BL.length responseBody responseStatus = responseWreq ^. Wreq.responseStatus mkResponseInfo respBody = ActionResponseInfo (HTTP.statusCode responseStatus) respBody $ toHeadersConf $ responseWreq ^. Wreq.responseHeaders + + -- log the request and response to/from the action handler + logger :: (L.Logger L.Hasura) <- asks getter + L.unLogger logger $ ActionHandlerLog requestBodySize responseBodySize + case J.eitherDecode responseBody of Left e -> do let responseInfo = mkResponseInfo $ J.String $ bsToTxt $ BL.toStrict responseBody @@ -613,3 +645,4 @@ processOutputSelectionSet tableRowInput actionOutputType definitionList fldTy fl functionArgs = RS.FunctionArgsExp [tableRowInput] mempty selectFrom = RS.FromFunction jsonbToPostgresRecordFunction functionArgs $ Just definitionList + diff --git a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs index 5517ab5ba52..70cd3e37ae9 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs @@ -32,6 +32,7 @@ import qualified Database.PG.Query as Q import qualified Hasura.GraphQL.Execute as E import qualified Hasura.GraphQL.Execute.Query as EQ import qualified Hasura.GraphQL.Resolve as R +import qualified Hasura.Logging as L import qualified Hasura.Server.Telemetry.Counters as Telem import qualified Hasura.Tracing as Tracing import qualified Language.GraphQL.Draft.Syntax as G @@ -71,6 +72,7 @@ runGQ , MonadExecuteQuery m ) => Env.Environment + -> L.Logger L.Hasura -> RequestId -> UserInfo -> Wai.IpAddress @@ -78,7 +80,7 @@ runGQ -> E.GraphQLQueryType -> GQLReqUnparsed -> m (HttpResponse EncJSON) -runGQ env reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do +runGQ env logger reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do -- The response and misc telemetry data: let telemTransport = Telem.HTTP (telemTimeTot_DT, (telemCacheHit, telemLocality, (telemTimeIO_DT, telemQueryType, !resp))) <- withElapsedTime $ do @@ -88,7 +90,7 @@ runGQ env reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do reqParsed <- E.checkGQLExecution userInfo (reqHeaders, ipAddress) enableAL sc reqUnparsed >>= flip onLeft throwError - (telemCacheHit, execPlan) <- E.getResolvedExecPlan env pgExecCtx planCache + (telemCacheHit, execPlan) <- E.getResolvedExecPlan env logger pgExecCtx planCache userInfo sqlGenCtx sc scVer queryType httpManager reqHeaders (reqUnparsed, reqParsed) case execPlan of @@ -119,6 +121,7 @@ runGQBatched , MonadExecuteQuery m ) => Env.Environment + -> L.Logger L.Hasura -> RequestId -> ResponseInternalErrorsConfig -> UserInfo @@ -128,10 +131,10 @@ runGQBatched -> GQLBatchedReqs GQLQueryText -- ^ the batched request with unparsed GraphQL query -> m (HttpResponse EncJSON) -runGQBatched env reqId responseErrorsConfig userInfo ipAddress reqHdrs queryType query = do +runGQBatched env logger reqId responseErrorsConfig userInfo ipAddress reqHdrs queryType query = do case query of GQLSingleRequest req -> - runGQ env reqId userInfo ipAddress reqHdrs queryType req + runGQ env logger reqId userInfo ipAddress reqHdrs queryType req GQLBatchedReqs reqs -> do -- It's unclear what we should do if we receive multiple -- responses with distinct headers, so just do the simplest thing @@ -142,7 +145,7 @@ runGQBatched env reqId responseErrorsConfig userInfo ipAddress reqHdrs queryType . encJFromList . map (either (encJFromJValue . encodeGQErr includeInternal) _hrBody) - removeHeaders <$> traverse (try . runGQ env reqId userInfo ipAddress reqHdrs queryType) reqs + removeHeaders <$> traverse (try . runGQ env logger reqId userInfo ipAddress reqHdrs queryType) reqs where try = flip catchError (pure . Left) . fmap Right diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs index 5f05334b2bb..a50e1ab8801 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs @@ -307,7 +307,14 @@ onConn (L.Logger logger) corsPolicy wsId requestHead ipAddress = do <> "HASURA_GRAPHQL_WS_READ_COOKIE to force read cookie when CORS is disabled." onStart - :: forall m. (HasVersion, MonadIO m, E.MonadGQLExecutionCheck m, MonadQueryLog m, Tracing.MonadTrace m, MonadExecuteQuery m) + :: forall m. + ( HasVersion + , MonadIO m + , E.MonadGQLExecutionCheck m + , MonadQueryLog m + , Tracing.MonadTrace m + , MonadExecuteQuery m + ) => Env.Environment -> WSServerEnv -> WSConn -> StartMsg -> m () onStart env serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do timerTot <- startTimer @@ -333,7 +340,7 @@ onStart env serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do reqParsedE <- lift $ E.checkGQLExecution userInfo (reqHdrs, ipAddress) enableAL sc q reqParsed <- either (withComplete . preExecErr requestId) return reqParsedE - execPlanE <- runExceptT $ E.getResolvedExecPlan env pgExecCtx + execPlanE <- runExceptT $ E.getResolvedExecPlan env logger pgExecCtx planCache userInfo sqlGenCtx sc scVer queryType httpMgr reqHdrs (q, reqParsed) (telemCacheHit, execPlan) <- either (withComplete . preExecErr requestId) return execPlanE diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs index 4934d5e8ff0..0371a88552d 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs @@ -5,6 +5,7 @@ module Hasura.GraphQL.Transport.WebSocket.Server ( WSId(..) , WSLog(..) , WSEvent(..) + , MessageDetails(..) , WSConn , getData , getWSId @@ -64,12 +65,20 @@ instance J.ToJSON WSId where toJSON (WSId uuid) = J.toJSON $ UUID.toText uuid +-- | Websocket message and other details +data MessageDetails + = MessageDetails + { _mdMessage :: !TBS.TByteString + , _mdMessageSize :: !Int64 + } deriving (Show, Eq) +$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''MessageDetails) + data WSEvent = EConnectionRequest | EAccepted | ERejected - | EMessageReceived !TBS.TByteString - | EMessageSent !TBS.TByteString + | EMessageReceived !MessageDetails + | EMessageSent !MessageDetails | EJwtExpired | ECloseReceived | ECloseSent !TBS.TByteString @@ -315,13 +324,15 @@ createServerApp (WSServer logger@(L.Logger writeLog) serverStatus) wsHandlers !i -- Regardless this should be safe: handleJust (guard . E.isResourceVanishedError) (\()-> throw WS.ConnectionClosed) $ WS.receiveData conn - logWSLog logger $ WSLog wsId (EMessageReceived $ TBS.fromLBS msg) Nothing + let message = MessageDetails (TBS.fromLBS msg) (BL.length msg) + logWSLog logger $ WSLog wsId (EMessageReceived message) Nothing _hOnMessage wsHandlers wsConn msg let send = forever $ do WSQueueResponse msg wsInfo <- liftIO $ STM.atomically $ STM.readTQueue sendQ + let message = MessageDetails (TBS.fromLBS msg) (BL.length msg) liftIO $ WS.sendTextData conn msg - logWSLog logger $ WSLog wsId (EMessageSent $ TBS.fromLBS msg) wsInfo + logWSLog logger $ WSLog wsId (EMessageSent message) wsInfo -- withAsync lets us be very sure that if e.g. an async exception is raised while we're -- forking that the threads we launched will be cleaned up. See also below. diff --git a/server/src-lib/Hasura/Logging.hs b/server/src-lib/Hasura/Logging.hs index f8b8021b654..bb45583c137 100644 --- a/server/src-lib/Hasura/Logging.hs +++ b/server/src-lib/Hasura/Logging.hs @@ -68,6 +68,7 @@ data instance EngineLogType Hasura | ELTQueryLog | ELTStartup | ELTLivequeryPollerLog + | ELTActionHandler -- internal log types | ELTInternal !InternalLogTypes deriving (Show, Eq, Generic) @@ -82,6 +83,7 @@ instance J.ToJSON (EngineLogType Hasura) where ELTQueryLog -> "query-log" ELTStartup -> "startup" ELTLivequeryPollerLog -> "livequery-poller-log" + ELTActionHandler -> "action-handler-log" ELTInternal t -> J.toJSON t instance J.FromJSON (EngineLogType Hasura) where @@ -92,6 +94,7 @@ instance J.FromJSON (EngineLogType Hasura) where "websocket-log" -> return ELTWebsocketLog "query-log" -> return ELTQueryLog "livequery-poller-log" -> return ELTLivequeryPollerLog + "action-handler-log" -> return ELTActionHandler _ -> fail $ "Valid list of comma-separated log types: " <> BLC.unpack (J.encode userAllowedLogTypes) diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 98fd861c13e..104c39cbcb5 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -283,8 +283,8 @@ mkSpockAction serverCtx qErrEncoder qErrModifier apiHandler = do lift $ Tracing.attachMetadata [("request_id", unRequestId requestId)] userInfoE <- fmap fst <$> lift (resolveUserInfo logger manager headers authMode) - userInfo <- either (logErrorAndResp Nothing requestId req (Left reqBody) False headers . qErrModifier) - return userInfoE + userInfo <- either (logErrorAndResp Nothing requestId req (reqBody, Nothing) False headers . qErrModifier) + return userInfoE let handlerState = HandlerCtx serverCtx userInfo headers requestId ipAddress includeInternal = shouldIncludeInternal (_uiRole userInfo) $ @@ -296,7 +296,7 @@ mkSpockAction serverCtx qErrEncoder qErrModifier apiHandler = do return (res, Nothing) AHPost handler -> do parsedReqE <- runExceptT $ parseBody reqBody - parsedReq <- either (logErrorAndResp (Just userInfo) requestId req (Left reqBody) includeInternal headers . qErrModifier) + parsedReq <- either (logErrorAndResp (Just userInfo) requestId req (reqBody, Nothing) includeInternal headers . qErrModifier) return parsedReqE res <- lift $ runReaderT (runExceptT $ handler parsedReq) handlerState return (res, Just parsedReq) @@ -306,9 +306,8 @@ mkSpockAction serverCtx qErrEncoder qErrModifier apiHandler = do -- log and return result case modResult of - Left err -> let jErr = maybe (Left reqBody) (Right . toJSON) q - in logErrorAndResp (Just userInfo) requestId req jErr includeInternal headers err - Right res -> logSuccessAndResp (Just userInfo) requestId req (fmap toJSON q) res (Just (ioWaitTime, serviceTime)) headers + Left err -> logErrorAndResp (Just userInfo) requestId req (reqBody, toJSON <$> q) includeInternal headers err + Right res -> logSuccessAndResp (Just userInfo) requestId req (reqBody, toJSON <$> q) res (Just (ioWaitTime, serviceTime)) headers where logger = scLogger serverCtx @@ -318,31 +317,31 @@ mkSpockAction serverCtx qErrEncoder qErrModifier apiHandler = do => Maybe UserInfo -> RequestId -> Wai.Request - -> Either BL.ByteString Value + -> (BL.ByteString, Maybe Value) -> Bool -> [HTTP.Header] -> QErr -> Spock.ActionCtxT ctx m a - logErrorAndResp userInfo reqId req reqBody includeInternal headers qErr = do - lift $ logHttpError logger userInfo reqId req reqBody qErr headers + logErrorAndResp userInfo reqId waiReq req includeInternal headers qErr = do + lift $ logHttpError logger userInfo reqId waiReq req qErr headers Spock.setStatus $ qeStatus qErr Spock.json $ qErrEncoder includeInternal qErr - logSuccessAndResp userInfo reqId req reqBody result qTime reqHeaders = + logSuccessAndResp userInfo reqId waiReq reqBody result qTime reqHeaders = case result of JSONResp (HttpResponse encJson h) -> - possiblyCompressedLazyBytes userInfo reqId req reqBody qTime (encJToLBS encJson) + possiblyCompressedLazyBytes userInfo reqId waiReq reqBody qTime (encJToLBS encJson) (pure jsonHeader <> h) reqHeaders RawResp (HttpResponse rawBytes h) -> - possiblyCompressedLazyBytes userInfo reqId req reqBody qTime rawBytes h reqHeaders + possiblyCompressedLazyBytes userInfo reqId waiReq reqBody qTime rawBytes h reqHeaders - possiblyCompressedLazyBytes userInfo reqId req reqBody qTime respBytes respHeaders reqHeaders = do + possiblyCompressedLazyBytes userInfo reqId waiReq req qTime respBytes respHeaders reqHeaders = do let (compressedResp, mEncodingHeader, mCompressionType) = - compressResponse (Wai.requestHeaders req) respBytes + compressResponse (Wai.requestHeaders waiReq) respBytes encodingHeader = maybe [] pure mEncodingHeader reqIdHeader = (requestIdHeader, txtToBs $ unRequestId reqId) allRespHeaders = pure reqIdHeader <> encodingHeader <> respHeaders - lift $ logHttpSuccess logger userInfo reqId req reqBody respBytes compressedResp qTime mCompressionType reqHeaders + lift $ logHttpSuccess logger userInfo reqId waiReq req respBytes compressedResp qTime mCompressionType reqHeaders mapM_ setHeader allRespHeaders Spock.lazyBytes compressedResp @@ -372,8 +371,15 @@ v1QueryHandler query = do runQuery env pgExecCtx instanceId userInfo schemaCache httpMgr sqlGenCtx (SystemDefined False) query v1Alpha1GQHandler - :: (HasVersion, MonadIO m, E.MonadGQLExecutionCheck m, MonadQueryLog m, Tracing.MonadTrace m, GH.MonadExecuteQuery m) - => E.GraphQLQueryType -> GH.GQLBatchedReqs GH.GQLQueryText -> Handler m (HttpResponse EncJSON) + :: ( HasVersion + , MonadIO m + , E.MonadGQLExecutionCheck m + , MonadQueryLog m + , Tracing.MonadTrace m + , GH.MonadExecuteQuery m + ) + => E.GraphQLQueryType -> GH.GQLBatchedReqs GH.GQLQueryText + -> Handler m (HttpResponse EncJSON) v1Alpha1GQHandler queryType query = do userInfo <- asks hcUser reqHeaders <- asks hcReqHeaders @@ -394,25 +400,37 @@ v1Alpha1GQHandler queryType query = do (lastBuiltSchemaCache sc) scVer manager enableAL flip runReaderT execCtx $ - GH.runGQBatched env requestId responseErrorsConfig userInfo ipAddress reqHeaders queryType query + GH.runGQBatched env logger requestId responseErrorsConfig userInfo ipAddress reqHeaders queryType query v1GQHandler - :: (HasVersion, MonadIO m, E.MonadGQLExecutionCheck m, MonadQueryLog m, Tracing.MonadTrace m, GH.MonadExecuteQuery m) + :: ( HasVersion + , MonadIO m + , E.MonadGQLExecutionCheck m + , MonadQueryLog m + , Tracing.MonadTrace m + , GH.MonadExecuteQuery m + ) => GH.GQLBatchedReqs GH.GQLQueryText -> Handler m (HttpResponse EncJSON) v1GQHandler = v1Alpha1GQHandler E.QueryHasura v1GQRelayHandler - :: (HasVersion, MonadIO m, E.MonadGQLExecutionCheck m, MonadQueryLog m, Tracing.MonadTrace m, GH.MonadExecuteQuery m) + :: ( HasVersion + , MonadIO m + , E.MonadGQLExecutionCheck m + , MonadQueryLog m + , Tracing.MonadTrace m + , GH.MonadExecuteQuery m + ) => GH.GQLBatchedReqs GH.GQLQueryText -> Handler m (HttpResponse EncJSON) v1GQRelayHandler = v1Alpha1GQHandler E.QueryRelay gqlExplainHandler - :: forall m - . ( HasVersion - , MonadIO m - ) + :: forall m . + ( HasVersion + , MonadIO m + ) => GE.GQLExplain -> Handler (Tracing.TraceT m) (HttpResponse EncJSON) gqlExplainHandler query = do @@ -422,13 +440,14 @@ gqlExplainHandler query = do pgExecCtx <- asks (scPGExecCtx . hcServerCtx) sqlGenCtx <- asks (scSQLGenCtx . hcServerCtx) env <- asks (scEnvironment . hcServerCtx) + logger <- asks (scLogger . hcServerCtx) -- let runTx :: ReaderT HandlerCtx (Tracing.TraceT (Tracing.NoReporter (LazyTx QErr))) a -- -> ExceptT QErr (ReaderT HandlerCtx (Tracing.TraceT m)) a let runTx rttx = ExceptT . ReaderT $ \ctx -> do runExceptT (Tracing.interpTraceT (runLazyTx pgExecCtx Q.ReadOnly) (runReaderT rttx ctx)) - res <- GE.explainGQLQuery env pgExecCtx runTx sc sqlGenCtx + res <- GE.explainGQLQuery env logger pgExecCtx runTx sc sqlGenCtx (restrictActionExecuter "query actions cannot be explained") query return $ HttpResponse res [] @@ -794,7 +813,7 @@ raiseGenericApiError logger headers qErr = do req <- Spock.request reqBody <- liftIO $ Wai.strictRequestBody req reqId <- getRequestId $ Wai.requestHeaders req - lift $ logHttpError logger Nothing reqId req (Left reqBody) qErr headers + lift $ logHttpError logger Nothing reqId req (reqBody, Nothing) qErr headers setHeader jsonHeader Spock.setStatus $ qeStatus qErr Spock.lazyBytes $ encode qErr diff --git a/server/src-lib/Hasura/Server/Logging.hs b/server/src-lib/Hasura/Server/Logging.hs index 435167fe34f..9c443fac4c3 100644 --- a/server/src-lib/Hasura/Server/Logging.hs +++ b/server/src-lib/Hasura/Server/Logging.hs @@ -122,8 +122,8 @@ class (Monad m) => HttpLog m where -- ^ request id of the request -> Wai.Request -- ^ the Wai.Request object - -> Either BL.ByteString Value - -- ^ the actual request body (bytestring if unparsed, Aeson value if parsed) + -> (BL.ByteString, Maybe Value) + -- ^ the request body and parsed request -> QErr -- ^ the error -> [HTTP.Header] @@ -139,8 +139,8 @@ class (Monad m) => HttpLog m where -- ^ request id of the request -> Wai.Request -- ^ the Wai.Request object - -> Maybe Value - -- ^ the actual request body, if present + -> (BL.ByteString, Maybe Value) + -- ^ the request body and parsed request -> BL.ByteString -- ^ the response bytes -> BL.ByteString @@ -196,9 +196,7 @@ data OperationLog , olError :: !(Maybe QErr) } deriving (Show, Eq) -$(deriveToJSON (aesonDrop 2 snakeCase) - { omitNothingFields = True - } ''OperationLog) +$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields = True} ''OperationLog) data HttpLogContext = HttpLogContext @@ -247,20 +245,20 @@ mkHttpErrorLogContext -- ^ Maybe because it may not have been resolved -> RequestId -> Wai.Request + -> (BL.ByteString, Maybe Value) -> QErr - -> Either BL.ByteString Value -> Maybe (DiffTime, DiffTime) -> Maybe CompressionType -> [HTTP.Header] -> HttpLogContext -mkHttpErrorLogContext userInfoM reqId req err query mTiming compressTypeM headers = +mkHttpErrorLogContext userInfoM reqId waiReq (reqBody, parsedReq) err mTiming compressTypeM headers = let http = HttpInfoLog { hlStatus = qeStatus err - , hlMethod = bsToTxt $ Wai.requestMethod req - , hlSource = Wai.getSourceFromFallback req - , hlPath = bsToTxt $ Wai.rawPathInfo req - , hlHttpVersion = Wai.httpVersion req - , hlCompression = compressTypeM + , hlMethod = bsToTxt $ Wai.requestMethod waiReq + , hlSource = Wai.getSourceFromFallback waiReq + , hlPath = bsToTxt $ Wai.rawPathInfo waiReq + , hlHttpVersion = Wai.httpVersion waiReq + , hlCompression = compressTypeM , hlHeaders = headers } op = OperationLog @@ -269,8 +267,8 @@ mkHttpErrorLogContext userInfoM reqId req err query mTiming compressTypeM header , olResponseSize = Just $ BL.length $ encode err , olRequestReadTime = Seconds . fst <$> mTiming , olQueryExecutionTime = Seconds . snd <$> mTiming - , olQuery = either (const Nothing) Just query - , olRawQuery = either (Just . bsToTxt . BL.toStrict) (const Nothing) query + , olQuery = parsedReq + , olRawQuery = maybe (Just $ bsToTxt $ BL.toStrict reqBody) (const Nothing) parsedReq , olError = Just err } in HttpLogContext http op