module Rollbar where
import BasicPrelude
import Data.Aeson
import Data.Aeson.TH hiding (Options)
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)
newtype ApiToken = ApiToken { unApiToken :: Text } deriving Show
newtype Environment = Environment { unEnvironment :: Text } deriving Show
data Person = Person
{ id :: Text
, username :: Maybe Text
, email :: Maybe Text
} deriving Show
deriveToJSON defaultOptions ''Person
data Settings = Settings
{ environment :: Environment
, token :: ApiToken
, hostName :: HostName
} deriving Show
data Options = Options
{ person :: Maybe Person
, revisionSha :: Maybe Text
} deriving Show
emptyOptions :: Options
emptyOptions = Options Nothing Nothing
reportErrorS :: (MonadIO m, MonadBaseControl IO m)
=> Settings
-> Options
-> Text
-> Text
-> m ()
reportErrorS settings opts section =
reportLoggerErrorS settings opts section logMessage
where
logMessage sec message = putStrLn $ "[Error#" `mappend` sec `mappend` "] " `mappend` " " `mappend` message
reportLoggerErrorS :: (MonadIO m, MonadBaseControl IO m)
=> Settings
-> Options
-> Text
-> (Text -> Text -> m ())
-> Text
-> m ()
reportLoggerErrorS settings opts section loggerS msg = do
logger msg
liftIO $
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
title = section <> ": " <> msg
logger = loggerS section
rollbarJson = object
[ "access_token" .= unApiToken (token settings)
, "data" .= object
[ "environment" .= toLower (unEnvironment $ environment settings)
, "level" .= ("error" :: Text)
, "server" .= object [ "host" .= hostName settings, "sha" .= revisionSha opts]
, "person" .= toJSON (person opts)
, "body" .= object
[ "trace" .= object
[ "frames" .= (Array $ V.fromList [])
, "exception" .= object ["class" .= title, "message" .= title]
]
]
]
, "title" .= title
, "notifier" .= object [
"name" .= "rollbar-haskell"
, "version" .= "0.2.1"
]
]