-- | HTTPS-capable transport using http-conduit.

{-# LANGUAGE OverloadedStrings #-}
module System.Log.Raven.Transport.HttpConduit
    ( sendRecord
    , sendRecordWith
    ) where

import Control.Monad.Trans (MonadIO, liftIO)
import Control.Monad.Trans.Resource (runResourceT)
import Network.HTTP.Conduit
import qualified Data.ByteString.Char8 as BS

import System.Log.Raven
import System.Log.Raven.Types

sendRecord :: SentrySettings -> SentryRecord -> IO ()
sendRecord :: SentrySettings -> SentryRecord -> IO ()
sendRecord SentrySettings
conf SentryRecord
rec = do
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Manager -> SentrySettings -> SentryRecord -> ResourceT IO ()
forall (m :: * -> *).
MonadIO m =>
Manager -> SentrySettings -> SentryRecord -> m ()
sendRecordWith Manager
manager SentrySettings
conf SentryRecord
rec

sendRecordWith :: MonadIO m => Manager -> SentrySettings -> SentryRecord -> m ()
sendRecordWith :: Manager -> SentrySettings -> SentryRecord -> m ()
sendRecordWith Manager
manager SentrySettings
conf SentryRecord
rec = do
    let ep :: Maybe String
ep = SentrySettings -> Maybe String
endpointURL SentrySettings
conf
    let auth :: String
auth = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Sentry sentry_version=2.0"
                      , String
", sentry_client=raven-haskell-0.1.0.0"
                      , String
", sentry_key=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SentrySettings -> String
sentryPublicKey SentrySettings
conf
                      , String
", sentry_secret=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SentrySettings -> String
sentryPrivateKey SentrySettings
conf
                      ]
    case Maybe String
ep of
        Maybe String
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
url -> do
            Request
req' <- IO Request -> m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request) -> IO Request -> m Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url
            let req :: Request
req = Request
req' { method :: Method
method = Method
"POST"
                           , requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"X-Sentry-Auth", String -> Method
BS.pack String
auth)]
                           , requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (SentryRecord -> ByteString
recordLBS SentryRecord
rec)
                           }
            Response ByteString
_ <- Request -> Manager -> m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
req Manager
manager
            () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()