module Rollbar where
import BasicPrelude
import Data.Aeson
import Data.Text (toLower)
import qualified Data.Vector as V
import Network.BSD (HostName)
import Control.Monad.Trans.Control (MonadBaseControl)
import Network.HTTP.Conduit
( RequestBody(RequestBodyLBS)
, Request(method, requestBody)
, parseUrl
, withManager
, http )
default (Text)
reportErrorS :: (MonadIO m, MonadBaseControl IO m)
=> Text
-> Text
-> HostName
-> Text
-> Text
-> m ()
reportErrorS token env hostName section msg =
reportLoggerErrorS token env hostName section logMessage msg
where
logMessage sec message = putStrLn $ "[Error#" `mappend` sec `mappend` "] " `mappend` " " `mappend` message
reportLoggerErrorS :: (MonadIO m, MonadBaseControl IO m)
=> Text
-> Text
-> HostName
-> Text
-> (Text -> Text -> m ())
-> Text
-> m ()
reportLoggerErrorS token env hostName section loggerS msg = do
logger msg
liftIO $ do
void $ withManager $ \manager -> do
initReq <- liftIO $ parseUrl "https://api.rollbar.com/api/1/item/"
let req = initReq { method = "POST", requestBody = RequestBodyLBS $ encode rollbarJson }
http req manager
`catch` (\(e::SomeException) -> logger $ show e)
where
logger = loggerS section
rollbarJson = object
[ "access_token" .= token
, "data" .= object
[ "environment" .= toLower env
, "level" .= ("error" :: Text)
, "server" .= object [ "host" .= hostName ]
, "custom" .= object []
, "body" .= object
[ "trace" .= object
[ "frames" .= (Array $ V.fromList [])
, "exception" .= object ["class" .= section, "message" .= msg]
]
]
]
]