module Patrol.Type.Event where

import qualified Control.Monad.Catch as Catch
import qualified Control.Monad.IO.Class as IO
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Time as Time
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as Http
import qualified Patrol.Constant as Constant
import qualified Patrol.Extra.Aeson as Aeson
import qualified Patrol.Extra.List as List
import qualified Patrol.Type.Breadcrumbs as Breadcrumbs
import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo
import qualified Patrol.Type.Context as Context
import qualified Patrol.Type.DebugMeta as DebugMeta
import qualified Patrol.Type.Dsn as Dsn
import qualified Patrol.Type.EventId as EventId
import qualified Patrol.Type.EventProcessingError as EventProcessingError
import qualified Patrol.Type.EventType as EventType
import qualified Patrol.Type.Exceptions as Exceptions
import qualified Patrol.Type.Level as Level
import qualified Patrol.Type.LogEntry as LogEntry
import qualified Patrol.Type.Platform as Platform
import qualified Patrol.Type.Request as Request
import qualified Patrol.Type.Threads as Threads
import qualified Patrol.Type.TransactionInfo as TransactionInfo
import qualified Patrol.Type.User as User

-- | <https://develop.sentry.dev/sdk/event-payloads/types/#event>
data Event = Event
  { Event -> Maybe Breadcrumbs
breadcrumbs :: Maybe Breadcrumbs.Breadcrumbs,
    Event -> Map Text Context
contexts :: Map.Map Text.Text Context.Context,
    Event -> Maybe DebugMeta
debugMeta :: Maybe DebugMeta.DebugMeta,
    Event -> Text
dist :: Text.Text,
    Event -> Text
environment :: Text.Text,
    Event -> [EventProcessingError]
errors :: [EventProcessingError.EventProcessingError],
    Event -> EventId
eventId :: EventId.EventId,
    Event -> Maybe Exceptions
exception :: Maybe Exceptions.Exceptions,
    Event -> Map Text Value
extra :: Map.Map Text.Text Aeson.Value,
    Event -> [Text]
fingerprint :: [Text.Text],
    Event -> Maybe Level
level :: Maybe Level.Level,
    Event -> Maybe LogEntry
logentry :: Maybe LogEntry.LogEntry,
    Event -> Text
logger :: Text.Text,
    Event -> Map Text Text
modules :: Map.Map Text.Text Text.Text,
    Event -> Maybe Platform
platform :: Maybe Platform.Platform,
    Event -> Text
release :: Text.Text,
    Event -> Maybe Request
request :: Maybe Request.Request,
    Event -> Maybe ClientSdkInfo
sdk :: Maybe ClientSdkInfo.ClientSdkInfo,
    Event -> Text
serverName :: Text.Text,
    Event -> Map Text Text
tags :: Map.Map Text.Text Text.Text,
    Event -> Maybe Threads
threads :: Maybe Threads.Threads,
    Event -> Maybe NominalDiffTime
timeSpent :: Maybe Time.NominalDiffTime,
    Event -> Maybe UTCTime
timestamp :: Maybe Time.UTCTime,
    Event -> Text
transaction :: Text.Text,
    Event -> Maybe TransactionInfo
transactionInfo :: Maybe TransactionInfo.TransactionInfo,
    Event -> Maybe EventType
type_ :: Maybe EventType.EventType,
    Event -> Maybe User
user :: Maybe User.User,
    Event -> Text
version :: Text.Text
  }
  deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show)

instance Aeson.ToJSON Event where
  toJSON :: Event -> Value
toJSON Event
event =
    [Pair] -> Value
Aeson.intoObject
      [ String -> Maybe Breadcrumbs -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"breadcrumbs" (Maybe Breadcrumbs -> Pair) -> Maybe Breadcrumbs -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Breadcrumbs
breadcrumbs Event
event,
        String -> Map Text Context -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"contexts" (Map Text Context -> Pair) -> Map Text Context -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Map Text Context
contexts Event
event,
        String -> Maybe DebugMeta -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"debug_meta" (Maybe DebugMeta -> Pair) -> Maybe DebugMeta -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe DebugMeta
debugMeta Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"dist" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
dist Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"environment" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
environment Event
event,
        String -> [EventProcessingError] -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"errors" ([EventProcessingError] -> Pair) -> [EventProcessingError] -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> [EventProcessingError]
errors Event
event,
        String -> Maybe Exceptions -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"exception" (Maybe Exceptions -> Pair) -> Maybe Exceptions -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Exceptions
exception Event
event,
        String -> Map Text Value -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"extra" (Map Text Value -> Pair) -> Map Text Value -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Map Text Value
extra Event
event,
        String -> EventId -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"event_id" (EventId -> Pair) -> EventId -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> EventId
eventId Event
event,
        String -> [Text] -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"fingerprint" ([Text] -> Pair) -> [Text] -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> [Text]
fingerprint Event
event,
        String -> Maybe Level -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"level" (Maybe Level -> Pair) -> Maybe Level -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Level
level Event
event,
        String -> Maybe LogEntry -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"logentry" (Maybe LogEntry -> Pair) -> Maybe LogEntry -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe LogEntry
logentry Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"logger" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
logger Event
event,
        String -> Map Text Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"modules" (Map Text Text -> Pair) -> Map Text Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Map Text Text
modules Event
event,
        String -> Maybe Platform -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"platform" (Maybe Platform -> Pair) -> Maybe Platform -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Platform
platform Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"release" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
release Event
event,
        String -> Maybe Request -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"request" (Maybe Request -> Pair) -> Maybe Request -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Request
request Event
event,
        String -> Maybe ClientSdkInfo -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"sdk" (Maybe ClientSdkInfo -> Pair) -> Maybe ClientSdkInfo -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe ClientSdkInfo
sdk Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"server_name" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
serverName Event
event,
        String -> Map Text Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"tags" (Map Text Text -> Pair) -> Map Text Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Map Text Text
tags Event
event,
        String -> Maybe Threads -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"threads" (Maybe Threads -> Pair) -> Maybe Threads -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Threads
threads Event
event,
        String -> Maybe NominalDiffTime -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"time_spent" (Maybe NominalDiffTime -> Pair) -> Maybe NominalDiffTime -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe NominalDiffTime
timeSpent Event
event,
        String -> Maybe UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"timestamp" (Maybe UTCTime -> Pair) -> Maybe UTCTime -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe UTCTime
timestamp Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"transaction" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
transaction Event
event,
        String -> Maybe TransactionInfo -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"transaction_info" (Maybe TransactionInfo -> Pair) -> Maybe TransactionInfo -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe TransactionInfo
transactionInfo Event
event,
        String -> Maybe EventType -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"type" (Maybe EventType -> Pair) -> Maybe EventType -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe EventType
type_ Event
event,
        String -> Maybe User -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"user" (Maybe User -> Pair) -> Maybe User -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Maybe User
user Event
event,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"version" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Event -> Text
version Event
event
      ]

empty :: Event
empty :: Event
empty =
  Event
    { breadcrumbs :: Maybe Breadcrumbs
breadcrumbs = Maybe Breadcrumbs
forall a. Maybe a
Nothing,
      contexts :: Map Text Context
contexts = Map Text Context
forall k a. Map k a
Map.empty,
      debugMeta :: Maybe DebugMeta
debugMeta = Maybe DebugMeta
forall a. Maybe a
Nothing,
      dist :: Text
dist = Text
Text.empty,
      environment :: Text
environment = Text
Text.empty,
      errors :: [EventProcessingError]
errors = [],
      eventId :: EventId
eventId = EventId
EventId.empty,
      exception :: Maybe Exceptions
exception = Maybe Exceptions
forall a. Maybe a
Nothing,
      extra :: Map Text Value
extra = Map Text Value
forall k a. Map k a
Map.empty,
      fingerprint :: [Text]
fingerprint = [],
      level :: Maybe Level
level = Maybe Level
forall a. Maybe a
Nothing,
      logentry :: Maybe LogEntry
logentry = Maybe LogEntry
forall a. Maybe a
Nothing,
      logger :: Text
logger = Text
Text.empty,
      modules :: Map Text Text
modules = Map Text Text
forall k a. Map k a
Map.empty,
      platform :: Maybe Platform
platform = Maybe Platform
forall a. Maybe a
Nothing,
      release :: Text
release = Text
Text.empty,
      request :: Maybe Request
request = Maybe Request
forall a. Maybe a
Nothing,
      sdk :: Maybe ClientSdkInfo
sdk = Maybe ClientSdkInfo
forall a. Maybe a
Nothing,
      serverName :: Text
serverName = Text
Text.empty,
      tags :: Map Text Text
tags = Map Text Text
forall k a. Map k a
Map.empty,
      threads :: Maybe Threads
threads = Maybe Threads
forall a. Maybe a
Nothing,
      timeSpent :: Maybe NominalDiffTime
timeSpent = Maybe NominalDiffTime
forall a. Maybe a
Nothing,
      timestamp :: Maybe UTCTime
timestamp = Maybe UTCTime
forall a. Maybe a
Nothing,
      transaction :: Text
transaction = Text
Text.empty,
      transactionInfo :: Maybe TransactionInfo
transactionInfo = Maybe TransactionInfo
forall a. Maybe a
Nothing,
      type_ :: Maybe EventType
type_ = Maybe EventType
forall a. Maybe a
Nothing,
      user :: Maybe User
user = Maybe User
forall a. Maybe a
Nothing,
      version :: Text
version = Text
Text.empty
    }

new :: (IO.MonadIO io) => io Event
new :: forall (io :: * -> *). MonadIO io => io Event
new = do
  EventId
theEventId <- io EventId
forall (io :: * -> *). MonadIO io => io EventId
EventId.random
  UTCTime
theTimestamp <- IO UTCTime -> io UTCTime
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO IO UTCTime
Time.getCurrentTime
  Event -> io Event
forall a. a -> io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Event
empty
      { environment = Text.pack "production",
        eventId = theEventId,
        level = Just Level.Error,
        platform = Just Platform.Haskell,
        timestamp = Just theTimestamp,
        type_ = Just EventType.Default,
        version = Constant.sentryVersion
      }

intoRequest :: (Catch.MonadThrow m) => Dsn.Dsn -> Event -> m Client.Request
intoRequest :: forall (m :: * -> *). MonadThrow m => Dsn -> Event -> m Request
intoRequest Dsn
dsn Event
event = do
  Request
theRequest <-
    String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseUrlThrow
      (String -> m Request) -> (Text -> String) -> Text -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
      (Text -> m Request) -> Text -> m Request
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Dsn -> Text
Dsn.protocol Dsn
dsn,
          String -> Text
Text.pack String
"://",
          Dsn -> Text
Dsn.host Dsn
dsn,
          Text -> (Natural -> Text) -> Maybe Natural -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty (String -> Text
Text.pack (String -> Text) -> (Natural -> String) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
':' ShowS -> (Natural -> String) -> Natural -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> String
forall a. Show a => a -> String
show) (Maybe Natural -> Text) -> Maybe Natural -> Text
forall a b. (a -> b) -> a -> b
$ Dsn -> Maybe Natural
Dsn.port Dsn
dsn,
          Dsn -> Text
Dsn.path Dsn
dsn,
          String -> Text
Text.pack String
"api/",
          Dsn -> Text
Dsn.projectId Dsn
dsn,
          String -> Text
Text.pack String
"/store/"
        ]
  let oldHeaders :: RequestHeaders
oldHeaders = Request -> RequestHeaders
Client.requestHeaders Request
theRequest
      authorization :: ByteString
authorization = Dsn -> ByteString
Dsn.intoAuthorization Dsn
dsn
      newHeaders :: RequestHeaders
newHeaders =
        [ (HeaderName
Http.hContentType, ByteString
Constant.applicationJson),
          (HeaderName
Http.hUserAgent, Text -> ByteString
Text.encodeUtf8 Text
Constant.userAgent),
          (HeaderName
Constant.xSentryAuth, ByteString
authorization)
        ]
  Request -> m Request
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Request
theRequest
      { Client.method = Http.methodPost,
        Client.requestBody = Client.RequestBodyBS . LazyByteString.toStrict $ Aeson.encode event,
        Client.requestHeaders = List.insertAll newHeaders oldHeaders
      }