diff --git a/CHANGELOG.md b/CHANGELOG.md index 081dad112cc10..fa4d58f02de39 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ (Add entries here in the order of: server, console, cli, docs, others) - console: update sidebar icons for different action and trigger types +- server: add request/response sizes in event triggers (and scheduled trigger) logs ## `v1.3.0` diff --git a/server/src-lib/Hasura/Eventing/EventTrigger.hs b/server/src-lib/Hasura/Eventing/EventTrigger.hs index c32c2508b998c..5b37e7e416d1a 100644 --- a/server/src-lib/Hasura/Eventing/EventTrigger.hs +++ b/server/src-lib/Hasura/Eventing/EventTrigger.hs @@ -64,6 +64,7 @@ import Hasura.SQL.Types import qualified Hasura.Tracing as Tracing import qualified Control.Concurrent.Async.Lifted.Safe as LA +import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as M import qualified Data.TByteString as TBS import qualified Data.Text as T @@ -272,9 +273,11 @@ processEventQueue logger logenv httpMgr pool getSchemaCache eeCtx@EventEngineCtx etHeaders = map encodeHeader headerInfos headers = addDefaultHeaders etHeaders ep = createEventPayload retryConf e + payload = encode $ toJSON ep extraLogCtx = ExtraLogContext Nothing (epId ep) -- avoiding getting current time here to avoid another IO call with each event call - res <- runExceptT $ tryWebhook headers responseTimeout (toJSON ep) webhook - logHTTPForET res extraLogCtx + requestDetails = RequestDetails $ LBS.length payload + res <- runExceptT $ tryWebhook headers responseTimeout payload webhook + logHTTPForET res extraLogCtx requestDetails let decodedHeaders = map (decodeHeader logenv headerInfos) headers either (processError pool e retryConf decodedHeaders ep) diff --git a/server/src-lib/Hasura/Eventing/HTTP.hs b/server/src-lib/Hasura/Eventing/HTTP.hs index ac23d5ace1288..bfc0cbca64e5a 100644 --- a/server/src-lib/Hasura/Eventing/HTTP.hs +++ b/server/src-lib/Hasura/Eventing/HTTP.hs @@ -17,6 +17,7 @@ module Hasura.Eventing.HTTP , logHTTPForET , logHTTPForST , ExtraLogContext(..) + , RequestDetails (..) , EventId , Invocation(..) , InvocationVersion @@ -46,9 +47,9 @@ import qualified Data.TByteString as TBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE +import qualified Data.Time.Clock as Time import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types as HTTP -import qualified Data.Time.Clock as Time import Control.Exception (try) import Data.Aeson @@ -56,6 +57,7 @@ import Data.Aeson.Casing import Data.Aeson.TH import Data.Either import Data.Has +import Data.Int (Int64) import Hasura.Logging import Hasura.Prelude import Hasura.RQL.DDL.Headers @@ -146,6 +148,7 @@ data HTTPResp (a :: TriggerTypes) { hrsStatus :: !Int , hrsHeaders :: ![HeaderConf] , hrsBody :: !TBS.TByteString + , hrsSize :: !Int64 } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''HTTPResp) @@ -189,28 +192,37 @@ mkHTTPResp resp = HTTPResp { hrsStatus = HTTP.statusCode $ HTTP.responseStatus resp , hrsHeaders = map decodeHeader $ HTTP.responseHeaders resp - , hrsBody = TBS.fromLBS $ HTTP.responseBody resp + , hrsBody = TBS.fromLBS respBody + , hrsSize = LBS.length respBody } where + respBody = HTTP.responseBody resp decodeBS = TE.decodeUtf8With TE.lenientDecode decodeHeader (hdrName, hdrVal) = HeaderConf (decodeBS $ CI.original hdrName) (HVValue (decodeBS hdrVal)) +newtype RequestDetails + = RequestDetails { _rdSize :: Int64 } +$(deriveToJSON (aesonDrop 3 snakeCase) ''RequestDetails) + data HTTPRespExtra (a :: TriggerTypes) = HTTPRespExtra - { _hreResponse :: Either (HTTPErr a) (HTTPResp a) - , _hreContext :: ExtraLogContext + { _hreResponse :: !(Either (HTTPErr a) (HTTPResp a)) + , _hreContext :: !ExtraLogContext + , _hreRequest :: !RequestDetails } instance ToJSON (HTTPRespExtra a) where - toJSON (HTTPRespExtra resp ctxt) = do + toJSON (HTTPRespExtra resp ctxt req) = case resp of Left errResp -> object [ "response" .= toJSON errResp + , "request" .= toJSON req , "context" .= toJSON ctxt ] Right rsp -> object [ "response" .= toJSON rsp + , "request" .= toJSON req , "context" .= toJSON ctxt ] @@ -260,20 +272,26 @@ logHTTPForET , Has (Logger Hasura) r , MonadIO m ) - => Either (HTTPErr 'EventType) (HTTPResp 'EventType) -> ExtraLogContext -> m () -logHTTPForET eitherResp extraLogCtx = do + => Either (HTTPErr 'EventType) (HTTPResp 'EventType) + -> ExtraLogContext + -> RequestDetails + -> m () +logHTTPForET eitherResp extraLogCtx reqDetails = do logger :: Logger Hasura <- asks getter - unLogger logger $ HTTPRespExtra eitherResp extraLogCtx + unLogger logger $ HTTPRespExtra eitherResp extraLogCtx reqDetails logHTTPForST :: ( MonadReader r m , Has (Logger Hasura) r , MonadIO m ) - => Either (HTTPErr 'ScheduledType) (HTTPResp 'ScheduledType) -> ExtraLogContext -> m () -logHTTPForST eitherResp extraLogCtx = do + => Either (HTTPErr 'ScheduledType) (HTTPResp 'ScheduledType) + -> ExtraLogContext + -> RequestDetails + -> m () +logHTTPForST eitherResp extraLogCtx reqDetails = do logger :: Logger Hasura <- asks getter - unLogger logger $ HTTPRespExtra eitherResp extraLogCtx + unLogger logger $ HTTPRespExtra eitherResp extraLogCtx reqDetails runHTTP :: (MonadIO m) => HTTP.Manager -> HTTP.Request -> m (Either (HTTPErr a) (HTTPResp a)) runHTTP manager req = do @@ -289,7 +307,10 @@ tryWebhook :: ) => [HTTP.Header] -> HTTP.ResponseTimeout - -> Value + -> LBS.ByteString + -- ^ the request body. It is passed as a 'BL.Bytestring' because we need to + -- log the request size. As the logging happens outside the function, we pass + -- it the final request body, instead of 'Value' -> String -> m (HTTPResp a) tryWebhook headers timeout payload webhook = do @@ -302,10 +323,10 @@ tryWebhook headers timeout payload webhook = do initReq { HTTP.method = "POST" , HTTP.requestHeaders = headers - , HTTP.requestBody = HTTP.RequestBodyLBS (encode payload) + , HTTP.requestBody = HTTP.RequestBodyLBS payload , HTTP.responseTimeout = timeout } - tracedHttpRequest req \req' -> do + tracedHttpRequest req $ \req' -> do eitherResp <- runHTTP manager req' onLeft eitherResp throwError diff --git a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs index 65cb285556610..bc7e00b1baeb6 100644 --- a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs +++ b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs @@ -95,6 +95,7 @@ import System.Cron import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J +import qualified Data.ByteString.Lazy as BL import qualified Data.Environment as Env import qualified Data.HashMap.Strict as Map import qualified Data.Set as Set @@ -489,8 +490,10 @@ processScheduledEvent webhookReqPayload = ScheduledEventWebhookPayload sefId sefName sefScheduledTime sefPayload sefComment currentTime webhookReqBodyJson = J.toJSON webhookReqPayload - res <- runExceptT $ tryWebhook headers httpTimeout webhookReqBodyJson (T.unpack sefWebhook) - logHTTPForST res extraLogCtx + webhookReqBody = J.encode webhookReqBodyJson + requestDetails = RequestDetails $ BL.length webhookReqBody + res <- runExceptT $ tryWebhook headers httpTimeout webhookReqBody (T.unpack sefWebhook) + logHTTPForST res extraLogCtx requestDetails let decodedHeaders = map (decodeHeader logEnv sefHeaders) headers either (processError pgpool se decodedHeaders type' webhookReqBodyJson)