Merge branch 'master' into 5363-default-bounded-plan-cache

This commit is contained in:
Brandon Simmons 2020-07-29 12:09:21 -04:00 committed by GitHub
commit b973479631
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
14 changed files with 189 additions and 97 deletions

View File

@ -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`

View File

@ -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 =

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -19,6 +19,7 @@ import Control.Exception (try)
import Control.Lens
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
@ -41,6 +42,7 @@ 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.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
:: 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,7 +441,7 @@ 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
@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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)

View File

@ -283,7 +283,7 @@ 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)
userInfo <- either (logErrorAndResp Nothing requestId req (reqBody, Nothing) False headers . qErrModifier)
return userInfoE
let handlerState = HandlerCtx serverCtx userInfo headers requestId ipAddress
@ -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,23 +400,35 @@ 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
:: forall m .
( HasVersion
, MonadIO m
)
=> GE.GQLExplain
@ -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

View File

@ -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,19 +245,19 @@ 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
, hlMethod = bsToTxt $ Wai.requestMethod waiReq
, hlSource = Wai.getSourceFromFallback waiReq
, hlPath = bsToTxt $ Wai.rawPathInfo waiReq
, hlHttpVersion = Wai.httpVersion waiReq
, hlCompression = compressTypeM
, hlHeaders = headers
}
@ -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