hasura · 0x777 · Aug 1, 2019 · Jul 16, 2019 · Jul 16, 2019 · Jul 17, 2019
@@ -136,7 +136,7 @@ data WSLogInfo
   , _wsliConnectionInfo :: !WsConnInfo
   , _wsliEvent          :: !WSEvent
   } deriving (Show, Eq)
-$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''WSLogInfo)
+$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WSLogInfo)
 
 data WSLog
   = WSLog

@@ -205,9 +205,19 @@ logResult logger userInfoM reqId httpReq req res qTime = do
   let logline = case res of
         Right res' -> mkHttpAccessLog userInfoM reqId httpReq res' qTime
         Left e     -> mkHttpErrorLog userInfoM reqId httpReq e req qTime
-  liftIO $ L.unLogger logger $ logline
--- logResult userInfoM req reqBody logger res qTime =
---   liftIO $ L.unLogger logger $ mkAccessLog userInfoM req (reqBody, res) qTime
+  liftIO $ L.unLogger logger logline
+
+logSuccess
+  :: (MonadIO m)
+  => L.Logger
+  -> Maybe UserInfo
+  -> RequestId
+  -> Wai.Request
+  -> BL.ByteString
+  -> Maybe (UTCTime, UTCTime)
+  -> m ()
+logSuccess logger userInfoM reqId httpReq res qTime =
+  liftIO $ L.unLogger logger $ mkHttpAccessLog userInfoM reqId httpReq res qTime
 
 logError
   :: (MonadIO m)
@@ -233,10 +243,12 @@ mkSpockAction qErrEncoder qErrModifier serverCtx apiHandler = do
   let headers = requestHeaders req
       authMode = scAuthMode serverCtx
       manager = scManager serverCtx
+      -- convert ByteString to Maybe Value for logging
+      reqTxt = Just $ String $ bsToTxt $ BL.toStrict reqBody
 
   requestId <- getRequestId headers
   userInfoE <- liftIO $ runExceptT $ getUserInfo logger manager headers authMode
-  userInfo  <- either (logAndThrow requestId req reqBody False . qErrModifier)
+  userInfo  <- either (logErrorAndResp Nothing requestId req reqTxt False . qErrModifier)
                return userInfoE
 
   let handlerState = HandlerCtx serverCtx userInfo headers requestId
@@ -250,7 +262,7 @@ mkSpockAction qErrEncoder qErrModifier serverCtx apiHandler = do
       return (res, Nothing)
     AHPost handler -> do
       parsedReqE <- runExceptT $ parseBody reqBody
-      parsedReq  <- either (qErrToResp (isAdmin curRole) . qErrModifier) return parsedReqE
+      parsedReq  <- either (logErrorAndResp (Just userInfo) requestId req reqTxt (isAdmin curRole) . qErrModifier) return parsedReqE
       res <- liftIO $ runReaderT (runExceptT $ handler parsedReq) handlerState
       return (res, Just parsedReq)
 
@@ -259,36 +271,34 @@ mkSpockAction qErrEncoder qErrModifier serverCtx apiHandler = do
   -- apply the error modifier
   let modResult = fmapL qErrModifier result
 
-  -- log result
-  logResult logger (Just userInfo) requestId req (toJSON <$> q)
-    (apiRespToLBS <$> modResult) $ Just (t1, t2)
-  either (qErrToResp (isAdmin curRole)) (resToResp requestId) modResult
+  -- log and return result
+  case modResult of
+    Left err  -> logErrorAndResp (Just userInfo) requestId req (toJSON <$> q) (isAdmin curRole) err
+    Right res -> logSuccessAndResp (Just userInfo) requestId req res (Just (t1, t2))
 
   where
-    logger     = scLogger serverCtx
-
-    logAndThrow reqId req reqBody includeInternal qErr = do
-      let reqTxt = Just $ toJSON $ String $ bsToTxt $ BL.toStrict reqBody
-      logError logger Nothing reqId req reqTxt qErr
-      qErrToResp includeInternal qErr
+    logger = scLogger serverCtx
 
-    -- encode error response
-    qErrToResp :: (MonadIO m) => Bool -> QErr -> ActionCtxT ctx m b
-    qErrToResp includeInternal qErr = do
+    logErrorAndResp
+      :: (MonadIO m)
+      => Maybe UserInfo -> RequestId -> Wai.Request -> Maybe Value -> Bool -> QErr -> ActionCtxT ctx m a
+    logErrorAndResp userInfo reqId req reqBody includeInternal qErr = do
+      logError logger userInfo reqId req reqBody qErr
       setStatus $ qeStatus qErr
       json $ qErrEncoder includeInternal qErr
 
-    resToResp reqId = \case
-      JSONResp (HttpResponse j h) -> do
-        uncurry setHeader jsonHeader
-        uncurry setHeader (requestIdHeader, unRequestId reqId)
-        mapM_ (mapM_ (uncurry setHeader . unHeader)) h
-        lazyBytes $ encJToLBS j
-      RawResp (HttpResponse b h) -> do
-        uncurry setHeader (requestIdHeader, unRequestId reqId)
-        mapM_ (mapM_ (uncurry setHeader . unHeader)) h
-        lazyBytes b
-
+    logSuccessAndResp userInfo reqId req result qTime = do
+      logSuccess logger userInfo reqId req (apiRespToLBS result) qTime
+      case result of
+        JSONResp (HttpResponse j h) -> do
+          uncurry setHeader jsonHeader
+          uncurry setHeader (requestIdHeader, unRequestId reqId)
+          mapM_ (mapM_ (uncurry setHeader . unHeader)) h
+          lazyBytes $ encJToLBS j
+        RawResp (HttpResponse b h) -> do
+          uncurry setHeader (requestIdHeader, unRequestId reqId)
+          mapM_ (mapM_ (uncurry setHeader . unHeader)) h
+          lazyBytes b
 
 v1QueryHandler :: RQLQuery -> Handler (HttpResponse EncJSON)
 v1QueryHandler query = do

@@ -98,6 +98,13 @@ defaultRoleClaim = "x-hasura-default-role"
 defaultClaimNs :: T.Text
 defaultClaimNs = "https://hasura.io/jwt/claims"
 
+-- | if the time is greater than 100 seconds, should refresh the JWK 10 seonds
+-- before the expiry, else refresh at given seconds
+computeDiffTime :: NominalDiffTime -> Int
+computeDiffTime t =
+  let intTime = diffTimeToMicro t
+  in if intTime > 100 then intTime - 10 else intTime
+
 -- | create a background thread to refresh the JWK
 jwkRefreshCtrl
   :: (MonadIO m)
@@ -113,7 +120,9 @@ jwkRefreshCtrl lggr mngr url ref time =
     forever $ do
       res <- runExceptT $ updateJwkRef lggr mngr url ref
       mTime <- either (const $ return Nothing) return res
-      C.threadDelay $ maybe (60 * aSecond) diffTimeToMicro mTime
+      -- if can't parse time from header, defaults to 1 min
+      let delay = maybe (60 * aSecond) computeDiffTime mTime
+      C.threadDelay delay
   where
     aSecond = 1000 * 1000
 
@@ -130,7 +139,7 @@ updateJwkRef
 updateJwkRef (Logger logger) manager url jwkRef = do
   let options = wreqOptions manager []
       urlT    = T.pack $ show url
-      infoMsg = "refreshing JWK from endpoint: " <> urlT
+      infoMsg = JLNInfo $ "refreshing JWK from endpoint: " <> urlT
   liftIO $ logger $ JwkRefreshLog LevelInfo infoMsg Nothing
   res  <- liftIO $ try $ Wreq.getWith options $ show url
   resp <- either logAndThrowHttp return res
@@ -156,18 +165,23 @@ updateJwkRef (Logger logger) manager url jwkRef = do
     return $ diffUTCTime expires currTime
 
   where
-    logAndThrow :: (MonadIO m, MonadError T.Text m) => T.Text -> Maybe JwkRefreshHttpError -> m a
+    logAndThrow
+      :: (MonadIO m, MonadError T.Text m)
+      => T.Text -> Maybe JwkRefreshHttpError -> m a
     logAndThrow err httpErr = do
-      liftIO $ logger $ JwkRefreshLog (LevelOther "critical") err httpErr
+      liftIO $ logger $ JwkRefreshLog (LevelOther "critical") (JLNError err) httpErr
       throwError err
 
     logAndThrowHttp :: (MonadIO m, MonadError T.Text m) => HTTP.HttpException -> m a
     logAndThrowHttp err = do
-      let httpErr = JwkRefreshHttpError Nothing (T.pack $ show url)
-                    (Just $ HttpException err) Nothing
-          errMsg = "Error fetching JWK: " <> T.pack (show err)
+      let httpErr = JwkRefreshHttpError Nothing (T.pack $ show url) (Just $ HttpException err) Nothing
+          errMsg = "Error fetching JWK: " <> T.pack (getHttpExceptionMsg err)
       logAndThrow errMsg (Just httpErr)
 
+    getHttpExceptionMsg = \case
+      HTTP.HttpExceptionRequest _ reason -> show reason
+      HTTP.InvalidUrlException _ reason -> show reason
+
     timeFmt = "%a, %d %b %Y %T GMT"
 
 

@@ -1,7 +1,7 @@
 module Hasura.Server.Auth.JWT.Logging
   ( JwkRefreshLog (..)
   , JwkRefreshHttpError (..)
-  , mkJwkRefreshLog
+  , JwkLogNotice (..)
   )
   where
 
@@ -12,15 +12,21 @@ import           Hasura.Logging        (EngineLogType (..), LogLevel (..),
                                         ToEngineLog (..))
 import           Hasura.Prelude
 import           Hasura.Server.Logging ()
+import           Hasura.Server.Utils   (httpExceptToJSON)
 
 import qualified Data.Text             as T
 import qualified Network.HTTP.Types    as HTTP
 
 
+data JwkLogNotice
+  = JLNInfo !Text
+  | JLNError !Text
+  deriving (Show)
+
 data JwkRefreshLog
   = JwkRefreshLog
   { jrlLogLevel  :: !LogLevel
-  , jrlError     :: !T.Text
+  , jrlNotice    :: !JwkLogNotice
   , jrlHttpError :: !(Maybe JwkRefreshHttpError)
   } deriving (Show)
 
@@ -37,18 +43,20 @@ instance ToJSON JwkRefreshHttpError where
     object [ "status_code" .= (HTTP.statusCode <$> jrheStatus jhe)
            , "url" .= jrheUrl jhe
            , "response" .= jrheResponse jhe
-           , "http_exception" .= (toJSON <$> jrheHttpException jhe)
+           , "http_exception" .= (httpExceptToJSON . unHttpException <$> jrheHttpException jhe)
            ]
 
 instance ToJSON JwkRefreshLog where
-  toJSON jrl =
-    object [ "error" .= jrlError jrl
-           , "http_error" .= (toJSON <$> jrlHttpError jrl)
-           ]
+  toJSON jrl = case jrlNotice jrl of
+    JLNInfo info ->
+      object [ "message" .= info
+             , "http_error" .= (toJSON <$> jrlHttpError jrl)
+             ]
+    JLNError err ->
+      object [ "error" .= err
+             , "http_error" .= (toJSON <$> jrlHttpError jrl)
+             ]
 
 instance ToEngineLog JwkRefreshLog where
   toEngineLog jwkRefreshLog =
     (jrlLogLevel jwkRefreshLog, ELTJwkRefreshLog, toJSON jwkRefreshLog)
-
-mkJwkRefreshLog :: LogLevel -> T.Text -> Maybe JwkRefreshHttpError -> JwkRefreshLog
-mkJwkRefreshLog = JwkRefreshLog
@@ -180,7 +180,7 @@ fmapL _ (Right x) = pure x
 -- diff time to micro seconds
 diffTimeToMicro :: NominalDiffTime -> Int
 diffTimeToMicro diff =
-  (floor (realToFrac diff :: Double) - 10) * aSecond
+  floor (realToFrac diff :: Double) * aSecond
   where
     aSecond = 1000 * 1000
 

@@ -21,13 +21,26 @@ def transact(self, hge_ctx):
         # setup some tables
         st_code, resp = hge_ctx.v1q_f(self.dir + '/setup.yaml')
         assert st_code == 200, resp
+
+        # make a successful query
         q = {'query': 'query { hello {code name} }'}
         headers = {}
         if hge_ctx.hge_key:
             headers['x-hasura-admin-secret'] = hge_ctx.hge_key
         resp = hge_ctx.http.post(hge_ctx.hge_url + '/v1/graphql', json=q,
                                  headers=headers)
         assert resp.status_code == 200 and 'data' in resp.json()
+
+        # make a query where JSON body parsing fails
+        q = {'quer': 'query { hello {code name} }'}
+        headers = {'x-request-id': 'json-parse-fail-log-test'}
+        if hge_ctx.hge_key:
+            headers['x-hasura-admin-secret'] = hge_ctx.hge_key
+        resp = hge_ctx.http.post(hge_ctx.hge_url + '/v1/graphql', json=q,
+                                 headers=headers)
+        assert resp.status_code == 200 and 'errors' in resp.json()
+
+        # gather and parse the logs now
         self.logs = self._parse_logs(hge_ctx)
         # sometimes the log might take time to buffer
         time.sleep(2)
@@ -115,3 +128,15 @@ def _get_query_logs(x):
         assert 'query' in onelog
         assert 'query' in onelog['query']
         assert 'generated_sql' in onelog
+
+    def test_http_parse_failed_log(self, hge_ctx):
+        def _get_parse_failed_logs(x):
+            return x['type'] == 'http-log' and \
+                x['detail']['operation']['request_id'] == 'json-parse-fail-log-test'
+
+        http_logs = list(filter(_get_parse_failed_logs, self.logs))
+        print('parse failed logs', http_logs)
+        assert len(http_logs) > 0
+        print(http_logs[0])
+        assert 'error' in http_logs[0]['detail']['operation']
+        assert http_logs[0]['detail']['operation']['error']['code'] == 'parse-failed'