I’m probably going to stop there, I have reached a satisfying point where I get a helpful amount of traces and source locations.
Here is the setup:
- In
cabal.project
profiling: True
package *
profiling-detail: none
ghc-options: +RTS -A32m -RTS -fprof-auto -fprof-auto-calls
- In the code:
setBacktraceMechanismState CostCentreBacktrace True
RequireCallStack
is necessary, without HasCallStack
the trace gives much more details (that are useless to me) about Wai internals and the only location I get is the place of definition .
and the natural transform is:
[…]
import Effectful.Exception qualified as E
[…]
naturalTransform :: RequireCallStack => Eff '[IOE] a -> Servant.Handler a
naturalTransform action = do
result <- liftIO $ Right <$> action
& (`E.catches` exceptionHandlers)
& Eff.runEff
either Servant.throwError pure result
where
exceptionHandlers =
[E.Handler $ \e@(E.SomeException exception) -> do
let context = E.displayExceptionContext $ E.someExceptionContext e
liftIO $ putStrLn $ "Exception: " <> E.displayException exception
liftIO $ putStrLn $ "Context: " <> context
pure $ Left Servant.err500
]
(See the reproducer at hecate/backtrace-reproducer - Codeberg.org)
Which gives me:
Exception: libpq: failed (connection to server on socket "/var/run/postgresql/.s.PGSQL.5432" failed: No such file or directory
Is the server running locally and accepting connections on that socket?
)
Context: Cost-centre stack backtrace:
GHC.Internal.TopHandler.runMainIO1 (<no location info>)
Main.main (app/Main.hs:(6,8)-(8,11))
Server.runServer (src/Server.hs:(32,13)-(37,33))
Server.runServer (src/Server.hs:34:3-56)
Server.runServer.server (src/Server.hs:36:16-40)
Server.mkServer (src/Server.hs:(41,3)-(45,10))
Server.naturalTransform (src/Server.hs:(48,27)-(52,39))
Server.naturalTransform (src/Server.hs:(49,13)-(51,18))
Server.naturalTransform (src/Server.hs:(49,22)-(51,18))
Effectful.Internal.Monad.runEff (src/Effectful/Internal/Monad.hs:363:12-73)
Server.naturalTransform (src/Server.hs:(49,22)-(50,39))
Server.naturalTransform (src/Server.hs:50:10-38)
Effectful.Exception.catches (src/Effectful/Exception.hs:(429,27)-(431,56))
Effectful.Dispatch.Static.Unsafe.reallyUnsafeUnliftIO (src/Effectful/Dispatch/Static/Unsafe.hs:54:26-58)
Effectful.Internal.Monad.unsafeEff (src/Effectful/Internal/Monad.hs:150:15-29)
Effectful.Internal.Monad.unsafeEff (src/Effectful/Internal/Monad.hs:150:20-28)
Effectful.Internal.Monad.>>= (src/Effectful/Internal/Monad.hs:280:36-64)
Effectful.Internal.Monad.>>= (src/Effectful/Internal/Monad.hs:280:36-39)
Server.handleDB (src/Server.hs:77:11-39)
Server.handleDB (src/Server.hs:77:20-39)
Database.PostgreSQL.Simple.Internal.connectPostgreSQL (src/Database/PostgreSQL/Simple/Internal.hs:(262,29)-(279,34))
Database.PostgreSQL.Simple.Internal.connectPostgreSQL (src/Database/PostgreSQL/Simple/Internal.hs:263:13-29)
Database.PostgreSQL.Simple.Internal.connectdb (src/Database/PostgreSQL/Simple/Internal.hs:(285,22)-(287,13))
Database.PostgreSQL.Simple.Internal.connectdb (src/Database/PostgreSQL/Simple/Internal.hs:287:5-13)
Database.PostgreSQL.Simple.Internal.connectdb.loop (src/Database/PostgreSQL/Simple/Internal.hs:(290,17)-(308,40))
Database.PostgreSQL.Simple.Internal.connectdb.loop (src/Database/PostgreSQL/Simple/Internal.hs:(292,7)-(308,40))
Database.PostgreSQL.Simple.Internal.connectdb.loop (src/Database/PostgreSQL/Simple/Internal.hs:293:30-69)
Database.PostgreSQL.Simple.Internal.throwLibPQError (src/Database/PostgreSQL/Simple/Internal.hs:(565,37)-(567,27))
Database.PostgreSQL.Simple.Internal.throwLibPQError (src/Database/PostgreSQL/Simple/Internal.hs:567:3-27)
GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:284:1-7)
GHC.Internal.Stack.withFrozenCallStack (libraries/ghc-internal/src/GHC/Internal/Stack.hs:101:1-19)
GHC.Internal.Exception.toExceptionWithBacktrace1 (<no location info>)
GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:136:1-17)
GHC.Internal.Exception.Backtrace.collectBacktraces1 (<no location info>)
The line Server.handleDB (src/Server.hs:73:20-39))
now refers to the place where the next function connectPostgreSQL
starts getting used, and not wher handleDB
itself is defined.
Bonus
You can tweak manually how the cost centers are pretty-printed, like this:
[…]
import GHC.Foreign as GHC
import Foreign.Ptr
import System.IO
[…]
exceptionHandlers =
[ E.Handler $ \(E.SomeException exception) -> do
liftIO $ putStrLn $ "Exception: " <> E.displayException exception
costCenterStackPtr <- liftIO $ getCurrentCCS ()
costCenterMessage <- liftIO $ ccsToStrings costCenterStackPtr
liftIO $ Text.putStrLn $ Text.intercalate "\n" costCenterMessage
pure $ Left Servant.err500
]
ccsToStrings :: Ptr CostCentreStack -> IO [Text]
ccsToStrings ccs0 = go ccs0 []
where
go ccs acc
| ccs == nullPtr = pure acc
| otherwise = do
cc <- ccsCC ccs
label <- GHC.peekCString utf8 =<< ccLabel cc
mdl <- GHC.peekCString utf8 =<< ccModule cc
loc <- GHC.peekCString utf8 =<< ccSrcSpan cc
parent <- ccsParent ccs
if mdl == "MAIN" && label == "MAIN"
then pure acc
else
let entry =
object ["module" .= mdl, "label" .= label, "location" .= loc]
& encode
& LText.decodeUtf8
& LText.toStrict
in go parent (entry : acc)
Giving you the following:
{"label":"runMainIO1","location":"<no location info>","module":"GHC.Internal.TopHandler"}
{"label":"main","location":"app/Main.hs:(6,8)-(8,11)","module":"Main"}
{"label":"runServer","location":"src/Server.hs:(40,13)-(45,33)","module":"Server"}
{"label":"runServer","location":"src/Server.hs:42:3-56","module":"Server"}
{"label":"runServer.server","location":"src/Server.hs:44:16-40","module":"Server"}
{"label":"mkServer","location":"src/Server.hs:(49,3)-(53,10)","module":"Server"}
{"label":"naturalTransform","location":"src/Server.hs:(56,27)-(60,39)","module":"Server"}
{"label":"naturalTransform","location":"src/Server.hs:(57,13)-(59,18)","module":"Server"}
{"label":"naturalTransform","location":"src/Server.hs:(57,22)-(59,18)","module":"Server"}
{"label":"runEff","location":"src/Effectful/Internal/Monad.hs:363:12-73","module":"Effectful.Internal.Monad"}
{"label":"naturalTransform","location":"src/Server.hs:(57,22)-(58,39)","module":"Server"}
{"label":"naturalTransform","location":"src/Server.hs:58:10-38","module":"Server"}
{"label":"catches","location":"src/Effectful/Exception.hs:(429,27)-(431,56)","module":"Effectful.Exception"}
{"label":"reallyUnsafeUnliftIO","location":"src/Effectful/Dispatch/Static/Unsafe.hs:54:26-58","module":"Effectful.Dispatch.Static.Unsafe"}
{"label":"unsafeEff","location":"src/Effectful/Internal/Monad.hs:150:15-29","module":"Effectful.Internal.Monad"}
{"label":"unsafeEff","location":"src/Effectful/Internal/Monad.hs:150:20-28","module":"Effectful.Internal.Monad"}
{"label":">>=","location":"src/Effectful/Internal/Monad.hs:280:36-64","module":"Effectful.Internal.Monad"}
{"label":">>=","location":"src/Effectful/Internal/Monad.hs:280:36-39","module":"Effectful.Internal.Monad"}
{"label":"naturalTransform.exceptionHandlers","location":"src/Server.hs:65:33-57","module":"Server"}
{"label":"naturalTransform.exceptionHandlers","location":"src/Server.hs:65:42-57","module":"Server"}
which can be sent to a remote logging service as structured data.
(However this is rather truncated compared to what the exception context gives me, but Backtraces
does not expose its internals, so it seems impossible to perform the conversion on what someExceptionContext
gives us.)
A bit of parsing is required on your side to further normalise location
fields in the form "src/Server.hs:65:33-57"
into something like
{
"file": "src/Server.hs",
"start_line": 65,
"end_line": 65,
"start_column": 33,
"end_column": 57
}
and programmatically match the content of the source file in the logging service. Maybe one day we’ll get such a structured output directly.
This is something that other languages like JS and Ruby can have through Sentry, for instance: