{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
module System.Log.Raven.Types
( SentrySettings(..), fromDSN, endpointURL
, SentryService(..)
, SentryLevel(..), SentryRecord(..), newRecord
) where
import Data.Aeson (ToJSON(toJSON), Value, object, (.=))
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Data.String (fromString)
import Data.Time.Clock (UTCTime)
data SentrySettings = SentryDisabled
| SentrySettings { SentrySettings -> String
sentryURI :: !String
, SentrySettings -> String
sentryPublicKey :: !String
, SentrySettings -> String
sentryPrivateKey :: !String
, SentrySettings -> String
sentryProjectId :: !String
} deriving (Int -> SentrySettings -> ShowS
[SentrySettings] -> ShowS
SentrySettings -> String
(Int -> SentrySettings -> ShowS)
-> (SentrySettings -> String)
-> ([SentrySettings] -> ShowS)
-> Show SentrySettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentrySettings] -> ShowS
$cshowList :: [SentrySettings] -> ShowS
show :: SentrySettings -> String
$cshow :: SentrySettings -> String
showsPrec :: Int -> SentrySettings -> ShowS
$cshowsPrec :: Int -> SentrySettings -> ShowS
Show, ReadPrec [SentrySettings]
ReadPrec SentrySettings
Int -> ReadS SentrySettings
ReadS [SentrySettings]
(Int -> ReadS SentrySettings)
-> ReadS [SentrySettings]
-> ReadPrec SentrySettings
-> ReadPrec [SentrySettings]
-> Read SentrySettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SentrySettings]
$creadListPrec :: ReadPrec [SentrySettings]
readPrec :: ReadPrec SentrySettings
$creadPrec :: ReadPrec SentrySettings
readList :: ReadS [SentrySettings]
$creadList :: ReadS [SentrySettings]
readsPrec :: Int -> ReadS SentrySettings
$creadsPrec :: Int -> ReadS SentrySettings
Read, SentrySettings -> SentrySettings -> Bool
(SentrySettings -> SentrySettings -> Bool)
-> (SentrySettings -> SentrySettings -> Bool) -> Eq SentrySettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentrySettings -> SentrySettings -> Bool
$c/= :: SentrySettings -> SentrySettings -> Bool
== :: SentrySettings -> SentrySettings -> Bool
$c== :: SentrySettings -> SentrySettings -> Bool
Eq)
fromDSN :: String -> SentrySettings
fromDSN :: String -> SentrySettings
fromDSN String
"" = SentrySettings
SentryDisabled
fromDSN dsn :: String
dsn@((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') -> String
proto)
| String
proto String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"http" = String -> (String, String) -> SentrySettings
forall a. String -> (a, String) -> SentrySettings
makeSettings String
"http" ((String, String) -> SentrySettings)
-> (String -> (String, String)) -> String -> SentrySettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
7 (String -> SentrySettings) -> String -> SentrySettings
forall a b. (a -> b) -> a -> b
$ String
dsn
| String
proto String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"https" = String -> (String, String) -> SentrySettings
forall a. String -> (a, String) -> SentrySettings
makeSettings String
"https" ((String, String) -> SentrySettings)
-> (String -> (String, String)) -> String -> SentrySettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
8 (String -> SentrySettings) -> String -> SentrySettings
forall a b. (a -> b) -> a -> b
$ String
dsn
| Bool
otherwise = String -> SentrySettings
forall a. HasCallStack => String -> a
error (String -> SentrySettings) -> String -> SentrySettings
forall a b. (a -> b) -> a -> b
$ String
"fromDSN: unknown protocol (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
proto String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
where
body :: String -> (String, String)
body = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@')
keys :: String -> (String, String)
keys = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (String -> (String, String)) -> ShowS -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
body
pub :: ShowS
pub = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
keys
priv :: ShowS
priv = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
keys
stuff :: String -> (String, String)
stuff = (String, String) -> (String, String)
forall a a. ([a], [a]) -> ([a], [a])
stuff' ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (String -> (String, String)) -> ShowS -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
body
stuff' :: ([a], [a]) -> ([a], [a])
stuff' ([a]
a, [a]
b) = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
b, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
a)
uri :: ShowS
uri = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
stuff
pid :: ShowS
pid = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
stuff
assemble :: String -> ShowS
assemble String
pref String
s = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
pref, String
"://", ShowS
uri String
s]
makeSettings :: String -> (a, String) -> SentrySettings
makeSettings String
pref (a
_, String
s) = SentrySettings -> SentrySettings
verify (SentrySettings -> SentrySettings)
-> SentrySettings -> SentrySettings
forall a b. (a -> b) -> a -> b
$! String -> String -> String -> String -> SentrySettings
SentrySettings (String -> ShowS
assemble String
pref String
s) (ShowS
pub String
s) (ShowS
priv String
s) (ShowS
pid String
s)
verify :: SentrySettings -> SentrySettings
verify (SentrySettings -> String
sentryURI -> String
"") = String -> SentrySettings
forall a. HasCallStack => String -> a
error String
"Empty URI"
verify (SentrySettings -> String
sentryPublicKey -> String
"") = String -> SentrySettings
forall a. HasCallStack => String -> a
error String
"Empty public key"
verify (SentrySettings -> String
sentryProjectId -> String
"") = String -> SentrySettings
forall a. HasCallStack => String -> a
error String
"Empty project id"
verify SentrySettings
s = SentrySettings
s
endpointURL :: SentrySettings -> Maybe String
endpointURL :: SentrySettings -> Maybe String
endpointURL SentrySettings
SentryDisabled = Maybe String
forall a. Maybe a
Nothing
endpointURL (SentrySettings String
uri String
_ String
_ String
pid) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$! [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
uri, String
"api/", String
pid, String
"/store/"]
data SentryService = SentryService { SentryService -> SentrySettings
serviceSettings :: SentrySettings
, SentryService -> SentryRecord -> SentryRecord
serviceDefaults :: (SentryRecord -> SentryRecord)
, SentryService -> SentrySettings -> SentryRecord -> IO ()
serviceTransport :: (SentrySettings -> SentryRecord -> IO ())
, SentryService -> SentryRecord -> IO ()
serviceFallback :: (SentryRecord -> IO ())
}
data SentryLevel = Fatal
| Error
| Warning
| Info
| Debug
| Custom String
deriving (Int -> SentryLevel -> ShowS
[SentryLevel] -> ShowS
SentryLevel -> String
(Int -> SentryLevel -> ShowS)
-> (SentryLevel -> String)
-> ([SentryLevel] -> ShowS)
-> Show SentryLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentryLevel] -> ShowS
$cshowList :: [SentryLevel] -> ShowS
show :: SentryLevel -> String
$cshow :: SentryLevel -> String
showsPrec :: Int -> SentryLevel -> ShowS
$cshowsPrec :: Int -> SentryLevel -> ShowS
Show, ReadPrec [SentryLevel]
ReadPrec SentryLevel
Int -> ReadS SentryLevel
ReadS [SentryLevel]
(Int -> ReadS SentryLevel)
-> ReadS [SentryLevel]
-> ReadPrec SentryLevel
-> ReadPrec [SentryLevel]
-> Read SentryLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SentryLevel]
$creadListPrec :: ReadPrec [SentryLevel]
readPrec :: ReadPrec SentryLevel
$creadPrec :: ReadPrec SentryLevel
readList :: ReadS [SentryLevel]
$creadList :: ReadS [SentryLevel]
readsPrec :: Int -> ReadS SentryLevel
$creadsPrec :: Int -> ReadS SentryLevel
Read, SentryLevel -> SentryLevel -> Bool
(SentryLevel -> SentryLevel -> Bool)
-> (SentryLevel -> SentryLevel -> Bool) -> Eq SentryLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentryLevel -> SentryLevel -> Bool
$c/= :: SentryLevel -> SentryLevel -> Bool
== :: SentryLevel -> SentryLevel -> Bool
$c== :: SentryLevel -> SentryLevel -> Bool
Eq)
instance ToJSON SentryLevel where
toJSON :: SentryLevel -> Value
toJSON SentryLevel
Fatal = Value
"fatal"
toJSON SentryLevel
Error = Value
"error"
toJSON SentryLevel
Warning = Value
"warning"
toJSON SentryLevel
Info = Value
"info"
toJSON SentryLevel
Debug = Value
"debug"
toJSON (Custom String
s) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
s
type Assoc = HM.HashMap String String
data SentryRecord = SentryRecord { SentryRecord -> String
srEventId :: !String
, SentryRecord -> String
srMessage :: !String
, SentryRecord -> UTCTime
srTimestamp :: !UTCTime
, SentryRecord -> SentryLevel
srLevel :: !SentryLevel
, SentryRecord -> String
srLogger :: !String
, SentryRecord -> Maybe String
srPlatform :: Maybe String
, SentryRecord -> Maybe String
srCulprit :: Maybe String
, SentryRecord -> Assoc
srTags :: !Assoc
, SentryRecord -> Maybe String
srServerName :: Maybe String
, SentryRecord -> Assoc
srModules :: !Assoc
, :: HM.HashMap String Value
, SentryRecord -> HashMap String Value
srInterfaces :: HM.HashMap String Value
, SentryRecord -> Maybe String
srRelease :: Maybe String
, SentryRecord -> Maybe String
srEnvironment :: Maybe String
} deriving (Int -> SentryRecord -> ShowS
[SentryRecord] -> ShowS
SentryRecord -> String
(Int -> SentryRecord -> ShowS)
-> (SentryRecord -> String)
-> ([SentryRecord] -> ShowS)
-> Show SentryRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SentryRecord] -> ShowS
$cshowList :: [SentryRecord] -> ShowS
show :: SentryRecord -> String
$cshow :: SentryRecord -> String
showsPrec :: Int -> SentryRecord -> ShowS
$cshowsPrec :: Int -> SentryRecord -> ShowS
Show, SentryRecord -> SentryRecord -> Bool
(SentryRecord -> SentryRecord -> Bool)
-> (SentryRecord -> SentryRecord -> Bool) -> Eq SentryRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SentryRecord -> SentryRecord -> Bool
$c/= :: SentryRecord -> SentryRecord -> Bool
== :: SentryRecord -> SentryRecord -> Bool
$c== :: SentryRecord -> SentryRecord -> Bool
Eq)
newRecord :: String -> String -> UTCTime -> SentryLevel -> String -> SentryRecord
newRecord :: String
-> String -> UTCTime -> SentryLevel -> String -> SentryRecord
newRecord String
eid String
m UTCTime
t SentryLevel
lev String
logger =
String
-> String
-> UTCTime
-> SentryLevel
-> String
-> Maybe String
-> Maybe String
-> Assoc
-> Maybe String
-> Assoc
-> HashMap String Value
-> HashMap String Value
-> Maybe String
-> Maybe String
-> SentryRecord
SentryRecord
String
eid String
m UTCTime
t SentryLevel
lev String
logger
Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Assoc
forall k v. HashMap k v
HM.empty Maybe String
forall a. Maybe a
Nothing Assoc
forall k v. HashMap k v
HM.empty HashMap String Value
forall k v. HashMap k v
HM.empty HashMap String Value
forall k v. HashMap k v
HM.empty Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
instance ToJSON SentryRecord where
toJSON :: SentryRecord -> Value
toJSON SentryRecord
r = [Pair] -> Value
object ([Pair] -> Value) -> ([[Pair]] -> [Pair]) -> [[Pair]] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pair]] -> Value) -> [[Pair]] -> Value
forall a b. (a -> b) -> a -> b
$
[ [ Key
"event_id" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> String
srEventId SentryRecord
r
, Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> String
srMessage SentryRecord
r
, Key
"timestamp" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> UTCTime
srTimestamp SentryRecord
r
, Key
"level" Key -> SentryLevel -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> SentryLevel
srLevel SentryRecord
r
, Key
"logger" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> String
srLogger SentryRecord
r
]
, [Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
v -> [Key
"platform" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
v]) (Maybe String -> [Pair]) -> Maybe String -> [Pair]
forall a b. (a -> b) -> a -> b
$ SentryRecord -> Maybe String
srPlatform SentryRecord
r
, [Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
v -> [Key
"culprit" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
v]) (Maybe String -> [Pair]) -> Maybe String -> [Pair]
forall a b. (a -> b) -> a -> b
$ SentryRecord -> Maybe String
srCulprit SentryRecord
r
, if Assoc -> Bool
forall k v. HashMap k v -> Bool
HM.null (SentryRecord -> Assoc
srTags SentryRecord
r) then [] else [Key
"tags" Key -> Assoc -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> Assoc
srTags SentryRecord
r]
, [Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
v -> [Key
"server_name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
v]) (Maybe String -> [Pair]) -> Maybe String -> [Pair]
forall a b. (a -> b) -> a -> b
$ SentryRecord -> Maybe String
srServerName SentryRecord
r
, if Assoc -> Bool
forall k v. HashMap k v -> Bool
HM.null (SentryRecord -> Assoc
srModules SentryRecord
r) then [] else [Key
"modules" Key -> Assoc -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> Assoc
srModules SentryRecord
r]
, if HashMap String Value -> Bool
forall k v. HashMap k v -> Bool
HM.null (SentryRecord -> HashMap String Value
srExtra SentryRecord
r) then [] else [Key
"extra" Key -> HashMap String Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SentryRecord -> HashMap String Value
srExtra SentryRecord
r]
, if HashMap String Value -> Bool
forall k v. HashMap k v -> Bool
HM.null (SentryRecord -> HashMap String Value
srInterfaces SentryRecord
r) then
[]
else
[ String -> Key
forall a. IsString a => String -> a
fromString String
iface Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
stuff
| (String
iface, Value
stuff) <- HashMap String Value -> [(String, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap String Value -> [(String, Value)])
-> HashMap String Value -> [(String, Value)]
forall a b. (a -> b) -> a -> b
$ SentryRecord -> HashMap String Value
srInterfaces SentryRecord
r
]
, [Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
v -> [Key
"release" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
v]) (Maybe String -> [Pair]) -> Maybe String -> [Pair]
forall a b. (a -> b) -> a -> b
$ SentryRecord -> Maybe String
srRelease SentryRecord
r
, [Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
v -> [Key
"environment" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
v]) (Maybe String -> [Pair]) -> Maybe String -> [Pair]
forall a b. (a -> b) -> a -> b
$ SentryRecord -> Maybe String
srEnvironment SentryRecord
r
]