{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Rollbar.Client.Item
  ( -- ** Requests
    Item(..)
  , mkItem
  , Body(..)
  , Payload(..)
  , Trace(..)
  , Frame(..)
  , Context(..)
  , Exception(..)
  , mkException
  , Message(..)
  , Level(..)
  , mkLevel
  , Request(..)
  , getRequestModifier
  , Server(..)
  , Notifier(..)
  , defaultNotifier
    -- ** Responses
  , ItemId(..)
    -- ** Endpoints
  , createItem
  ) where

import qualified Control.Exception as E
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T

import Control.Monad.IO.Class (MonadIO(..))
import Data.Aeson
import Data.Maybe (catMaybes)
import Data.Monoid (Endo(..))
import Data.Text
import Network.HTTP.Req
import Rollbar.Client.Internal
import Rollbar.Client.Settings
import System.Directory (getCurrentDirectory)
import System.Info (arch, os)

data Item = Item
  { Item -> Environment
itemEnvironment :: Environment
    -- ^ The name of the environment in which this occurrence was seen. A
    -- string up to 255 characters. For best results, use "production" or
    -- "prod" for your production environment.  You don't need to configure
    -- anything in the Rollbar UI for new environment names; we'll detect them
    -- automatically.
  , Item -> Body
itemBody :: Body
    -- ^ The main data being sent. It can either be a message, an exception, or
    -- a crash report.
  , Item -> Maybe Level
itemLevel :: Maybe Level
    -- ^ The severity level. One of: "critical", "error", "warning", "info",
    -- "debug" Defaults to "error" for exceptions and "info" for messages.  The
    -- level of the *first* occurrence of an item is used as the item's level.
  -- timestamp
  -- code_version
  , Item -> Maybe Text
itemPlatform :: Maybe Text
    -- ^ The platform on which this occurred. Meaningful platform names:
    -- "browser", "android", "ios", "flash", "client", "heroku",
    -- "google-app-engine" If this is a client-side event, be sure to specify
    -- the platform and use a post_client_item access token.
  , Item -> Maybe Text
itemLanguage :: Maybe Text
    -- ^ The name of the language your code is written in.  This can affect the
    -- order of the frames in the stack trace. The following languages set the
    -- most recent call first - 'ruby', 'javascript', 'php', 'java',
    -- 'objective-c', 'lua' It will also change the way the individual frames
    -- are displayed, with what is most consistent with users of the language.
  , Item -> Maybe Text
itemFramework :: Maybe Text
    -- ^ The name of the framework your code uses.
  -- context
  -- request
  , Item -> Maybe Request
itemRequest :: Maybe Request
    -- ^ Data about the request this event occurred in.
  -- person
  , Item -> Maybe Server
itemServer :: Maybe Server
    -- ^ Data about the server related to this event.
  -- client
  -- custom
  -- fingerprint
  -- title
  -- uuid
  , Item -> Notifier
itemNotifier :: Notifier
    -- ^ Describes the library used to send this event.
  } deriving (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)

instance ToJSON Item where
  toJSON :: Item -> Value
toJSON Item{Maybe Text
Maybe Server
Maybe Request
Maybe Level
Environment
Notifier
Body
itemNotifier :: Notifier
itemServer :: Maybe Server
itemRequest :: Maybe Request
itemFramework :: Maybe Text
itemLanguage :: Maybe Text
itemPlatform :: Maybe Text
itemLevel :: Maybe Level
itemBody :: Body
itemEnvironment :: Environment
itemNotifier :: Item -> Notifier
itemServer :: Item -> Maybe Server
itemRequest :: Item -> Maybe Request
itemFramework :: Item -> Maybe Text
itemLanguage :: Item -> Maybe Text
itemPlatform :: Item -> Maybe Text
itemLevel :: Item -> Maybe Level
itemBody :: Item -> Body
itemEnvironment :: Item -> Environment
..} = [Pair] -> Value
object
    [ Text
"data" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
        [ Text
"environment" Text -> Environment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Environment
itemEnvironment
        , Text
"body" Text -> Body -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Body
itemBody
        , Text
"level" Text -> Maybe Level -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Level
itemLevel
        , Text
"platform" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
itemPlatform
        , Text
"language" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
itemLanguage
        , Text
"framework" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
itemFramework
        , Text
"request" Text -> Maybe Request -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Request
itemRequest
        , Text
"server" Text -> Maybe Server -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Server
itemServer
        , Text
"notifier" Text -> Notifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Notifier
itemNotifier
        ]
    ]

-- | Builds an 'Item' based on a 'Payload'.
mkItem
  :: (HasSettings m, MonadIO m)
  => Payload
  -> m Item
mkItem :: Payload -> m Item
mkItem Payload
payload = do
  Environment
environment <- Settings -> Environment
settingsEnvironment (Settings -> Environment) -> m Settings -> m Environment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Settings
forall (m :: * -> *). HasSettings m => m Settings
getSettings
  String
root <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
  Item -> m Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item :: Environment
-> Body
-> Maybe Level
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Request
-> Maybe Server
-> Notifier
-> Item
Item
    { itemEnvironment :: Environment
itemEnvironment = Environment
environment
    , itemBody :: Body
itemBody = Body :: Payload -> Body
Body
        { bodyPayload :: Payload
bodyPayload = Payload
payload
        }
    , itemLevel :: Maybe Level
itemLevel = Level -> Maybe Level
forall a. a -> Maybe a
Just (Level -> Maybe Level) -> Level -> Maybe Level
forall a b. (a -> b) -> a -> b
$ Payload -> Level
mkLevel Payload
payload
    , itemPlatform :: Maybe Text
itemPlatform = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
os
    , itemLanguage :: Maybe Text
itemLanguage = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"haskell"
    , itemFramework :: Maybe Text
itemFramework = Maybe Text
forall a. Maybe a
Nothing
    , itemRequest :: Maybe Request
itemRequest = Maybe Request
forall a. Maybe a
Nothing
    , itemServer :: Maybe Server
itemServer = Server -> Maybe Server
forall a. a -> Maybe a
Just Server :: Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Server
Server
        { serverCpu :: Maybe Text
serverCpu = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
arch
        , serverHost :: Maybe Text
serverHost = Maybe Text
forall a. Maybe a
Nothing
        , serverRoot :: Maybe Text
serverRoot = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
root
        , serverBranch :: Maybe Text
serverBranch = Maybe Text
forall a. Maybe a
Nothing
        , serverCodeVersion :: Maybe Text
serverCodeVersion = Maybe Text
forall a. Maybe a
Nothing
        }
    , itemNotifier :: Notifier
itemNotifier = Notifier
defaultNotifier
    }

-- | The main data being sent. It can either be a message, an exception, or a
-- crash report.
newtype Body = Body { Body -> Payload
bodyPayload :: Payload }
  deriving (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c== :: Body -> Body -> Bool
Eq, Int -> Body -> ShowS
[Body] -> ShowS
Body -> String
(Int -> Body -> ShowS)
-> (Body -> String) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Body] -> ShowS
$cshowList :: [Body] -> ShowS
show :: Body -> String
$cshow :: Body -> String
showsPrec :: Int -> Body -> ShowS
$cshowsPrec :: Int -> Body -> ShowS
Show)

instance ToJSON Body where
  toJSON :: Body -> Value
toJSON Body{Payload
bodyPayload :: Payload
bodyPayload :: Body -> Payload
..} = [Pair] -> Value
object
    [ case Payload
bodyPayload of
        (PayloadTrace Trace
trace) -> (Text
"trace", Trace -> Value
forall a. ToJSON a => a -> Value
toJSON Trace
trace)
        (PayloadTraceChain [Trace]
traceChain) -> (Text
"trace_chain", [Trace] -> Value
forall a. ToJSON a => a -> Value
toJSON [Trace]
traceChain)
        (PayloadMessage Message
message) -> (Text
"message", Message -> Value
forall a. ToJSON a => a -> Value
toJSON Message
message)
    ]

data Payload
  = PayloadTrace Trace
  | PayloadTraceChain [Trace]
  | PayloadMessage Message
  deriving (Payload -> Payload -> Bool
(Payload -> Payload -> Bool)
-> (Payload -> Payload -> Bool) -> Eq Payload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Payload -> Payload -> Bool
$c/= :: Payload -> Payload -> Bool
== :: Payload -> Payload -> Bool
$c== :: Payload -> Payload -> Bool
Eq, Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> String
(Int -> Payload -> ShowS)
-> (Payload -> String) -> ([Payload] -> ShowS) -> Show Payload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Payload] -> ShowS
$cshowList :: [Payload] -> ShowS
show :: Payload -> String
$cshow :: Payload -> String
showsPrec :: Int -> Payload -> ShowS
$cshowsPrec :: Int -> Payload -> ShowS
Show)

data Trace = Trace
  { Trace -> [Frame]
traceFrames :: [Frame]
    -- ^ A list of stack frames, ordered such that the most recent call is last
    -- in the list.
  , Trace -> Exception
traceException :: Exception
  } deriving (Trace -> Trace -> Bool
(Trace -> Trace -> Bool) -> (Trace -> Trace -> Bool) -> Eq Trace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trace -> Trace -> Bool
$c/= :: Trace -> Trace -> Bool
== :: Trace -> Trace -> Bool
$c== :: Trace -> Trace -> Bool
Eq, Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
(Int -> Trace -> ShowS)
-> (Trace -> String) -> ([Trace] -> ShowS) -> Show Trace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show)

instance ToJSON Trace where
  toJSON :: Trace -> Value
toJSON Trace{[Frame]
Exception
traceException :: Exception
traceFrames :: [Frame]
traceException :: Trace -> Exception
traceFrames :: Trace -> [Frame]
..} = [Pair] -> Value
object
    [ Text
"frames" Text -> [Frame] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Frame]
traceFrames
    , Text
"exception" Text -> Exception -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Exception
traceException
    ]

data Frame = Frame
  { Frame -> Text
frameFilename :: Text
    -- ^ The filename including its full path.
  , Frame -> Maybe Integer
frameLineno :: Maybe Integer
    -- ^ The line number as an integer.
  , Frame -> Maybe Integer
frameColno :: Maybe Integer
    -- ^ The column number as an integer.
  , Frame -> Maybe Text
frameMethod :: Maybe Text
    -- ^ The method or function name.
  , Frame -> Maybe Text
frameCode :: Maybe Text
    -- ^ The line of code.
  , Frame -> Maybe Text
frameClassName :: Maybe Text
    -- ^ A string containing the class name.  Used in the UI when the payload's
    -- top-level "language" key has the value "java".
  , Frame -> Maybe Context
frameContext :: Maybe Context
    -- ^ Additional code before and after the "code" line.
  } deriving (Frame -> Frame -> Bool
(Frame -> Frame -> Bool) -> (Frame -> Frame -> Bool) -> Eq Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c== :: Frame -> Frame -> Bool
Eq, Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)

instance ToJSON Frame where
  toJSON :: Frame -> Value
toJSON Frame{Maybe Integer
Maybe Text
Maybe Context
Text
frameContext :: Maybe Context
frameClassName :: Maybe Text
frameCode :: Maybe Text
frameMethod :: Maybe Text
frameColno :: Maybe Integer
frameLineno :: Maybe Integer
frameFilename :: Text
frameContext :: Frame -> Maybe Context
frameClassName :: Frame -> Maybe Text
frameCode :: Frame -> Maybe Text
frameMethod :: Frame -> Maybe Text
frameColno :: Frame -> Maybe Integer
frameLineno :: Frame -> Maybe Integer
frameFilename :: Frame -> Text
..} = [Pair] -> Value
object
    [ Text
"filename" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
frameFilename
    , Text
"lineno" Text -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
frameLineno
    , Text
"colno" Text -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Integer
frameColno
    , Text
"method" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
frameMethod
    , Text
"code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
frameCode
    , Text
"class_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
frameClassName
    , Text
"context" Text -> Maybe Context -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Context
frameContext
    ]

-- | Additional code before and after the "code" line.
data Context = Context
  { Context -> [Text]
contextPre :: [Text]
    -- ^ List of lines of code before the "code" line.
  , Context -> [Text]
contextPost :: [Text]
    -- ^ List of lines of code after the "code" line.
  } deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

instance ToJSON Context where
  toJSON :: Context -> Value
toJSON Context{[Text]
contextPost :: [Text]
contextPre :: [Text]
contextPost :: Context -> [Text]
contextPre :: Context -> [Text]
..} = [Pair] -> Value
object
    [ Text
"pre" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
contextPre
    , Text
"post" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
contextPost
    ]

-- | An object describing the exception instance.
data Exception = Exception
  { Exception -> Text
exceptionClass :: Text
    -- ^ The exception class name.
  , Exception -> Maybe Text
exceptionMessage :: Maybe Text
    -- ^ The exception message, as a string.
  , Exception -> Maybe Text
exceptionDescription :: Maybe Text
    -- ^ An alternate human-readable string describing the exception Usually
    -- the original exception message will have been machine-generated; you can
    -- use this to send something custom.
  } deriving (Exception -> Exception -> Bool
(Exception -> Exception -> Bool)
-> (Exception -> Exception -> Bool) -> Eq Exception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exception -> Exception -> Bool
$c/= :: Exception -> Exception -> Bool
== :: Exception -> Exception -> Bool
$c== :: Exception -> Exception -> Bool
Eq, Int -> Exception -> ShowS
[Exception] -> ShowS
Exception -> String
(Int -> Exception -> ShowS)
-> (Exception -> String)
-> ([Exception] -> ShowS)
-> Show Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception] -> ShowS
$cshowList :: [Exception] -> ShowS
show :: Exception -> String
$cshow :: Exception -> String
showsPrec :: Int -> Exception -> ShowS
$cshowsPrec :: Int -> Exception -> ShowS
Show)

instance ToJSON Exception where
  toJSON :: Exception -> Value
toJSON Exception{Maybe Text
Text
exceptionDescription :: Maybe Text
exceptionMessage :: Maybe Text
exceptionClass :: Text
exceptionDescription :: Exception -> Maybe Text
exceptionMessage :: Exception -> Maybe Text
exceptionClass :: Exception -> Text
..} = [Pair] -> Value
object
    [ Text
"class" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
exceptionClass
    , Text
"message" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
exceptionMessage
    , Text
"description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
exceptionDescription
    ]

-- | Builds a 'Exception' based on 'E.SomeException'.
mkException :: E.Exception e => e -> Exception
mkException :: e -> Exception
mkException e
e = Exception :: Text -> Maybe Text -> Maybe Text -> Exception
Exception
  { exceptionClass :: Text
exceptionClass = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
E.displayException e
e
  , exceptionMessage :: Maybe Text
exceptionMessage = Maybe Text
forall a. Maybe a
Nothing
  , exceptionDescription :: Maybe Text
exceptionDescription = Maybe Text
forall a. Maybe a
Nothing
  }

data Message = Message
  { Message -> Text
messageBody :: Text
  , Message -> Object
messageMetadata :: Object
  } deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show)

instance ToJSON Message where
  toJSON :: Message -> Value
toJSON Message{Text
Object
messageMetadata :: Object
messageBody :: Text
messageMetadata :: Message -> Object
messageBody :: Message -> Text
..} = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
    Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"body" (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
messageBody) Object
messageMetadata

-- | The severity level. One of: "critical", "error", "warning", "info",
-- "debug" Defaults to "error" for exceptions and "info" for messages. The
-- level of the *first* occurrence of an item is used as the item's level.
data Level
  = LevelCritical
  | LevelError
  | LevelWarning
  | LevelInfo
  | LevelDebug
  deriving (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq, Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show)

instance ToJSON Level where
  toJSON :: Level -> Value
toJSON = \case
    Level
LevelCritical -> Value
"critical"
    Level
LevelError -> Value
"error"
    Level
LevelWarning -> Value
"warning"
    Level
LevelInfo -> Value
"info"
    Level
LevelDebug -> Value
"debug"

-- | Builds a 'Level' based on a 'Payload'.
mkLevel :: Payload -> Level
mkLevel :: Payload -> Level
mkLevel (PayloadMessage Message
_) = Level
LevelInfo
mkLevel Payload
_ = Level
LevelError

-- | Data about the request this event occurred in.
data Request = Request
  { Request -> Text
requestUrl :: Text
    -- ^ Full URL where this event occurred.
  , Request -> Text
requestMethod :: Text
    -- ^ The request method.
  , Request -> Object
requestHeaders :: Object
    -- ^ Object containing the request headers.
  , Request -> Object
requestParams :: Object
    -- ^ Any routing parameters (i.e. for use with Rails Routes).
  , Request -> Object
requestGet :: Object
    -- ^ Query string params.
  , Request -> Text
requestQueryStrings :: Text
    -- ^ The raw query string.
  , Request -> Object
requestPost :: Object
    -- ^ POST params.
  , Request -> Text
requestBody :: Text
    -- ^ The raw POST body.
  , Request -> Text
requestUserIp :: Text
    -- ^ Can also be the special value "$remote_ip", which will be replaced
    -- with the source IP of the API request.  Will be indexed, as long as it
    -- is a valid IPv4 address.
  } deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

instance ToJSON Request where
  toJSON :: Request -> Value
toJSON Request{Text
Object
requestUserIp :: Text
requestBody :: Text
requestPost :: Object
requestQueryStrings :: Text
requestGet :: Object
requestParams :: Object
requestHeaders :: Object
requestMethod :: Text
requestUrl :: Text
requestUserIp :: Request -> Text
requestBody :: Request -> Text
requestPost :: Request -> Object
requestQueryStrings :: Request -> Text
requestGet :: Request -> Object
requestParams :: Request -> Object
requestHeaders :: Request -> Object
requestMethod :: Request -> Text
requestUrl :: Request -> Text
..} = [Pair] -> Value
object
    [ Text
"url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
requestUrl
    , Text
"method" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
requestMethod
    , Text
"headers" Text -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object
requestHeaders
    , Text
"params" Text -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object
requestParams
    , Text
"GET" Text -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object
requestGet
    , Text
"query_string" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
requestQueryStrings
    , Text
"POST" Text -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object
requestPost
    , Text
"body" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
requestBody
    , Text
"user_ip" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
requestUserIp
    ]

-- | Pulls 'RequestModifiers' out of 'Settings' and build a list of 'Endo
-- Request' which are folded as a single request modifier function.
getRequestModifier :: (HasSettings m, Monad m) => m (Request -> Request)
getRequestModifier :: m (Request -> Request)
getRequestModifier = do
  RequestModifiers{Maybe (NonEmpty Text)
requestModifiersIncludeParams :: RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersIncludeHeaders :: RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersExcludeParams :: RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersExcludeHeaders :: RequestModifiers -> Maybe (NonEmpty Text)
requestModifiersIncludeParams :: Maybe (NonEmpty Text)
requestModifiersIncludeHeaders :: Maybe (NonEmpty Text)
requestModifiersExcludeParams :: Maybe (NonEmpty Text)
requestModifiersExcludeHeaders :: Maybe (NonEmpty Text)
..} <- Settings -> RequestModifiers
settingsRequestModifiers (Settings -> RequestModifiers) -> m Settings -> m RequestModifiers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Settings
forall (m :: * -> *). HasSettings m => m Settings
getSettings
  (Request -> Request) -> m (Request -> Request)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Request -> Request) -> m (Request -> Request))
-> (Request -> Request) -> m (Request -> Request)
forall a b. (a -> b) -> a -> b
$ Endo Request -> Request -> Request
forall a. Endo a -> a -> a
appEndo (Endo Request -> Request -> Request)
-> Endo Request -> Request -> Request
forall a b. (a -> b) -> a -> b
$ [Endo Request] -> Endo Request
forall a. Monoid a => [a] -> a
mconcat ([Endo Request] -> Endo Request) -> [Endo Request] -> Endo Request
forall a b. (a -> b) -> a -> b
$ [Maybe (Endo Request)] -> [Endo Request]
forall a. [Maybe a] -> [a]
catMaybes
    [ (Object -> Object) -> Endo Request
withHeaders ((Object -> Object) -> Endo Request)
-> (NonEmpty Text -> Object -> Object)
-> NonEmpty Text
-> Endo Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Object -> Object
forall (t :: * -> *) a v.
(Foldable t, Eq a) =>
t a -> HashMap a v -> HashMap a v
excludeNames (NonEmpty Text -> Endo Request)
-> Maybe (NonEmpty Text) -> Maybe (Endo Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersExcludeHeaders
    , (Object -> Object) -> Endo Request
withParams ((Object -> Object) -> Endo Request)
-> (NonEmpty Text -> Object -> Object)
-> NonEmpty Text
-> Endo Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Object -> Object
forall (t :: * -> *) a v.
(Foldable t, Eq a) =>
t a -> HashMap a v -> HashMap a v
excludeNames (NonEmpty Text -> Endo Request)
-> Maybe (NonEmpty Text) -> Maybe (Endo Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersExcludeParams
    , (Object -> Object) -> Endo Request
withHeaders ((Object -> Object) -> Endo Request)
-> (NonEmpty Text -> Object -> Object)
-> NonEmpty Text
-> Endo Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Object -> Object
forall (t :: * -> *) a v.
(Foldable t, Eq a) =>
t a -> HashMap a v -> HashMap a v
includeNames (NonEmpty Text -> Endo Request)
-> Maybe (NonEmpty Text) -> Maybe (Endo Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersIncludeHeaders
    , (Object -> Object) -> Endo Request
withParams ((Object -> Object) -> Endo Request)
-> (NonEmpty Text -> Object -> Object)
-> NonEmpty Text
-> Endo Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Object -> Object
forall (t :: * -> *) a v.
(Foldable t, Eq a) =>
t a -> HashMap a v -> HashMap a v
includeNames (NonEmpty Text -> Endo Request)
-> Maybe (NonEmpty Text) -> Maybe (Endo Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersIncludeParams
    ]
  where
    withHeaders :: (Object -> Object) -> Endo Request
withHeaders Object -> Object
f = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
request -> Request
request
      { requestHeaders :: Object
requestHeaders = Object -> Object
f (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ Request -> Object
requestHeaders Request
request }
    withParams :: (Object -> Object) -> Endo Request
withParams Object -> Object
f = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
request -> Request
request
      { requestParams :: Object
requestParams = Object -> Object
f (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ Request -> Object
requestParams Request
request }
    excludeNames :: t a -> HashMap a v -> HashMap a v
excludeNames t a
names = (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey ((a -> v -> Bool) -> HashMap a v -> HashMap a v)
-> (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall a b. (a -> b) -> a -> b
$ \a
name v
_ -> a
name a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t a
names
    includeNames :: t a -> HashMap a v -> HashMap a v
includeNames t a
names = (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey ((a -> v -> Bool) -> HashMap a v -> HashMap a v)
-> (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall a b. (a -> b) -> a -> b
$ \a
name v
_ -> a
name a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
names

-- | Data about the server related to this event.
data Server = Server
  { Server -> Maybe Text
serverCpu :: Maybe Text
    -- ^ A string up to 255 characters.
  , Server -> Maybe Text
serverHost :: Maybe Text
    -- ^ The server hostname. Will be indexed.
  , Server -> Maybe Text
serverRoot :: Maybe Text
    -- ^ Path to the application code root, not including the final slash.
    -- Used to collapse non-project code when displaying tracebacks.
  , Server -> Maybe Text
serverBranch :: Maybe Text
    -- ^ Name of the checked-out source control branch. Defaults to "master".
  , Server -> Maybe Text
serverCodeVersion :: Maybe Text
    -- ^ String describing the running code version on the server.
  } deriving (Server -> Server -> Bool
(Server -> Server -> Bool)
-> (Server -> Server -> Bool) -> Eq Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
(Int -> Server -> ShowS)
-> (Server -> String) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show)

instance ToJSON Server where
  toJSON :: Server -> Value
toJSON Server{Maybe Text
serverCodeVersion :: Maybe Text
serverBranch :: Maybe Text
serverRoot :: Maybe Text
serverHost :: Maybe Text
serverCpu :: Maybe Text
serverCodeVersion :: Server -> Maybe Text
serverBranch :: Server -> Maybe Text
serverRoot :: Server -> Maybe Text
serverHost :: Server -> Maybe Text
serverCpu :: Server -> Maybe Text
..} = [Pair] -> Value
object
    [ Text
"cpu" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
serverCpu
    , Text
"host" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
serverHost
    , Text
"root" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
serverRoot
    , Text
"branch" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
serverBranch
    , Text
"code_version" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
serverCodeVersion
    ]

data Notifier = Notifier
  { Notifier -> Text
notifierName :: Text
  , Notifier -> Text
notifierVersion :: Text
  } deriving (Notifier -> Notifier -> Bool
(Notifier -> Notifier -> Bool)
-> (Notifier -> Notifier -> Bool) -> Eq Notifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notifier -> Notifier -> Bool
$c/= :: Notifier -> Notifier -> Bool
== :: Notifier -> Notifier -> Bool
$c== :: Notifier -> Notifier -> Bool
Eq, Int -> Notifier -> ShowS
[Notifier] -> ShowS
Notifier -> String
(Int -> Notifier -> ShowS)
-> (Notifier -> String) -> ([Notifier] -> ShowS) -> Show Notifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notifier] -> ShowS
$cshowList :: [Notifier] -> ShowS
show :: Notifier -> String
$cshow :: Notifier -> String
showsPrec :: Int -> Notifier -> ShowS
$cshowsPrec :: Int -> Notifier -> ShowS
Show)

instance ToJSON Notifier where
  toJSON :: Notifier -> Value
toJSON Notifier{Text
notifierVersion :: Text
notifierName :: Text
notifierVersion :: Notifier -> Text
notifierName :: Notifier -> Text
..} = [Pair] -> Value
object
    [ Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
notifierName
    , Text
"version" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
notifierVersion
    ]

-- | Returns information about this package such as the name and version.
defaultNotifier :: Notifier
defaultNotifier :: Notifier
defaultNotifier = Notifier :: Text -> Text -> Notifier
Notifier
  { notifierName :: Text
notifierName = Text
"rollbar-client"
  , notifierVersion :: Text
notifierVersion = Text
"0.1.0"
  }

newtype ItemId = ItemId Text
  deriving (ItemId -> ItemId -> Bool
(ItemId -> ItemId -> Bool)
-> (ItemId -> ItemId -> Bool) -> Eq ItemId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemId -> ItemId -> Bool
$c/= :: ItemId -> ItemId -> Bool
== :: ItemId -> ItemId -> Bool
$c== :: ItemId -> ItemId -> Bool
Eq, Int -> ItemId -> ShowS
[ItemId] -> ShowS
ItemId -> String
(Int -> ItemId -> ShowS)
-> (ItemId -> String) -> ([ItemId] -> ShowS) -> Show ItemId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemId] -> ShowS
$cshowList :: [ItemId] -> ShowS
show :: ItemId -> String
$cshow :: ItemId -> String
showsPrec :: Int -> ItemId -> ShowS
$cshowsPrec :: Int -> ItemId -> ShowS
Show)

instance FromJSON ItemId where
  parseJSON :: Value -> Parser ItemId
parseJSON = String -> (Object -> Parser ItemId) -> Value -> Parser ItemId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ItemId" ((Object -> Parser ItemId) -> Value -> Parser ItemId)
-> (Object -> Parser ItemId) -> Value -> Parser ItemId
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> ItemId
ItemId (Text -> ItemId) -> Parser Text -> Parser ItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uuid"

-- | Reports an occurrence (exception or message) to Rollbar.
--
-- __Example__
--
-- > settings <- readSettings "rollbar.yaml"
-- > runRollbar settings $ do
-- >   item <- mkItem $ PayloadTrace $ Trace [] $ Exception
-- >     { exceptionClass = "NameError"
-- >     , exceptionMessage = Just "global name 'foo' is not defined"
-- >     , exceptionDescription = Just "Something went wrong while trying to save the user object"
-- >     }
-- >   createItem item
--
-- __Reference__
--
-- <https://explorer.docs.rollbar.com/#operation/create-item>
createItem
  :: (HasSettings m, MonadHttp m)
  => Item
  -> m ItemId
createItem :: Item -> m ItemId
createItem Item
item = do
  Request -> Request
requestModifier <- m (Request -> Request)
forall (m :: * -> *).
(HasSettings m, Monad m) =>
m (Request -> Request)
getRequestModifier
  (JsonResponse (ResultResponse ItemId) -> ItemId)
-> m (JsonResponse (ResultResponse ItemId)) -> m ItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (ResultResponse ItemId -> ItemId
forall a. ResultResponse a -> a
resultResponseResult (ResultResponse ItemId -> ItemId)
-> (JsonResponse (ResultResponse ItemId) -> ResultResponse ItemId)
-> JsonResponse (ResultResponse ItemId)
-> ItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonResponse (ResultResponse ItemId) -> ResultResponse ItemId
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody)
    (POST
-> Url 'Https
-> ReqBodyJson Item
-> Proxy (JsonResponse (ResultResponse ItemId))
-> m (JsonResponse (ResultResponse ItemId))
forall (m :: * -> *) body method response.
(HasSettings m, HttpBody body,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body),
 HttpMethod method, HttpResponse response, MonadHttp m) =>
method -> Url 'Https -> body -> Proxy response -> m response
rollbar POST
POST Url 'Https
url ((Request -> Request) -> ReqBodyJson Item
body Request -> Request
requestModifier) Proxy (JsonResponse (ResultResponse ItemId))
forall a. Proxy (JsonResponse a)
jsonResponse)
  where
    url :: Url 'Https
url = Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"item" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
""
    body :: (Request -> Request) -> ReqBodyJson Item
body Request -> Request
requestModifier = Item -> ReqBodyJson Item
forall a. a -> ReqBodyJson a
ReqBodyJson (Item -> ReqBodyJson Item) -> Item -> ReqBodyJson Item
forall a b. (a -> b) -> a -> b
$
      Item
item { itemRequest :: Maybe Request
itemRequest = Request -> Request
requestModifier (Request -> Request) -> Maybe Request -> Maybe Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item -> Maybe Request
itemRequest Item
item }