{-# 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.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as K
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 (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
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
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
    [ Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
        [ Key
"environment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Environment
itemEnvironment
        , Key
"body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Body
itemBody
        , Key
"level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Level
itemLevel
        , Key
"platform" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
itemPlatform
        , Key
"language" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
itemLanguage
        , Key
"framework" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
itemFramework
        , Key
"request" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Request
itemRequest
        , Key
"server" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Server
itemServer
        , Key
"notifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Notifier
itemNotifier
        ]
    ]

-- | Builds an 'Item' based on a 'Payload'.
mkItem
  :: (HasSettings m, MonadIO m)
  => Payload
  -> m Item
mkItem :: forall (m :: * -> *).
(HasSettings m, MonadIO m) =>
Payload -> m Item
mkItem Payload
payload = do
  Environment
environment <- Settings -> Environment
settingsEnvironment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasSettings m => m Settings
getSettings
  String
root <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
  forall (m :: * -> *) a. Monad m => a -> m a
return Item
    { itemEnvironment :: Environment
itemEnvironment = Environment
environment
    , itemBody :: Body
itemBody = Body
        { bodyPayload :: Payload
bodyPayload = Payload
payload
        }
    , itemLevel :: Maybe Level
itemLevel = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Payload -> Level
mkLevel Payload
payload
    , itemPlatform :: Maybe Text
itemPlatform = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
os
    , itemLanguage :: Maybe Text
itemLanguage = forall a. a -> Maybe a
Just Text
"haskell"
    , itemFramework :: Maybe Text
itemFramework = forall a. Maybe a
Nothing
    , itemRequest :: Maybe Request
itemRequest = forall a. Maybe a
Nothing
    , itemServer :: Maybe Server
itemServer = forall a. a -> Maybe a
Just Server
        { serverCpu :: Maybe Text
serverCpu = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
arch
        , serverHost :: Maybe Text
serverHost = forall a. Maybe a
Nothing
        , serverRoot :: Maybe Text
serverRoot = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
root
        , serverBranch :: Maybe Text
serverBranch = forall a. Maybe a
Nothing
        , serverCodeVersion :: Maybe Text
serverCodeVersion = 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
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
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) -> (Key
"trace", forall a. ToJSON a => a -> Value
toJSON Trace
trace)
        (PayloadTraceChain [Trace]
traceChain) -> (Key
"trace_chain", forall a. ToJSON a => a -> Value
toJSON [Trace]
traceChain)
        (PayloadMessage Message
message) -> (Key
"message", forall a. ToJSON a => a -> Value
toJSON Message
message)
    ]

data Payload
  = PayloadTrace Trace
  | PayloadTraceChain [Trace]
  | PayloadMessage Message
  deriving (Payload -> Payload -> Bool
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
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
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
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
    [ Key
"frames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Frame]
traceFrames
    , Key
"exception" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
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
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
    [ Key
"filename" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
frameFilename
    , Key
"lineno" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
frameLineno
    , Key
"colno" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
frameColno
    , Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
frameMethod
    , Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
frameCode
    , Key
"class_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
frameClassName
    , Key
"context" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
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
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
    [ Key
"pre" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
contextPre
    , Key
"post" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
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
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
    [ Key
"class" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
exceptionClass
    , Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
exceptionMessage
    , Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
exceptionDescription
    ]

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

data Message = Message
  { Message -> Text
messageBody :: Text
  , Message -> Object
messageMetadata :: Object
  } deriving (Message -> Message -> Bool
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
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 forall a b. (a -> b) -> a -> b
$
    forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
"body" (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
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
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
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
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
    [ Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
requestUrl
    , Key
"method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
requestMethod
    , Key
"headers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object
requestHeaders
    , Key
"params" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object
requestParams
    , Key
"GET" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object
requestGet
    , Key
"query_string" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
requestQueryStrings
    , Key
"POST" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object
requestPost
    , Key
"body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
requestBody
    , Key
"user_ip" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 :: forall (m :: * -> *).
(HasSettings m, Monad m) =>
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasSettings m => m Settings
getSettings
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Endo a -> a -> a
appEndo forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
    [ (Object -> Object) -> Endo Request
withHeaders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {v}.
Foldable t =>
t Key -> KeyMap v -> KeyMap v
excludeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
K.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersExcludeHeaders
    , (Object -> Object) -> Endo Request
withParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {v}.
Foldable t =>
t Key -> KeyMap v -> KeyMap v
excludeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
K.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersExcludeParams
    , (Object -> Object) -> Endo Request
withHeaders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {v}.
Foldable t =>
t Key -> KeyMap v -> KeyMap v
includeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
K.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty Text)
requestModifiersIncludeHeaders
    , (Object -> Object) -> Endo Request
withParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {v}.
Foldable t =>
t Key -> KeyMap v -> KeyMap v
includeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
K.fromText 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 = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
request -> Request
request
      { requestHeaders :: Object
requestHeaders = Object -> Object
f forall a b. (a -> b) -> a -> b
$ Request -> Object
requestHeaders Request
request }
    withParams :: (Object -> Object) -> Endo Request
withParams Object -> Object
f = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
request -> Request
request
      { requestParams :: Object
requestParams = Object -> Object
f forall a b. (a -> b) -> a -> b
$ Request -> Object
requestParams Request
request }
    excludeNames :: t Key -> KeyMap v -> KeyMap v
excludeNames t Key
names = forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KM.filterWithKey forall a b. (a -> b) -> a -> b
$ \Key
name v
_ -> Key
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t Key
names
    includeNames :: t Key -> KeyMap v -> KeyMap v
includeNames t Key
names = forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KM.filterWithKey forall a b. (a -> b) -> a -> b
$ \Key
name v
_ -> Key
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Key
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
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
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
    [ Key
"cpu" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
serverCpu
    , Key
"host" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
serverHost
    , Key
"root" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
serverRoot
    , Key
"branch" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
serverBranch
    , Key
"code_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
serverCodeVersion
    ]

data Notifier = Notifier
  { Notifier -> Text
notifierName :: Text
  , Notifier -> Text
notifierVersion :: Text
  } deriving (Notifier -> Notifier -> Bool
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
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
    [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
notifierName
    , Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
notifierVersion
    ]

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

newtype ItemId = ItemId Text
  deriving (ItemId -> ItemId -> Bool
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ItemId" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> ItemId
ItemId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 :: forall (m :: * -> *).
(HasSettings m, MonadHttp m) =>
Item -> m ItemId
createItem Item
item = do
  Request -> Request
requestModifier <- forall (m :: * -> *).
(HasSettings m, Monad m) =>
m (Request -> Request)
getRequestModifier
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (forall a. ResultResponse a -> a
resultResponseResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody)
    (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) forall a. Proxy (JsonResponse a)
jsonResponse)
  where
    url :: Url 'Https
url = Url 'Https
baseUrl forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"item" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
""
    body :: (Request -> Request) -> ReqBodyJson Item
body Request -> Request
requestModifier = forall a. a -> ReqBodyJson a
ReqBodyJson forall a b. (a -> b) -> a -> b
$
      Item
item { itemRequest :: Maybe Request
itemRequest = Request -> Request
requestModifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item -> Maybe Request
itemRequest Item
item }