{-# LANGUAGE OverloadedStrings, ViewPatterns #-}

-- | Internal representation of event record and related facilities.
--   Keep this under a pillow when writing custom wrappers.

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)

-- * Service settings

-- | Sentry client settings parsed from a DSN.
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)

-- | Transforms a service DSN into a settings. Format is:
--
-- > {PROTOCOL}://{PUBLIC_KEY}:{SECRET_KEY}@{HOST}{PATH}/{PROJECT_ID}
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

-- | Assemble http endpoint URL from settings.
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/"]

-- * Logging service

-- | Misc settings packaged for easier operations.
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 ())
                                   }

-- * Log entry

-- | Sentry log levels. Custom levels should be configured in Sentry or sending messages will fail.
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

-- | Event packet to be sent. See detailed field descriptions in
--   <https://docs.sentry.io/clientdev/attributes/>
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
                                 , SentryRecord -> HashMap String Value
srExtra       :: 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)

-- | Initialize a record with all required fields filled in.
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
        ]