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