diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +## 0.4.28 + +* Add support for including request method in URL +* `requestManagerOverride` +* `RequestBodyIO` + ## 0.4.27.1 * Incorrect idle connection count in HTTP manager [#185](https://github.com/snoyberg/http-client/issues/185) diff --git a/Network/HTTP/Client.hs b/Network/HTTP/Client.hs --- a/Network/HTTP/Client.hs +++ b/Network/HTTP/Client.hs @@ -3,7 +3,20 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} --- | This is the main entry point for using http-client. Used by itself, this +-- | +-- +-- = Simpler API +-- +-- The API below is rather low-level. The @Network.HTTP.Simple@ module (from +-- the @http-conduit@ package) provides a higher-level API with built-in +-- support for things like JSON request and response bodies. For most users, +-- this will be an easier place to start. You can read the tutorial at: +-- +-- https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md +-- +-- = Lower-level API +-- +-- This is the main entry point for using http-client. Used by itself, this -- module provides low-level access for streaming request and response bodies, -- and only non-secure HTTP connections. Helper packages such as http-conduit -- provided higher level streaming approaches, while other helper packages like diff --git a/Network/HTTP/Client/Core.hs b/Network/HTTP/Client/Core.hs --- a/Network/HTTP/Client/Core.hs +++ b/Network/HTTP/Client/Core.hs @@ -163,13 +163,15 @@ -- -- Since 0.1.0 responseOpen :: Request -> Manager -> IO (Response BodyReader) -responseOpen req0 manager = handle addTlsHostPort $ mWrapIOException manager $ do +responseOpen req0 manager' = handle addTlsHostPort $ mWrapIOException manager $ do (req, res) <- if redirectCount req0 == 0 then httpRaw' req0 manager else go (redirectCount req0) req0 maybe (return res) throwIO =<< applyCheckStatus req (checkStatus req) res where + manager = fromMaybe manager' (requestManagerOverride req0) + addTlsHostPort (TlsException e) = throwIO $ TlsExceptionHostPort e (host req0) (port req0) addTlsHostPort e = throwIO e diff --git a/Network/HTTP/Client/Request.hs b/Network/HTTP/Client/Request.hs --- a/Network/HTTP/Client/Request.hs +++ b/Network/HTTP/Client/Request.hs @@ -64,6 +64,7 @@ import Data.IORef import System.IO (withBinaryFile, hTell, hFileSize, Handle, IOMode (ReadMode)) +import Control.Monad (liftM) -- | Convert a URL into a 'Request'. -- @@ -73,15 +74,33 @@ -- Since this function uses 'MonadThrow', the return monad can be anything that is -- an instance of 'MonadThrow', such as 'IO' or 'Maybe'. -- +-- You can place the request method at the beginning of the URL separated by a +-- space, e.g.: +-- +-- @@@ +-- parseUrl "POST http://httpbin.org/post" +-- @@@ +-- +-- Note that the request method must be provided as all capital letters. +-- -- Since 0.1.0 parseUrl :: MonadThrow m => String -> m Request -parseUrl s = +parseUrl s' = case parseURI (encode s) of - Just uri -> setUri def uri + Just uri -> liftM setMethod (setUri def uri) Nothing -> throwM $ InvalidUrlException s "Invalid URL" where encode = escapeURIString isAllowedInURI + (mmethod, s) = + case break (== ' ') s' of + (x, ' ':y) | all (\c -> 'A' <= c && c <= 'Z') x -> (Just x, y) + _ -> (Nothing, s') + setMethod req = + case mmethod of + Nothing -> req + Just m -> req { method = S8.pack m } + -- | Add a 'URI' to the request. If it is absolute (includes a host name), add -- it as per 'setUri'; if it is relative, merge it with the existing request. setUriRelative :: MonadThrow m => Request -> URI -> m Request @@ -240,6 +259,7 @@ case E.fromException se of Just (_ :: IOException) -> return () Nothing -> throwIO se + , requestManagerOverride = Nothing } instance IsString Request where @@ -318,50 +338,49 @@ && decompress req (fromMaybe "" $ lookup "content-type" hs') requestBuilder :: Request -> Connection -> IO (Maybe (IO ())) -requestBuilder req Connection {..} - | expectContinue = flushHeaders >> return (Just (checkBadSend sendLater)) - | otherwise = sendNow >> return Nothing +requestBuilder req Connection {..} = do + (contentLength, sendNow, sendLater) <- toTriple (requestBody req) + if expectContinue + then flushHeaders contentLength >> return (Just (checkBadSend sendLater)) + else sendNow >> return Nothing where expectContinue = Just "100-continue" == lookup "Expect" (requestHeaders req) checkBadSend f = f `E.catch` onRequestBodyException req writeBuilder = toByteStringIO connectionWrite - writeHeadersWith = writeBuilder . (builder `mappend`) - flushHeaders = writeHeadersWith flush - - (contentLength, sendNow, sendLater) = - case requestBody req of - RequestBodyLBS lbs -> - let body = fromLazyByteString lbs - now = checkBadSend $ writeHeadersWith body - later = writeBuilder body - in (Just (L.length lbs), now, later) - - RequestBodyBS bs -> - let body = fromByteString bs - now = checkBadSend $ writeHeadersWith body - later = writeBuilder body - in (Just (fromIntegral $ S.length bs), now, later) - - RequestBodyBuilder len body -> - let now = checkBadSend $ writeHeadersWith body - later = writeBuilder body - in (Just len, now, later) - - -- See https://github.com/snoyberg/http-client/issues/74 for usage - -- of flush here. - RequestBodyStream len stream -> - let body = writeStream False stream - -- Don't check for a bad send on the headers themselves. - -- Ideally, we'd do the same thing for the other request body - -- types, but it would also introduce a performance hit since - -- we couldn't merge request headers and bodies together. - now = flushHeaders >> checkBadSend body - in (Just len, now, body) + writeHeadersWith contentLength = writeBuilder . (builder contentLength `mappend`) + flushHeaders contentLength = writeHeadersWith contentLength flush - RequestBodyStreamChunked stream -> - let body = writeStream True stream - now = flushHeaders >> checkBadSend body - in (Nothing, now, body) + toTriple (RequestBodyLBS lbs) = do + let body = fromLazyByteString lbs + len = Just $ L.length lbs + now = checkBadSend $ writeHeadersWith len body + later = writeBuilder body + return (len, now, later) + toTriple (RequestBodyBS bs) = do + let body = fromByteString bs + len = Just $ fromIntegral $ S.length bs + now = checkBadSend $ writeHeadersWith len body + later = writeBuilder body + return (len, now, later) + toTriple (RequestBodyBuilder len body) = do + let now = checkBadSend $ writeHeadersWith (Just len) body + later = writeBuilder body + return (Just len, now, later) + toTriple (RequestBodyStream len stream) = do + -- See https://github.com/snoyberg/http-client/issues/74 for usage + -- of flush here. + let body = writeStream False stream + -- Don't check for a bad send on the headers themselves. + -- Ideally, we'd do the same thing for the other request body + -- types, but it would also introduce a performance hit since + -- we couldn't merge request headers and bodies together. + now = flushHeaders (Just len) >> checkBadSend body + return (Just len, now, body) + toTriple (RequestBodyStreamChunked stream) = do + let body = writeStream True stream + now = flushHeaders Nothing >> checkBadSend body + return (Nothing, now, body) + toTriple (RequestBodyIO mbody) = mbody >>= toTriple writeStream isChunked withStream = withStream loop @@ -413,14 +432,15 @@ Nothing -> ("Host", hh) : x Just{} -> x - headerPairs :: W.RequestHeaders - headerPairs = hostHeader + headerPairs :: Maybe Int64 -> W.RequestHeaders + headerPairs contentLength + = hostHeader $ acceptEncodingHeader $ contentLengthHeader contentLength $ requestHeaders req - builder :: Builder - builder = + builder :: Maybe Int64 -> Builder + builder contentLength = fromByteString (method req) <> fromByteString " " <> requestHostname @@ -441,7 +461,7 @@ <> foldr (\a b -> headerPairToBuilder a <> b) (fromByteString "\r\n") - headerPairs + (headerPairs contentLength) headerPairToBuilder (k, v) = fromByteString (CI.original k) diff --git a/Network/HTTP/Client/Types.hs b/Network/HTTP/Client/Types.hs --- a/Network/HTTP/Client/Types.hs +++ b/Network/HTTP/Client/Types.hs @@ -222,6 +222,11 @@ | RequestBodyBuilder Int64 Builder | RequestBodyStream Int64 (GivesPopper ()) | RequestBodyStreamChunked (GivesPopper ()) + | RequestBodyIO (IO RequestBody) + -- ^ Allows creation of a @RequestBody@ inside the @IO@ monad, which is + -- useful for making easier APIs (like @setRequestBodyFile@). + -- + -- @since 0.4.28 deriving T.Typeable -- | -- @@ -446,6 +451,13 @@ -- Default: ignore @IOException@s, rethrow all other exceptions. -- -- Since: 0.4.6 + + , requestManagerOverride :: Maybe Manager + -- ^ A 'Manager' value that should override whatever @Manager@ value was + -- passed in to the HTTP request function manually. This is useful when + -- dealing with implicit global managers, such as in @Network.HTTP.Simple@ + -- + -- @since 0.4.28 } deriving T.Typeable diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,16 @@ http-client =========== +Full tutorial docs are available at: +https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md + An HTTP client engine, intended as a base layer for more user-friendly packages. This codebase has been refactored from [http-conduit](http://www.stackage.org/package/http-conduit). + +Note that, if you want to make HTTPS secure connections, you should use +[http-client-tls](https://www.stackage.org/package/http-client-tls) in addition +to this library. Below is a series of cookbook recipes. A number of recipes exist elsewhere, including `Network.HTTP.Client` and `Network.HTTP.Conduit`. The goal is to diff --git a/http-client.cabal b/http-client.cabal --- a/http-client.cabal +++ b/http-client.cabal @@ -1,5 +1,5 @@ name: http-client -version: 0.4.27.1 +version: 0.4.28 synopsis: An HTTP client engine, intended as a base layer for more user-friendly packages. description: Hackage documentation generation is not reliable. For up to date documentation, please see: . homepage: https://github.com/snoyberg/http-client diff --git a/test/Network/HTTP/ClientSpec.hs b/test/Network/HTTP/ClientSpec.hs --- a/test/Network/HTTP/ClientSpec.hs +++ b/test/Network/HTTP/ClientSpec.hs @@ -4,7 +4,7 @@ import Control.Exception (toException) import Network (withSocketsDo) import Network.HTTP.Client -import Network.HTTP.Types (status200) +import Network.HTTP.Types (status200, status405) import Test.Hspec import Data.ByteString.Lazy.Char8 () -- orphan instance @@ -18,6 +18,22 @@ man <- newManager defaultManagerSettings res <- httpLbs req man responseStatus res `shouldBe` status200 + + describe "method in URL" $ do + it "success" $ withSocketsDo $ do + req <- parseUrl "POST http://httpbin.org/post" + man <- newManager defaultManagerSettings + res <- httpLbs req man + responseStatus res `shouldBe` status200 + + it "failure" $ withSocketsDo $ do + req' <- parseUrl "PUT http://httpbin.org/post" + let req = req' + { checkStatus = \_ _ _ -> Nothing + } + man <- newManager defaultManagerSettings + res <- httpLbs req man + responseStatus res `shouldBe` status405 it "managerModifyRequest" $ do let modify req = return req { port = 80 }