{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Simple
(
httpBS
, httpLBS
, httpNoBody
#ifdef VERSION_aeson
, httpJSON
, httpJSONEither
#endif
, httpSink
, httpSource
, withResponse
, H.Header
, H.Query
, H.QueryItem
, H.Request
, H.RequestHeaders
, H.Response
, H.ResponseHeaders
#ifdef VERSION_aeson
, JSONException (..)
#endif
, H.HttpException (..)
, H.Proxy (..)
, H.defaultRequest
, H.parseRequest
, H.parseRequest_
, parseRequestThrow
, parseRequestThrow_
, setRequestMethod
, setRequestSecure
, setRequestHost
, setRequestPort
, setRequestPath
, addRequestHeader
, getRequestHeader
, setRequestHeader
, setRequestHeaders
, setRequestQueryString
, getRequestQueryString
, addToRequestQueryString
, setRequestBody
#ifdef VERSION_aeson
, setRequestBodyJSON
#endif
, setRequestBodyLBS
, setRequestBodySource
, setRequestBodyFile
, setRequestBodyURLEncoded
, H.setRequestIgnoreStatus
, H.setRequestCheckStatus
, setRequestBasicAuth
#if MIN_VERSION_http_client(0,7,6)
, setRequestBearerAuth
#endif
, setRequestManager
, setRequestProxy
, setRequestResponseTimeout
, getResponseStatus
, getResponseStatusCode
, getResponseHeader
, getResponseHeaders
, getResponseBody
, httpLbs
) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Network.HTTP.Client as H
import qualified Network.HTTP.Client.Internal as HI
import qualified Network.HTTP.Client.TLS as H
import Network.HTTP.Client.Conduit (bodyReaderSource)
import qualified Network.HTTP.Client.Conduit as HC
import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
#ifdef VERSION_aeson
import Data.Aeson (FromJSON (..), Value)
import Data.Aeson.Parser (json')
import qualified Data.Aeson.Types as A
import qualified Data.Aeson as A
#endif
import qualified Data.Traversable as T
import Control.Exception (throw, throwIO, Exception)
import Data.Monoid
import Data.Typeable (Typeable)
import qualified Data.Conduit as C
import Data.Conduit (runConduit, (.|), ConduitM)
import qualified Data.Conduit.Attoparsec as C
import qualified Network.HTTP.Types as H
import Data.Int (Int64)
import Control.Monad.Trans.Resource (MonadResource, MonadThrow)
import qualified Control.Exception as E (bracket)
import Data.Void (Void)
import qualified Data.Attoparsec.ByteString as Atto
import qualified Data.Attoparsec.ByteString.Char8 as Atto8
httpBS :: MonadIO m => H.Request -> m (H.Response S.ByteString)
httpBS :: forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpBS Request
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Manager
man <- IO Manager
H.getGlobalManager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
L.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Request -> Manager -> IO (Response ByteString)
H.httpLbs Request
req Manager
man
httpLBS :: MonadIO m => H.Request -> m (H.Response L.ByteString)
httpLBS :: forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS Request
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Manager
man <- IO Manager
H.getGlobalManager
Request -> Manager -> IO (Response ByteString)
H.httpLbs Request
req Manager
man
httpNoBody :: MonadIO m => H.Request -> m (H.Response ())
httpNoBody :: forall (m :: * -> *). MonadIO m => Request -> m (Response ())
httpNoBody Request
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Manager
man <- IO Manager
H.getGlobalManager
Request -> Manager -> IO (Response ())
H.httpNoBody Request
req Manager
man
#ifdef VERSION_aeson
httpJSON :: (MonadIO m, FromJSON a) => H.Request -> m (H.Response a)
httpJSON :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON Request
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either JSONException a))
httpJSONEither Request
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return)
httpJSONEither :: (MonadIO m, FromJSON a)
=> H.Request
-> m (H.Response (Either JSONException a))
httpJSONEither :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either JSONException a))
httpJSONEither Request
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitM ByteString Void m a) -> m a
httpSink Request
req' forall {m :: * -> *} {b} {o}.
(Monad m, FromJSON b) =>
Response ()
-> ConduitT ByteString o m (Response (Either JSONException b))
sink
where
req' :: Request
req' = HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
H.hAccept ByteString
"application/json" Request
req
sink :: Response ()
-> ConduitT ByteString o m (Response (Either JSONException b))
sink Response ()
orig = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Either JSONException b
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Either JSONException b
x) Response ()
orig) forall a b. (a -> b) -> a -> b
$ do
Either ParseError Value
eres1 <- forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Parser a b -> ConduitT a o m (Either ParseError b)
C.sinkParserEither (Parser ByteString Value
json' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString ()
Atto8.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall t. Chunk t => Parser t ()
Atto.endOfInput))
case Either ParseError Value
eres1 of
Left ParseError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Request -> Response () -> ParseError -> JSONException
JSONParseException Request
req' Response ()
orig ParseError
e
Right Value
value ->
case forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
A.Error String
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Request -> Response Value -> String -> JSONException
JSONConversionException
Request
req' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Value
value) Response ()
orig) String
e
A.Success b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
x
data JSONException
= JSONParseException H.Request (H.Response ()) C.ParseError
| JSONConversionException H.Request (H.Response Value) String
deriving (Int -> JSONException -> ShowS
[JSONException] -> ShowS
JSONException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONException] -> ShowS
$cshowList :: [JSONException] -> ShowS
show :: JSONException -> String
$cshow :: JSONException -> String
showsPrec :: Int -> JSONException -> ShowS
$cshowsPrec :: Int -> JSONException -> ShowS
Show, Typeable)
instance Exception JSONException
#endif
httpSink :: MonadUnliftIO m
=> H.Request
-> (H.Response () -> ConduitM S.ByteString Void m a)
-> m a
httpSink :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitM ByteString Void m a) -> m a
httpSink Request
req Response () -> ConduitM ByteString Void m a
sink = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
Manager
man <- IO Manager
H.getGlobalManager
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
(Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man)
forall a. Response a -> IO ()
H.responseClose
forall a b. (a -> b) -> a -> b
$ \Response BodyReader
res -> forall a. m a -> IO a
run
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource (forall a. Response a -> a
getResponseBody Response BodyReader
res)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Response () -> ConduitM ByteString Void m a
sink (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) Response BodyReader
res)
httpSource :: (MonadResource m, MonadIO n)
=> H.Request
-> (H.Response (C.ConduitM i S.ByteString n ())
-> C.ConduitM i o m r)
-> C.ConduitM i o m r
httpSource :: forall (m :: * -> *) (n :: * -> *) i o r.
(MonadResource m, MonadIO n) =>
Request
-> (Response (ConduitM i ByteString n ()) -> ConduitM i o m r)
-> ConduitM i o m r
httpSource Request
req Response (ConduitM i ByteString n ()) -> ConduitM i o m r
withRes = do
Manager
man <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
H.getGlobalManager
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
C.bracketP (Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man) forall a. Response a -> IO ()
H.responseClose
(Response (ConduitM i ByteString n ()) -> ConduitM i o m r
withRes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource)
withResponse :: (MonadUnliftIO m, MonadIO n)
=> H.Request
-> (H.Response (C.ConduitM i S.ByteString n ()) -> m a)
-> m a
withResponse :: forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a
withResponse Request
req Response (ConduitM i ByteString n ()) -> m a
withRes = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
Manager
man <- IO Manager
H.getGlobalManager
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
(Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man)
forall a. Response a -> IO ()
H.responseClose
(forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (ConduitM i ByteString n ()) -> m a
withRes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource)
parseRequestThrow :: MonadThrow m => String -> m HC.Request
parseRequestThrow :: forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequestThrow = forall (m :: * -> *). MonadThrow m => String -> m Request
HC.parseUrlThrow
parseRequestThrow_ :: String -> HC.Request
parseRequestThrow_ :: String -> Request
parseRequestThrow_ = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => String -> m Request
HC.parseUrlThrow
httpLbs :: MonadIO m => H.Request -> m (H.Response L.ByteString)
httpLbs :: forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLbs = forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS
setRequestMethod :: S.ByteString -> H.Request -> H.Request
setRequestMethod :: ByteString -> Request -> Request
setRequestMethod ByteString
x Request
req = Request
req { method :: ByteString
H.method = ByteString
x }
setRequestSecure :: Bool -> H.Request -> H.Request
setRequestSecure :: Bool -> Request -> Request
setRequestSecure Bool
x Request
req = Request
req { secure :: Bool
H.secure = Bool
x }
setRequestHost :: S.ByteString -> H.Request -> H.Request
setRequestHost :: ByteString -> Request -> Request
setRequestHost ByteString
x Request
r = Request
r { host :: ByteString
H.host = ByteString
x }
setRequestPort :: Int -> H.Request -> H.Request
setRequestPort :: Int -> Request -> Request
setRequestPort Int
x Request
r = Request
r { port :: Int
H.port = Int
x }
setRequestPath :: S.ByteString -> H.Request -> H.Request
setRequestPath :: ByteString -> Request -> Request
setRequestPath ByteString
x Request
r = Request
r { path :: ByteString
H.path = ByteString
x }
addRequestHeader :: H.HeaderName -> S.ByteString -> H.Request -> H.Request
HeaderName
name ByteString
val Request
req =
Request
req { requestHeaders :: RequestHeaders
H.requestHeaders = (HeaderName
name, ByteString
val) forall a. a -> [a] -> [a]
: Request -> RequestHeaders
H.requestHeaders Request
req }
getRequestHeader :: H.HeaderName -> H.Request -> [S.ByteString]
HeaderName
name =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
x, ByteString
_) -> HeaderName
x forall a. Eq a => a -> a -> Bool
== HeaderName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> RequestHeaders
H.requestHeaders
setRequestHeader :: H.HeaderName -> [S.ByteString] -> H.Request -> H.Request
HeaderName
name [ByteString]
vals Request
req =
Request
req { requestHeaders :: RequestHeaders
H.requestHeaders =
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
x, ByteString
_) -> HeaderName
x forall a. Eq a => a -> a -> Bool
/= HeaderName
name) (Request -> RequestHeaders
H.requestHeaders Request
req)
forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (HeaderName
name, ) [ByteString]
vals)
}
setRequestHeaders :: H.RequestHeaders -> H.Request -> H.Request
RequestHeaders
x Request
req = Request
req { requestHeaders :: RequestHeaders
H.requestHeaders = RequestHeaders
x }
getRequestQueryString :: H.Request -> H.Query
getRequestQueryString :: Request -> Query
getRequestQueryString = ByteString -> Query
H.parseQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
H.queryString
setRequestQueryString :: H.Query -> H.Request -> H.Request
setRequestQueryString :: Query -> Request -> Request
setRequestQueryString = Query -> Request -> Request
H.setQueryString
addToRequestQueryString :: H.Query -> H.Request -> H.Request
addToRequestQueryString :: Query -> Request -> Request
addToRequestQueryString Query
additions Request
req = Query -> Request -> Request
setRequestQueryString Query
q Request
req
where q :: Query
q = Query
additions forall a. Semigroup a => a -> a -> a
<> Request -> Query
getRequestQueryString Request
req
setRequestBody :: H.RequestBody -> H.Request -> H.Request
setRequestBody :: RequestBody -> Request -> Request
setRequestBody RequestBody
x Request
req = Request
req { requestBody :: RequestBody
H.requestBody = RequestBody
x }
#ifdef VERSION_aeson
setRequestBodyJSON :: A.ToJSON a => a -> H.Request -> H.Request
setRequestBodyJSON :: forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON a
x Request
req =
Request
req { requestHeaders :: RequestHeaders
H.requestHeaders
= (HeaderName
H.hContentType, ByteString
"application/json; charset=utf-8")
forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
y, ByteString
_) -> HeaderName
y forall a. Eq a => a -> a -> Bool
/= HeaderName
H.hContentType) (Request -> RequestHeaders
H.requestHeaders Request
req)
, requestBody :: RequestBody
H.requestBody = ByteString -> RequestBody
H.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode a
x
}
#endif
setRequestBodyLBS :: L.ByteString -> H.Request -> H.Request
setRequestBodyLBS :: ByteString -> Request -> Request
setRequestBodyLBS = RequestBody -> Request -> Request
setRequestBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RequestBody
H.RequestBodyLBS
setRequestBodySource :: Int64
-> ConduitM () S.ByteString IO ()
-> H.Request
-> H.Request
setRequestBodySource :: Int64 -> ConduitM () ByteString IO () -> Request -> Request
setRequestBodySource Int64
len ConduitM () ByteString IO ()
src Request
req = Request
req { requestBody :: RequestBody
H.requestBody = Int64 -> ConduitM () ByteString IO () -> RequestBody
HC.requestBodySource Int64
len ConduitM () ByteString IO ()
src }
setRequestBodyFile :: FilePath -> H.Request -> H.Request
setRequestBodyFile :: String -> Request -> Request
setRequestBodyFile = RequestBody -> Request -> Request
setRequestBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO RequestBody -> RequestBody
HI.RequestBodyIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO RequestBody
H.streamFile
setRequestBodyURLEncoded :: [(S.ByteString, S.ByteString)] -> H.Request -> H.Request
setRequestBodyURLEncoded :: [(ByteString, ByteString)] -> Request -> Request
setRequestBodyURLEncoded = [(ByteString, ByteString)] -> Request -> Request
H.urlEncodedBody
setRequestBasicAuth :: S.ByteString
-> S.ByteString
-> H.Request
-> H.Request
setRequestBasicAuth :: ByteString -> ByteString -> Request -> Request
setRequestBasicAuth = ByteString -> ByteString -> Request -> Request
H.applyBasicAuth
#if MIN_VERSION_http_client(0,7,6)
setRequestBearerAuth :: S.ByteString
-> H.Request
-> H.Request
setRequestBearerAuth :: ByteString -> Request -> Request
setRequestBearerAuth = ByteString -> Request -> Request
H.applyBearerAuth
#endif
setRequestManager :: H.Manager -> H.Request -> H.Request
setRequestManager :: Manager -> Request -> Request
setRequestManager Manager
x Request
req = Request
req { requestManagerOverride :: Maybe Manager
HI.requestManagerOverride = forall a. a -> Maybe a
Just Manager
x }
setRequestProxy :: Maybe H.Proxy -> H.Request -> H.Request
setRequestProxy :: Maybe Proxy -> Request -> Request
setRequestProxy Maybe Proxy
x Request
req = Request
req { proxy :: Maybe Proxy
H.proxy = Maybe Proxy
x }
setRequestResponseTimeout :: H.ResponseTimeout -> H.Request -> H.Request
setRequestResponseTimeout :: ResponseTimeout -> Request -> Request
setRequestResponseTimeout ResponseTimeout
x Request
req = Request
req { responseTimeout :: ResponseTimeout
H.responseTimeout = ResponseTimeout
x }
getResponseStatus :: H.Response a -> H.Status
getResponseStatus :: forall a. Response a -> Status
getResponseStatus = forall a. Response a -> Status
H.responseStatus
getResponseStatusCode :: H.Response a -> Int
getResponseStatusCode :: forall a. Response a -> Int
getResponseStatusCode = Status -> Int
H.statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Response a -> Status
getResponseStatus
getResponseHeader :: H.HeaderName -> H.Response a -> [S.ByteString]
HeaderName
name = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
x, ByteString
_) -> HeaderName
x forall a. Eq a => a -> a -> Bool
== HeaderName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> RequestHeaders
H.responseHeaders
getResponseHeaders :: H.Response a -> [(H.HeaderName, S.ByteString)]
= forall body. Response body -> RequestHeaders
H.responseHeaders
getResponseBody :: H.Response a -> a
getResponseBody :: forall a. Response a -> a
getResponseBody = forall a. Response a -> a
H.responseBody