{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Rollbar.Client.Item
(
Item(..)
, mkItem
, Body(..)
, Payload(..)
, Trace(..)
, Frame(..)
, Context(..)
, Exception(..)
, mkException
, Message(..)
, Level(..)
, mkLevel
, Request(..)
, getRequestModifier
, Server(..)
, Notifier(..)
, defaultNotifier
, ItemId(..)
, 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
, Item -> Body
itemBody :: Body
, Item -> Maybe Level
itemLevel :: Maybe Level
, Item -> Maybe Text
itemPlatform :: Maybe Text
, Item -> Maybe Text
itemLanguage :: Maybe Text
, Item -> Maybe Text
itemFramework :: Maybe Text
, Item -> Maybe Request
itemRequest :: Maybe Request
, Item -> Maybe Server
itemServer :: Maybe Server
, Item -> Notifier
itemNotifier :: Notifier
} 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
]
]
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
}
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]
, 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
, Frame -> Maybe Integer
frameLineno :: Maybe Integer
, Frame -> Maybe Integer
frameColno :: Maybe Integer
, Frame -> Maybe Text
frameMethod :: Maybe Text
, Frame -> Maybe Text
frameCode :: Maybe Text
, Frame -> Maybe Text
frameClassName :: Maybe Text
, Frame -> Maybe Context
frameContext :: Maybe Context
} 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
]
data Context = Context
{ Context -> [Text]
contextPre :: [Text]
, Context -> [Text]
contextPost :: [Text]
} 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
]
data Exception = Exception
{ Exception -> Text
exceptionClass :: Text
, Exception -> Maybe Text
exceptionMessage :: Maybe Text
, Exception -> Maybe Text
exceptionDescription :: Maybe Text
} 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
]
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
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"
mkLevel :: Payload -> Level
mkLevel :: Payload -> Level
mkLevel (PayloadMessage Message
_) = Level
LevelInfo
mkLevel Payload
_ = Level
LevelError
data Request = Request
{ Request -> Text
requestUrl :: Text
, Request -> Text
requestMethod :: Text
, :: Object
, Request -> Object
requestParams :: Object
, Request -> Object
requestGet :: Object
, Request -> Text
requestQueryStrings :: Text
, Request -> Object
requestPost :: Object
, Request -> Text
requestBody :: Text
, Request -> Text
requestUserIp :: Text
} 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
]
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 Server = Server
{ Server -> Maybe Text
serverCpu :: Maybe Text
, Server -> Maybe Text
serverHost :: Maybe Text
, Server -> Maybe Text
serverRoot :: Maybe Text
, Server -> Maybe Text
serverBranch :: Maybe Text
, Server -> Maybe Text
serverCodeVersion :: Maybe Text
} 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
]
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"
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 }