Improvements to middlewares

CHANGELOG.md

@@ -60,6 +60,7 @@ Upgrade nginz (#1658)
 
 * Improvements to local integration test setup when using buildah and kind (#1667)
 * The servant-swagger dependency now points to the current upstream master (#1656).
+* Improved error handling middleware (#1671).
 * Refactor function createUser for readability (#1670)
 
 ## Federation changes (alpha feature, do not use yet)

libs/wai-utilities/src/Network/Wai/Utilities/Server.hs

@@ -299,28 +299,28 @@ rethrow5xx logger app req k = app req k'
       if statusCode st < 500
         then k resp
         else do
-          rsbody :: LText <- liftIO $ cs <$> lazyResponseBody resp
+          rsbody <- liftIO (lazyResponseBody resp)
           throwM $ wrapError st rsbody
 
 -- | Wrap the body of an HTTP error into a Wai.Error structure.
 --
 -- If the error is already a JSON serialisation of a Wai.Error, avoid creating
 -- an unnecessary wrapper.
-wrapError :: Status -> LText -> Wai.Error
+wrapError :: Status -> LByteString -> Wai.Error
 wrapError st body =
-  decode (LT.encodeUtf8 body)
-    ?: Wai.mkError st "server-error" body
+  decode body
+    ?: Wai.mkError st "server-error" (cs body)
 
 -- | This flushes the response!  If you want to keep using the response, you need to construct
 -- a new one with a fresh body stream.
 lazyResponseBody :: Response -> IO LByteString
 lazyResponseBody rs = case responseToStream rs of
   (_, _, cont :: (StreamingBody -> IO ()) -> IO ()) -> do
-    tvar <- atomically $ newTVar mempty
-    let pushstream builder = atomically $ modifyTVar tvar (<> builder)
+    bref <- newIORef mempty
+    let pushstream builder = modifyIORef bref (<> builder)
     cont $ \streamingBody ->
       streamingBody pushstream (pure ())
-    atomically $ toLazyByteString <$> readTVar tvar
+    toLazyByteString <$> readIORef bref
 
 --------------------------------------------------------------------------------
 -- Utilities

services/brig/src/Brig/Run.hs

@@ -112,9 +112,9 @@ mkApp o = do
     middleware :: Env -> (RequestId -> Wai.Application) -> Wai.Application
     middleware e =
       Metrics.servantPlusWAIPrometheusMiddleware (sitemap o) (Proxy @ServantCombinedAPI)
-        . catchErrors (e ^. applog) [Right $ e ^. metrics]
         . GZip.gunzip
         . GZip.gzip GZip.def
+        . catchErrors (e ^. applog) [Right $ e ^. metrics]
         . lookupRequestIdMiddleware
     app e r k = runHandler e r (Server.route rtree r k) k
 

services/cannon/src/Cannon/Run.hs

@@ -67,8 +67,8 @@ run o = do
       middleware :: Wai.Middleware
       middleware =
         waiPrometheusMiddleware sitemap
-          . catchErrors g [Right m]
           . Gzip.gzip Gzip.def
+          . catchErrors g [Right m]
       start = middleware app
   runSettings s start `finally` do
     Async.cancel refreshMetricsThread

services/cargohold/src/CargoHold/Run.hs

@@ -46,6 +46,6 @@ run o = do
     middleware :: Env -> Wai.Middleware
     middleware e =
       waiPrometheusMiddleware sitemap
-        . catchErrors (e ^. appLogger) [Right $ e ^. metrics]
         . GZip.gzip GZip.def
+        . catchErrors (e ^. appLogger) [Right $ e ^. metrics]
     serve e r k = runHandler e r (Server.route rtree r k) k

services/galley/src/Galley/Run.hs

@@ -89,9 +89,9 @@ mkApp o = do
         Log.close l
       middlewares =
         servantPlusWAIPrometheusMiddleware API.sitemap (Proxy @CombinedAPI)
-          . catchErrors l [Right m]
           . GZip.gunzip
           . GZip.gzip GZip.def
+          . catchErrors l [Right m]
   return (middlewares $ servantApp e, e, finalizer)
   where
     rtree = compile API.sitemap

services/gundeck/src/Gundeck/Run.hs

@@ -61,9 +61,9 @@ run o = do
     middleware :: Env -> Wai.Middleware
     middleware e =
       waiPrometheusMiddleware sitemap
-        . catchErrors (e ^. applog) [Right $ e ^. monitor]
         . GZip.gunzip
         . GZip.gzip GZip.def
+        . catchErrors (e ^. applog) [Right $ e ^. monitor]
     app :: Env -> Wai.Application
     app e r k = runGundeck e r (route routes r k)
     routes = compile sitemap