module Patrol.Client
  ( store
  ) where

import qualified Data.Aeson as Aeson
import qualified Data.ByteString as ByteString
import qualified Data.CaseInsensitive as CI
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Time as Time
import qualified Data.Version as Version
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as Http
import qualified Paths_patrol as Package
import qualified Patrol.Type.Dsn as Dsn
import qualified Patrol.Type.Event as Event
import qualified Patrol.Type.EventId as EventId
import qualified Patrol.Type.Response as Response

-- | <https://develop.sentry.dev/sdk/store/>
store :: Client.Manager -> Dsn.Dsn -> Event.Event -> IO EventId.EventId
store :: Manager -> Dsn -> Event -> IO EventId
store Manager
manager Dsn
dsn Event
event = do
  UTCTime
now <- IO UTCTime
Time.getCurrentTime
  Request
request <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseUrlThrow (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Dsn -> String
makeUrl Dsn
dsn
  -- TODO: Compress request body.
  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request
    { requestBody :: RequestBody
Client.requestBody = ByteString -> RequestBody
Client.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Event -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Event
event
    , requestHeaders :: RequestHeaders
Client.requestHeaders =
      [ (HeaderName
Http.hContentType, String -> ByteString
utf8 String
"application/json")
      , (HeaderName
Http.hUserAgent, String -> ByteString
utf8 String
userAgent)
      , (ByteString -> HeaderName
forall a. FoldCase a => a -> CI a
ci (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ String -> ByteString
utf8 String
"X-Sentry-Auth", Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
',') ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
        [ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Sentry sentry_version=7"
        , Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String
"sentry_client=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
userAgent
        , Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String
"sentry_timestamp=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale String
"%s" UTCTime
now
        , Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"sentry_key=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dsn -> Text
Dsn.publicKey Dsn
dsn
        , (\ Text
x -> String -> Text
Text.pack String
"sentry_secret=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dsn -> Maybe Text
Dsn.secretKey Dsn
dsn
        ])
      ]
    , method :: ByteString
Client.method = ByteString
Http.methodPost
    } Manager
manager
  -- TODO: Handle 429 response codes.
  (String -> IO EventId)
-> (Response -> IO EventId) -> Either String Response -> IO EventId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO EventId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (EventId -> IO EventId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventId -> IO EventId)
-> (Response -> EventId) -> Response -> IO EventId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> EventId
Response.id_) (Either String Response -> IO EventId)
-> (ByteString -> Either String Response)
-> ByteString
-> IO EventId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Response
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> IO EventId) -> ByteString -> IO EventId
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response

makeUrl :: Dsn.Dsn -> String
makeUrl :: Dsn -> String
makeUrl Dsn
dsn =
  Text -> String
Text.unpack (Dsn -> Text
Dsn.protocol Dsn
dsn)
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"://"
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Dsn -> Text
Dsn.host Dsn
dsn)
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\ Text
x -> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
x) (Dsn -> Maybe Text
Dsn.port Dsn
dsn)
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Dsn -> Text
Dsn.path Dsn
dsn)
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"api/"
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Dsn -> Text
Dsn.projectId Dsn
dsn)
  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/store/"

utf8 :: String -> ByteString.ByteString
utf8 :: String -> ByteString
utf8 = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

ci :: CI.FoldCase a => a -> CI.CI a
ci :: a -> CI a
ci = a -> CI a
forall a. FoldCase a => a -> CI a
CI.mk

userAgent :: String
userAgent :: String
userAgent = String
"patrol/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Version -> String
Version.showVersion Version
Package.version