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)
guardIO :: SentryService
-> String
-> Maybe String
-> Maybe String
-> IO a
-> ActionM a
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
logError :: SentryService
-> String
-> String
-> (SentryRecord -> SentryRecord)
-> ActionM ()
logError raven logger msg upd = do
ifHttp <- scottyHttpInterface
liftIO $ register raven logger Error msg (upd . ifHttp)
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 []