mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 01:12:56 +03:00
Merge branch 'master' into 5363-default-bounded-plan-cache
This commit is contained in:
Brandon Simmons
GitHub
commit
b973479631
@ -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`
|
||||
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user