module Patrol.Client where

import qualified Control.Monad.Catch as Catch
import qualified Control.Monad.IO.Class as IO
import qualified Data.Aeson as Aeson
import qualified Network.HTTP.Client as Client
import qualified Patrol.Exception.Problem as Problem
import qualified Patrol.Type.Dsn as Dsn
import qualified Patrol.Type.Event as Event
import qualified Patrol.Type.Response as Response

store ::
  (IO.MonadIO io, Catch.MonadThrow io) =>
  Client.Manager ->
  Dsn.Dsn ->
  Event.Event ->
  io Response.Response
store :: forall (io :: * -> *).
(MonadIO io, MonadThrow io) =>
Manager -> Dsn -> Event -> io Response
store Manager
manager Dsn
dsn Event
event = do
  Request
request <- Dsn -> Event -> io Request
forall (m :: * -> *). MonadThrow m => Dsn -> Event -> m Request
Event.intoRequest Dsn
dsn Event
event
  Response ByteString
response <- IO (Response ByteString) -> io (Response ByteString)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO (Response ByteString) -> io (Response ByteString))
-> IO (Response ByteString) -> io (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager
  (String -> io Response)
-> (Response -> io Response)
-> Either String Response
-> io Response
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Problem -> io Response
forall e a. (HasCallStack, Exception e) => e -> io a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (Problem -> io Response)
-> (String -> Problem) -> String -> io Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Problem
Problem.Problem (String -> Problem) -> (String -> String) -> String -> Problem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. Monoid a => a -> a -> a
mappend String
"invalid response body: ") Response -> io Response
forall a. a -> io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either String Response -> io Response)
-> (ByteString -> Either String Response)
-> ByteString
-> io Response
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 Response) -> ByteString -> io Response
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response