{-# LANGUAGE ScopedTypeVariables #-}
-- | Utilities to log errors in Scotty actions using raven-haskell.
--
-- > import Web.Scotty
-- >
-- > import System.Log.Raven
-- > import System.Log.Raven.Transport.HttpConduit (sendRecord)
-- > import System.Log.Raven.Scotty
-- >
-- > main = do
-- > raven <- initRaven "https://…" id sendRecord stderrFallback
-- > let hereBeDragons = guardIO raven "my.logger" (Just "DragonsError") (Just "My.Inner.Dragons")
-- >
-- > scotty 8000 $ do
-- > post "/some/action/" $ do
-- > arg1 <- param "arg1"
-- > arg2 <- param "arg2"
-- > ds <- hereBeDragons $ dragonsIO arg1 arg2
-- > if null ds
-- > then text "no dragons"
-- > else do
-- > let msg = "dragons! run!"
-- > scottyHttpInterface >>= logError raven "Main.main" msg
module System.Log.Raven.Scotty
( guardIO
, logError
, scottyHttpInterface
) where
import Web.Scotty (ActionM, request, reqHeader, params)
import System.Log.Raven as Raven
import System.Log.Raven.Types as Raven
import System.Log.Raven.Transport.HttpConduit (sendRecord)
import qualified System.Log.Raven.Interfaces as SI
import Network.Wai(Request(..))
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text.Lazy as TL
import qualified Data.CaseInsensitive as CI
import Control.Monad.Trans (liftIO)
import Control.Exception (try, throw, SomeException)
-- | A liftIO alternative that logs unhandled exceptions.
-- The function itself is verbose in arguments and designed to be curried and reused.
guardIO :: SentryService -- ^ Configured Sentry service.
-> String -- ^ Logger name.
-> Maybe String -- ^ Exception type name.
-> Maybe String -- ^ Action module name.
-> IO a -- ^ Action to run.
-> ActionM a -- ^ Result in a Scotty ActionM monad.
guardIO raven logger typename modname io = do
res <- liftIO $ try io
case res of
Right r -> return r
Left (e :: SomeException) -> do
let exc = SI.exception (show e) typename modname
logError raven logger (takeWhile (/= ' ') $ show e) exc
liftIO $ throw e
-- | Log an error in an ActionM monad, collecting request data.
logError :: SentryService -- ^ A configured Sentry service.
-> String -- ^ Logger name.
-> String -- ^ Message to log.
-> (SentryRecord -> SentryRecord) -- ^ Additional interfaces or other updates.
-> ActionM ()
logError raven logger msg upd = do
ifHttp <- scottyHttpInterface
liftIO $ register raven logger Error msg (upd . ifHttp)
-- | Collect request parameters for a HTTP sentry interface.
scottyHttpInterface :: ActionM (SentryRecord -> SentryRecord)
scottyHttpInterface = do
r <- request
let method = BS.unpack $ requestMethod r
let qs = case BS.unpack $ rawQueryString r of
"" -> Nothing
c -> Just c
let hs = [ (BS.unpack . CI.original $ h, BS.unpack v)
| (h, v) <- requestHeaders r
]
#if MIN_VERSION_scotty(0,5,0)
host <- maybe (TL.pack "") id `fmap` reqHeader (TL.pack "Host")
#else
host <- reqHeader (TL.pack "Host")
#endif
let url = "http://" ++ TL.unpack host ++ BS.unpack (rawPathInfo r)
ps <- params
let args = SI.QueryArgs [ (TL.unpack k, TL.unpack v)
| (k, v) <- ps
]
return $ SI.http url method args qs Nothing hs []