{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Network.Wreq.Helper ( responseValue , responseMaybe , responseEither , responseEither' , responseEitherJSON , responseJSON , responseOk , responseOk_ , responseList , responseList_ , tryResponse , eitherToError ) where import Control.Exception (Exception, throwIO, try) import Control.Monad (unless) import Data.Aeson (FromJSON (..), decode, eitherDecode') import Data.Aeson.Result (Err, List, Ok, err, throwError, toList, toOk) import qualified Data.ByteString as B (break, isPrefixOf, isSuffixOf) import qualified Data.ByteString.Char8 as B (unpack) import qualified Data.ByteString.Lazy as LB (ByteString, fromStrict) import Data.Maybe (fromMaybe) import Data.Text (Text) import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), Response, responseBody, responseHeaders) data JSONError = JSONError String deriving (Int -> JSONError -> ShowS [JSONError] -> ShowS JSONError -> String (Int -> JSONError -> ShowS) -> (JSONError -> String) -> ([JSONError] -> ShowS) -> Show JSONError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [JSONError] -> ShowS $cshowList :: [JSONError] -> ShowS show :: JSONError -> String $cshow :: JSONError -> String showsPrec :: Int -> JSONError -> ShowS $cshowsPrec :: Int -> JSONError -> ShowS Show) instance Exception JSONError asJSON :: FromJSON a => Response LB.ByteString -> IO (Response a) asJSON :: Response ByteString -> IO (Response a) asJSON Response ByteString resp = do let contentType :: ByteString contentType = (ByteString, ByteString) -> ByteString forall a b. (a, b) -> a fst ((ByteString, ByteString) -> ByteString) -> (Response ByteString -> (ByteString, ByteString)) -> Response ByteString -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) B.break (Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool ==Word8 59) (ByteString -> (ByteString, ByteString)) -> (Response ByteString -> ByteString) -> Response ByteString -> (ByteString, ByteString) forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Maybe ByteString -> ByteString forall a. a -> Maybe a -> a fromMaybe ByteString "unknown" (Maybe ByteString -> ByteString) -> (Response ByteString -> Maybe ByteString) -> Response ByteString -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup HeaderName "Content-Type" ([(HeaderName, ByteString)] -> Maybe ByteString) -> (Response ByteString -> [(HeaderName, ByteString)]) -> Response ByteString -> Maybe ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . Response ByteString -> [(HeaderName, ByteString)] forall body. Response body -> [(HeaderName, ByteString)] responseHeaders (Response ByteString -> ByteString) -> Response ByteString -> ByteString forall a b. (a -> b) -> a -> b $ Response ByteString resp Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (ByteString "application/json" ByteString -> ByteString -> Bool `B.isPrefixOf` ByteString contentType Bool -> Bool -> Bool || (ByteString "application/" ByteString -> ByteString -> Bool `B.isPrefixOf` ByteString contentType Bool -> Bool -> Bool && ByteString "+json" ByteString -> ByteString -> Bool `B.isSuffixOf` ByteString contentType)) (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ JSONError -> IO () forall e a. Exception e => e -> IO a throwIO (JSONError -> IO ()) -> (String -> JSONError) -> String -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> JSONError JSONError (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "content type of response is " String -> ShowS forall a. [a] -> [a] -> [a] ++ ByteString -> String forall a. Show a => a -> String show ByteString contentType case ByteString -> Either String a forall a. FromJSON a => ByteString -> Either String a eitherDecode' (Response ByteString -> ByteString forall body. Response body -> body responseBody Response ByteString resp) of Left String e -> JSONError -> IO (Response a) forall e a. Exception e => e -> IO a throwIO (String -> JSONError JSONError String e) Right a val -> Response a -> IO (Response a) forall (m :: * -> *) a. Monad m => a -> m a return ((ByteString -> a) -> Response ByteString -> Response a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a -> ByteString -> a forall a b. a -> b -> a const a val) Response ByteString resp) eitherToError :: IO (Either Err a) -> IO a eitherToError :: IO (Either Err a) -> IO a eitherToError IO (Either Err a) io = do Either Err a r <- IO (Either Err a) io case Either Err a r of Left Err e -> Err -> IO a forall a. Err -> IO a throwError Err e Right a v -> a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure a v responseValue :: IO (Response a) -> IO a responseValue :: IO (Response a) -> IO a responseValue IO (Response a) req = Response a -> a forall body. Response body -> body responseBody (Response a -> a) -> IO (Response a) -> IO a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Response a) req responseMaybe :: IO (Response a) -> IO (Maybe a) responseMaybe :: IO (Response a) -> IO (Maybe a) responseMaybe IO (Response a) req = do Either HttpException (Response a) e <- IO (Response a) -> IO (Either HttpException (Response a)) forall e a. Exception e => IO a -> IO (Either e a) try IO (Response a) req case Either HttpException (Response a) e of Left (HttpException _ :: HttpException) -> Maybe a -> IO (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return Maybe a forall a. Maybe a Nothing Right Response a r -> Maybe a -> IO (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe a -> IO (Maybe a)) -> (a -> Maybe a) -> a -> IO (Maybe a) forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Maybe a forall a. a -> Maybe a Just (a -> IO (Maybe a)) -> a -> IO (Maybe a) forall a b. (a -> b) -> a -> b $ Response a -> a forall body. Response body -> body responseBody Response a r tryResponse :: IO (Response a) -> IO (Either Err (Response a)) tryResponse :: IO (Response a) -> IO (Either Err (Response a)) tryResponse IO (Response a) req = do Either HttpException (Response a) e <- IO (Response a) -> IO (Either HttpException (Response a)) forall e a. Exception e => IO a -> IO (Either e a) try IO (Response a) req case Either HttpException (Response a) e of Left (HttpExceptionRequest Request _ HttpExceptionContent content) -> case HttpExceptionContent content of (StatusCodeException Response () _ ByteString body) -> case ByteString -> Maybe Err forall a. FromJSON a => ByteString -> Maybe a decode (ByteString -> Maybe Err) -> (ByteString -> ByteString) -> ByteString -> Maybe Err forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString LB.fromStrict (ByteString -> Maybe Err) -> ByteString -> Maybe Err forall a b. (a -> b) -> a -> b $ ByteString body of Just Err er -> Either Err (Response a) -> IO (Either Err (Response a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Response a) -> IO (Either Err (Response a))) -> Either Err (Response a) -> IO (Either Err (Response a)) forall a b. (a -> b) -> a -> b $ Err -> Either Err (Response a) forall a b. a -> Either a b Left Err er Maybe Err Nothing -> Either Err (Response a) -> IO (Either Err (Response a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Response a) -> IO (Either Err (Response a))) -> (ByteString -> Either Err (Response a)) -> ByteString -> IO (Either Err (Response a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Err -> Either Err (Response a) forall a b. a -> Either a b Left (Err -> Either Err (Response a)) -> (ByteString -> Err) -> ByteString -> Either Err (Response a) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Err err (String -> Err) -> (ByteString -> String) -> ByteString -> Err forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> String B.unpack (ByteString -> IO (Either Err (Response a))) -> ByteString -> IO (Either Err (Response a)) forall a b. (a -> b) -> a -> b $ ByteString body HttpExceptionContent ResponseTimeout -> Either Err (Response a) -> IO (Either Err (Response a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Response a) -> IO (Either Err (Response a))) -> (String -> Either Err (Response a)) -> String -> IO (Either Err (Response a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Err -> Either Err (Response a) forall a b. a -> Either a b Left (Err -> Either Err (Response a)) -> (String -> Err) -> String -> Either Err (Response a) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Err err (String -> IO (Either Err (Response a))) -> String -> IO (Either Err (Response a)) forall a b. (a -> b) -> a -> b $ String "ResponseTimeout" HttpExceptionContent other -> Either Err (Response a) -> IO (Either Err (Response a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Response a) -> IO (Either Err (Response a))) -> (String -> Either Err (Response a)) -> String -> IO (Either Err (Response a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Err -> Either Err (Response a) forall a b. a -> Either a b Left (Err -> Either Err (Response a)) -> (String -> Err) -> String -> Either Err (Response a) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Err err (String -> IO (Either Err (Response a))) -> String -> IO (Either Err (Response a)) forall a b. (a -> b) -> a -> b $ HttpExceptionContent -> String forall a. Show a => a -> String show HttpExceptionContent other Left (InvalidUrlException String _ String _) -> Either Err (Response a) -> IO (Either Err (Response a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Response a) -> IO (Either Err (Response a))) -> (String -> Either Err (Response a)) -> String -> IO (Either Err (Response a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Err -> Either Err (Response a) forall a b. a -> Either a b Left (Err -> Either Err (Response a)) -> (String -> Err) -> String -> Either Err (Response a) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Err err (String -> IO (Either Err (Response a))) -> String -> IO (Either Err (Response a)) forall a b. (a -> b) -> a -> b $ String "InvalidUrlException" Right Response a r -> Either Err (Response a) -> IO (Either Err (Response a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Response a) -> IO (Either Err (Response a))) -> Either Err (Response a) -> IO (Either Err (Response a)) forall a b. (a -> b) -> a -> b $ Response a -> Either Err (Response a) forall a b. b -> Either a b Right Response a r responseEither :: IO (Response a) -> IO (Either Err a) responseEither :: IO (Response a) -> IO (Either Err a) responseEither IO (Response a) req = do Either Err (Response a) rsp <- IO (Response a) -> IO (Either Err (Response a)) forall a. IO (Response a) -> IO (Either Err (Response a)) tryResponse IO (Response a) req case Either Err (Response a) rsp of Left Err e -> Either Err a -> IO (Either Err a) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err a -> IO (Either Err a)) -> Either Err a -> IO (Either Err a) forall a b. (a -> b) -> a -> b $ Err -> Either Err a forall a b. a -> Either a b Left Err e Right Response a r -> Either Err a -> IO (Either Err a) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err a -> IO (Either Err a)) -> (a -> Either Err a) -> a -> IO (Either Err a) forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Either Err a forall a b. b -> Either a b Right (a -> IO (Either Err a)) -> a -> IO (Either Err a) forall a b. (a -> b) -> a -> b $ Response a -> a forall body. Response body -> body responseBody Response a r responseEither' :: IO (Response LB.ByteString) -> IO (Either Err ()) responseEither' :: IO (Response ByteString) -> IO (Either Err ()) responseEither' IO (Response ByteString) req = do Either Err (Response ByteString) rsp <- IO (Response ByteString) -> IO (Either Err (Response ByteString)) forall a. IO (Response a) -> IO (Either Err (Response a)) tryResponse IO (Response ByteString) req case Either Err (Response ByteString) rsp of Left Err e -> Either Err () -> IO (Either Err ()) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err () -> IO (Either Err ())) -> Either Err () -> IO (Either Err ()) forall a b. (a -> b) -> a -> b $ Err -> Either Err () forall a b. a -> Either a b Left Err e Right Response ByteString _ -> Either Err () -> IO (Either Err ()) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err () -> IO (Either Err ())) -> Either Err () -> IO (Either Err ()) forall a b. (a -> b) -> a -> b $ () -> Either Err () forall a b. b -> Either a b Right () responseEitherJSON :: FromJSON a => IO (Response LB.ByteString) -> IO (Either Err a) responseEitherJSON :: IO (Response ByteString) -> IO (Either Err a) responseEitherJSON IO (Response ByteString) req = IO (Response a) -> IO (Either Err a) forall a. IO (Response a) -> IO (Either Err a) responseEither (IO (Response a) -> IO (Either Err a)) -> IO (Response a) -> IO (Either Err a) forall a b. (a -> b) -> a -> b $ Response ByteString -> IO (Response a) forall a. FromJSON a => Response ByteString -> IO (Response a) asJSON (Response ByteString -> IO (Response a)) -> IO (Response ByteString) -> IO (Response a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO (Response ByteString) req responseJSON :: FromJSON a => IO (Response LB.ByteString) -> IO a responseJSON :: IO (Response ByteString) -> IO a responseJSON = IO (Either Err a) -> IO a forall a. IO (Either Err a) -> IO a eitherToError (IO (Either Err a) -> IO a) -> (IO (Response ByteString) -> IO (Either Err a)) -> IO (Response ByteString) -> IO a forall b c a. (b -> c) -> (a -> b) -> a -> c . IO (Response ByteString) -> IO (Either Err a) forall a. FromJSON a => IO (Response ByteString) -> IO (Either Err a) responseEitherJSON responseOk :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Either Err (Ok a)) responseOk :: Text -> IO (Response ByteString) -> IO (Either Err (Ok a)) responseOk Text okey IO (Response ByteString) req = do Either Err Value rsp <- IO (Response ByteString) -> IO (Either Err Value) forall a. FromJSON a => IO (Response ByteString) -> IO (Either Err a) responseEitherJSON IO (Response ByteString) req case Either Err Value rsp of Left Err e -> Either Err (Ok a) -> IO (Either Err (Ok a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Ok a) -> IO (Either Err (Ok a))) -> Either Err (Ok a) -> IO (Either Err (Ok a)) forall a b. (a -> b) -> a -> b $ Err -> Either Err (Ok a) forall a b. a -> Either a b Left Err e Right Value r -> case Text -> Value -> Maybe (Ok a) forall a. FromJSON a => Text -> Value -> Maybe (Ok a) toOk Text okey Value r of Just Ok a v -> Either Err (Ok a) -> IO (Either Err (Ok a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Ok a) -> IO (Either Err (Ok a))) -> Either Err (Ok a) -> IO (Either Err (Ok a)) forall a b. (a -> b) -> a -> b $ Ok a -> Either Err (Ok a) forall a b. b -> Either a b Right Ok a v Maybe (Ok a) Nothing -> Either Err (Ok a) -> IO (Either Err (Ok a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (Ok a) -> IO (Either Err (Ok a))) -> (Err -> Either Err (Ok a)) -> Err -> IO (Either Err (Ok a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Err -> Either Err (Ok a) forall a b. a -> Either a b Left (Err -> IO (Either Err (Ok a))) -> Err -> IO (Either Err (Ok a)) forall a b. (a -> b) -> a -> b $ String -> Err err String "Invalid Result" responseOk_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Ok a) responseOk_ :: Text -> IO (Response ByteString) -> IO (Ok a) responseOk_ Text okey IO (Response ByteString) req = IO (Either Err (Ok a)) -> IO (Ok a) forall a. IO (Either Err a) -> IO a eitherToError (Text -> IO (Response ByteString) -> IO (Either Err (Ok a)) forall a. FromJSON a => Text -> IO (Response ByteString) -> IO (Either Err (Ok a)) responseOk Text okey IO (Response ByteString) req) responseList :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (Either Err (List a)) responseList :: Text -> IO (Response ByteString) -> IO (Either Err (List a)) responseList Text okey IO (Response ByteString) req = do Either Err Value rsp <- IO (Response ByteString) -> IO (Either Err Value) forall a. FromJSON a => IO (Response ByteString) -> IO (Either Err a) responseEitherJSON IO (Response ByteString) req case Either Err Value rsp of Left Err e -> Either Err (List a) -> IO (Either Err (List a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (List a) -> IO (Either Err (List a))) -> Either Err (List a) -> IO (Either Err (List a)) forall a b. (a -> b) -> a -> b $ Err -> Either Err (List a) forall a b. a -> Either a b Left Err e Right Value r -> case Text -> Value -> Maybe (List a) forall a. FromJSON a => Text -> Value -> Maybe (List a) toList Text okey Value r of Just List a v -> Either Err (List a) -> IO (Either Err (List a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (List a) -> IO (Either Err (List a))) -> Either Err (List a) -> IO (Either Err (List a)) forall a b. (a -> b) -> a -> b $ List a -> Either Err (List a) forall a b. b -> Either a b Right List a v Maybe (List a) Nothing -> Either Err (List a) -> IO (Either Err (List a)) forall (m :: * -> *) a. Monad m => a -> m a return (Either Err (List a) -> IO (Either Err (List a))) -> (Err -> Either Err (List a)) -> Err -> IO (Either Err (List a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Err -> Either Err (List a) forall a b. a -> Either a b Left (Err -> IO (Either Err (List a))) -> Err -> IO (Either Err (List a)) forall a b. (a -> b) -> a -> b $ String -> Err err String "Invalid Result" responseList_ :: FromJSON a => Text -> IO (Response LB.ByteString) -> IO (List a) responseList_ :: Text -> IO (Response ByteString) -> IO (List a) responseList_ Text okey IO (Response ByteString) req = IO (Either Err (List a)) -> IO (List a) forall a. IO (Either Err a) -> IO a eitherToError (Text -> IO (Response ByteString) -> IO (Either Err (List a)) forall a. FromJSON a => Text -> IO (Response ByteString) -> IO (Either Err (List a)) responseList Text okey IO (Response ByteString) req)