diff --git a/changelog.d/5-internal/galley-request-id b/changelog.d/5-internal/galley-request-id new file mode 100644 index 0000000000..90e448b49b --- /dev/null +++ b/changelog.d/5-internal/galley-request-id @@ -0,0 +1 @@ +Set request ID correctly in galley logs diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 7b63c880cb..e3a80a6bef 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -37,7 +37,6 @@ module Galley.App -- * Running Galley effects GalleyEffects, - runGalley, evalGalley, ask, DeleteItem (..), @@ -95,7 +94,6 @@ import Network.HTTP.Client.OpenSSL import Network.HTTP.Media.RenderHeader (RenderHeader (..)) import Network.HTTP.Types (hContentType) import Network.HTTP.Types.Status (statusCode, statusMessage) -import Network.Wai import qualified Network.Wai.Utilities as Wai import qualified Network.Wai.Utilities.Server as Server import OpenSSL.Session as Ssl @@ -188,11 +186,6 @@ initHttpManager o = do managerIdleConnectionCount = 3 * (o ^. optSettings . setHttpPoolSize) } -runGalley :: Env -> Request -> Sem GalleyEffects a -> IO a -runGalley e r m = - let e' = reqId .~ lookupReqId r $ e - in evalGalley e' m - interpretTinyLog :: Members '[Embed IO] r => Env -> @@ -201,9 +194,6 @@ interpretTinyLog :: interpretTinyLog e = interpret $ \case P.Polylog l m -> Logger.log (e ^. applog) l (reqIdMsg (e ^. reqId) . m) -lookupReqId :: Request -> RequestId -lookupReqId = maybe def RequestId . lookup requestIdName . requestHeaders - toServantHandler :: Env -> Sem GalleyEffects a -> Servant.Handler a toServantHandler env galley = do eith <- liftIO $ Control.Exception.try (evalGalley env galley) diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs index b34d7df724..18f5a8d0e7 100644 --- a/services/galley/src/Galley/Run.hs +++ b/services/galley/src/Galley/Run.hs @@ -21,13 +21,16 @@ module Galley.Run ) where +import Bilge.Request (requestIdName) import Cassandra (runClient, shutdown) import Cassandra.Schema (versionCheck) import qualified Control.Concurrent.Async as Async import Control.Exception (finally) -import Control.Lens (view, (^.)) +import Control.Lens (view, (.~), (^.)) import qualified Data.Aeson as Aeson +import Data.Default import Data.Domain +import Data.Id import qualified Data.Metrics.Middleware as M import Data.Metrics.Servant (servantPlusWAIPrometheusMiddleware) import Data.Misc (portNumber) @@ -45,6 +48,7 @@ import qualified Galley.Queue as Q import Imports import qualified Network.HTTP.Media.RenderHeader as HTTPMedia import qualified Network.HTTP.Types as HTTP +import Network.Wai import qualified Network.Wai.Middleware.Gunzip as GZip import qualified Network.Wai.Middleware.Gzip as GZip import Network.Wai.Utilities.Server @@ -91,21 +95,25 @@ mkApp o = do return (middlewares $ servantApp e, e, finalizer) where rtree = compile API.sitemap - app e r k = runGalley e r (route rtree r k) + app e r k = evalGalley e (route rtree r k) -- the servant API wraps the one defined using wai-routing - servantApp e r = - Servant.serveWithContext - (Proxy @CombinedAPI) - ( view (options . optSettings . setFederationDomain) e - :. customFormatters - :. Servant.EmptyContext - ) - ( hoistServer' @GalleyAPI.ServantAPI (toServantHandler e) API.servantSitemap - :<|> hoistServer' @Internal.ServantAPI (toServantHandler e) Internal.servantSitemap - :<|> hoistServer' @FederationAPI (toServantHandler e) federationSitemap - :<|> Servant.Tagged (app e) - ) - r + servantApp e0 r = + let e = reqId .~ lookupReqId r $ e0 + in Servant.serveWithContext + (Proxy @CombinedAPI) + ( view (options . optSettings . setFederationDomain) e + :. customFormatters + :. Servant.EmptyContext + ) + ( hoistServer' @GalleyAPI.ServantAPI (toServantHandler e) API.servantSitemap + :<|> hoistServer' @Internal.ServantAPI (toServantHandler e) Internal.servantSitemap + :<|> hoistServer' @FederationAPI (toServantHandler e) federationSitemap + :<|> Servant.Tagged (app e) + ) + r + + lookupReqId :: Request -> RequestId + lookupReqId = maybe def RequestId . lookup requestIdName . requestHeaders -- Servant needs a context type argument here that contains *at least* the -- context types required by all the HasServer instances. In reality, this should