{-# LANGUAGE OverloadedStrings #-}

-- | Structured data interfaces from Sentry core:
--   <http://sentry.readthedocs.org/en/latest/developer/interfaces/index.html#provided-interfaces>

module System.Log.Raven.Interfaces
    ( -- * Core sentry interfaces
      -- ** Message
      message
      -- ** Exception
    , exception
      -- ** Http
    , http, HttpArgs(..)
      -- ** User
    , user
      -- ** Query
    , query
      -- * Generic interface helpers
    , interface
    , fields, (.=:), fromMaybe, fromAssoc
    ) where

import Data.Aeson (ToJSON(toJSON), Value, object, (.=))
import qualified Data.HashMap.Strict as HM

import System.Log.Raven.Types

-- | 'sentry.interfaces.Message':
--   A standard message consisting of a message arg, and an optional params
--   arg for formatting.
message :: String       -- ^ Message text (no more than 1000 characters in length).
        -> [Value]      -- ^ Formatting arguments
        -> SentryRecord -- ^ Record to update
        -> SentryRecord
message :: String -> [Value] -> SentryRecord -> SentryRecord
message String
msg [Value]
args = String -> Value -> SentryRecord -> SentryRecord
forall v. ToJSON v => String -> v -> SentryRecord -> SentryRecord
interface String
"sentry.interfaces.Message" Value
info
    where
        info :: Value
info = [Pair] -> Value
object [ Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1000 String
msg
                      , Key
"params" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Value]
args
                      ]

-- | 'sentry.interfaces.Exception':
--   A standard exception with a mandatory value argument,
--   and optional type and``module`` argument describing
--   the exception class type and module namespace.
exception :: String       -- ^ Value
          -> Maybe String -- ^ Type
          -> Maybe String -- ^ Module
          -> SentryRecord -- ^ Record to update
          -> SentryRecord
exception :: String
-> Maybe String -> Maybe String -> SentryRecord -> SentryRecord
exception String
v Maybe String
t Maybe String
m = String -> HashMap String Value -> SentryRecord -> SentryRecord
forall v. ToJSON v => String -> v -> SentryRecord -> SentryRecord
interface String
"sentry.interfaces.Exception" HashMap String Value
info
    where
        info :: HashMap String Value
info = [[(String, Value)]] -> HashMap String Value
fields [ String
"value" String -> String -> [(String, Value)]
forall v. ToJSON v => String -> v -> [(String, Value)]
.=: String
v
                      , String -> Maybe String -> [(String, Value)]
forall v. ToJSON v => String -> Maybe v -> [(String, Value)]
fromMaybe String
"type" Maybe String
t
                      , String -> Maybe String -> [(String, Value)]
forall v. ToJSON v => String -> Maybe v -> [(String, Value)]
fromMaybe String
"module" Maybe String
m
                      ]

-- | Optional and optionally parsed HTTP query
data HttpArgs = EmptyArgs
              | RawArgs String
              | QueryArgs [(String, String)]
              deriving (HttpArgs -> HttpArgs -> Bool
(HttpArgs -> HttpArgs -> Bool)
-> (HttpArgs -> HttpArgs -> Bool) -> Eq HttpArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpArgs -> HttpArgs -> Bool
$c/= :: HttpArgs -> HttpArgs -> Bool
== :: HttpArgs -> HttpArgs -> Bool
$c== :: HttpArgs -> HttpArgs -> Bool
Eq, Int -> HttpArgs -> String -> String
[HttpArgs] -> String -> String
HttpArgs -> String
(Int -> HttpArgs -> String -> String)
-> (HttpArgs -> String)
-> ([HttpArgs] -> String -> String)
-> Show HttpArgs
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HttpArgs] -> String -> String
$cshowList :: [HttpArgs] -> String -> String
show :: HttpArgs -> String
$cshow :: HttpArgs -> String
showsPrec :: Int -> HttpArgs -> String -> String
$cshowsPrec :: Int -> HttpArgs -> String -> String
Show)

-- | 'sentry.interfaces.Http':
--   The Request information is stored in the Http interface.
--
--   Sentry will explicitly look for REMOTE_ADDR in env for things
--   which require an IP address.
--
--   The data variable should only contain the request body
--   (not the query string). It can either be a dictionary
--   (for standard HTTP requests) or a raw request body.
--
-- > import System.Log.RavenInterfaces as SI
-- > let upd = SI.http
-- >             "http://absolute.uri/foo"
-- >             "POST"
-- >             (SI.QueryArgs [("foo", "bar")])
-- >             (Just "hello=world")
-- >             (Just "foo=bar")
-- >             [("Content-Type", "text/html")]
-- >             [("REMOTE_ADDR", "127.1.0.1")]
http :: String             -- ^ URL
     -> String             -- ^ Method
     -> HttpArgs           -- ^ Arguments
     -> Maybe String       -- ^ Query string
     -> Maybe String       -- ^ Cookies
     -> [(String, String)] -- ^ Headers
     -> [(String, String)] -- ^ Environment
     -> SentryRecord       -- ^ Record to update
     -> SentryRecord
http :: String
-> String
-> HttpArgs
-> Maybe String
-> Maybe String
-> [(String, String)]
-> [(String, String)]
-> SentryRecord
-> SentryRecord
http String
url String
m HttpArgs
args Maybe String
q Maybe String
c [(String, String)]
hs [(String, String)]
env = String -> HashMap String Value -> SentryRecord -> SentryRecord
forall v. ToJSON v => String -> v -> SentryRecord -> SentryRecord
interface String
"sentry.interfaces.Http" HashMap String Value
info
    where
        info :: HashMap String Value
info = [[(String, Value)]] -> HashMap String Value
fields [ String
"url" String -> String -> [(String, Value)]
forall v. ToJSON v => String -> v -> [(String, Value)]
.=: String
url
                      , String
"method" String -> String -> [(String, Value)]
forall v. ToJSON v => String -> v -> [(String, Value)]
.=: String
m
                      , HttpArgs -> [(String, Value)]
fromHttpArgs HttpArgs
args
                      , String -> Maybe String -> [(String, Value)]
forall v. ToJSON v => String -> Maybe v -> [(String, Value)]
fromMaybe String
"query_string" Maybe String
q
                      , String -> Maybe String -> [(String, Value)]
forall v. ToJSON v => String -> Maybe v -> [(String, Value)]
fromMaybe String
"cookies" Maybe String
c
                      , String -> [(String, String)] -> [(String, Value)]
fromAssoc String
"headers" [(String, String)]
hs
                      , String -> [(String, String)] -> [(String, Value)]
fromAssoc String
"env" [(String, String)]
env
                      ]

        fromHttpArgs :: HttpArgs -> [(String, Value)]
fromHttpArgs HttpArgs
EmptyArgs = []
        fromHttpArgs (RawArgs String
s) = String
"data" String -> String -> [(String, Value)]
forall v. ToJSON v => String -> v -> [(String, Value)]
.=: String
s
        fromHttpArgs (QueryArgs [(String, String)]
kvs) = String
"data" String -> HashMap String String -> [(String, Value)]
forall v. ToJSON v => String -> v -> [(String, Value)]
.=: [(String, String)] -> HashMap String String
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(String, String)]
kvs

-- | 'sentry.interfaces.User':
--   An interface which describes the authenticated User for a request.
--
-- > let upd = SI.user "unique_id" [ ("username", "my_user")
-- >                               , ("email", "foo@example.com") ]
user :: String             -- ^ User's unique identifier
     -> [(String, String)] -- ^ Optional user data
     -> SentryRecord       -- ^ Record to update
     -> SentryRecord
user :: String -> [(String, String)] -> SentryRecord -> SentryRecord
user String
uid [(String, String)]
kwargs = String -> HashMap String String -> SentryRecord -> SentryRecord
forall v. ToJSON v => String -> v -> SentryRecord -> SentryRecord
interface String
"sentry.interfaces.User" HashMap String String
info
    where
        info :: HashMap String String
info = [(String, String)] -> HashMap String String
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, String)] -> HashMap String String)
-> [(String, String)] -> HashMap String String
forall a b. (a -> b) -> a -> b
$ (String
"id", String
uid) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
kwargs

-- | 'sentry.interfaces.Query':
--   A SQL query with an optional string describing the SQL driver, engine.
query :: Maybe String -- ^ SQL Driver
      -> String       -- ^ Query
      -> SentryRecord -- ^ Record to update
      -> SentryRecord
query :: Maybe String -> String -> SentryRecord -> SentryRecord
query Maybe String
d String
q = String -> HashMap String Value -> SentryRecord -> SentryRecord
forall v. ToJSON v => String -> v -> SentryRecord -> SentryRecord
interface String
"sentry.interfaces.Query" HashMap String Value
info
    where
        info :: HashMap String Value
info = [[(String, Value)]] -> HashMap String Value
fields [ String
"query" String -> String -> [(String, Value)]
forall v. ToJSON v => String -> v -> [(String, Value)]
.=: String
q
                      , String -> Maybe String -> [(String, Value)]
forall v. ToJSON v => String -> Maybe v -> [(String, Value)]
fromMaybe String
"engine" Maybe String
d
                      ]

-- | Generic interface helper.
interface :: (ToJSON v) => String -> v -> SentryRecord -> SentryRecord
interface :: String -> v -> SentryRecord -> SentryRecord
interface String
k v
v SentryRecord
rec =
    SentryRecord
rec { srInterfaces :: HashMap String Value
srInterfaces = String -> Value -> HashMap String Value -> HashMap String Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert String
k (v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v) (HashMap String Value -> HashMap String Value)
-> HashMap String Value -> HashMap String Value
forall a b. (a -> b) -> a -> b
$ SentryRecord -> HashMap String Value
srInterfaces SentryRecord
rec }

-- | JSON object with optional fields removed.
fields :: [[(String, Value)]] -> HM.HashMap String Value
fields :: [[(String, Value)]] -> HashMap String Value
fields = [(String, Value)] -> HashMap String Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Value)] -> HashMap String Value)
-> ([[(String, Value)]] -> [(String, Value)])
-> [[(String, Value)]]
-> HashMap String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(String, Value)]] -> [(String, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

-- | A mandatory field.
(.=:) :: (ToJSON v) => String -> v -> [(String, Value)]
String
k .=: :: String -> v -> [(String, Value)]
.=: v
v = [(String
k, v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v)]

-- | Optional simple field.
fromMaybe :: (ToJSON v) => String -> Maybe v -> [(String, Value)]
fromMaybe :: String -> Maybe v -> [(String, Value)]
fromMaybe String
k = [(String, Value)]
-> (v -> [(String, Value)]) -> Maybe v -> [(String, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\v
v -> [ (String
k, v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v) ])

-- | Optional dict-like field.
fromAssoc :: String -> [(String, String)] -> [(String, Value)]
fromAssoc :: String -> [(String, String)] -> [(String, Value)]
fromAssoc String
_ [] = []
fromAssoc String
k [(String, String)]
vs = [(String
k, HashMap String String -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap String String -> Value)
-> ([(String, String)] -> HashMap String String)
-> [(String, String)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> HashMap String String
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, String)] -> Value) -> [(String, String)] -> Value
forall a b. (a -> b) -> a -> b
$ [(String, String)]
vs)]