http-client 0.4.5 → 0.4.6

raw patch · 5 files changed

+75/−8 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Network/HTTP/Client/Request.hs +28/−6
• Network/HTTP/Client/Types.hs +7/−0
• http-client.cabal +1/−1
• test/Network/HTTP/ClientSpec.hs +33/−1

@@ -1,3 +1,9 @@+## 0.4.6++Add `onRequestBodyException` to `Request` to allow for recovering from+exceptions when sending the request. Most useful for servers which terminate+the connection after sending a response body without flushing the request body.+ ## 0.4.5  Add `openSocketConnectionSize` and increase default chunk size to 8192.

@@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -42,7 +43,8 @@ import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI)  import Control.Monad.IO.Class (liftIO)-import Control.Exception (Exception, toException, throw, throwIO)+import Control.Exception (Exception, toException, throw, throwIO, IOException)+import qualified Control.Exception as E import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Base64 as B64 @@ -53,6 +55,7 @@ import System.Timeout (timeout) import Data.Time.Clock import Control.Monad.Catch (MonadThrow, throwM)+import Data.IORef  -- | Convert a URL into a 'Request'. --@@ -205,6 +208,10 @@                                 else return (Just remainingTime, res)         , cookieJar = Just def         , requestVersion = W.http11+        , onRequestBodyException = \se ->+            case E.fromException se of+                Just (_ :: IOException) -> return ()+                Nothing -> throwIO se         }  instance IsString Request where@@ -286,18 +293,33 @@ requestBuilder req Connection {..} =     bodySource   where+    checkBadSend f = f `E.catch` onRequestBodyException req+     writeBuilder = toByteStringIO connectionWrite      (contentLength, bodySource) =         case requestBody req of-            RequestBodyLBS lbs -> (Just $ L.length lbs, writeBuilder $ builder `mappend` fromLazyByteString lbs)-            RequestBodyBS bs -> (Just $ fromIntegral $ S.length bs, writeBuilder $ builder `mappend` fromByteString bs)-            RequestBodyBuilder i b -> (Just $ i, writeBuilder $ builder `mappend` b)+            RequestBodyLBS lbs -> (Just $ L.length lbs,+                checkBadSend $ writeBuilder+                             $ builder `mappend` fromLazyByteString lbs)+            RequestBodyBS bs -> (Just $ fromIntegral $ S.length bs,+                checkBadSend $ writeBuilder+                             $ builder `mappend` fromByteString bs)+            RequestBodyBuilder i b -> (Just i,+                checkBadSend $ writeBuilder $ builder `mappend` b)              -- See https://github.com/snoyberg/http-client/issues/74 for usage             -- of flush here.-            RequestBodyStream i stream -> (Just i, writeBuilder (builder `mappend` flush) >> writeStream False stream)-            RequestBodyStreamChunked stream -> (Nothing, writeBuilder (builder `mappend` flush) >> writeStream True stream)+            RequestBodyStream i stream -> (Just i, do+                -- 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.+                writeBuilder (builder `mappend` flush)+                checkBadSend $ writeStream False stream)+            RequestBodyStreamChunked stream -> (Nothing, do+                writeBuilder (builder `mappend` flush)+                checkBadSend $ writeStream True stream)      writeStream isChunked withStream =         withStream loop

@@ -397,6 +397,13 @@     -- Default: HTTP 1.1     --     -- Since 0.4.3++    , onRequestBodyException :: SomeException -> IO ()+    -- ^ How to deal with exceptions thrown while sending the request.+    --+    -- Default: ignore @IOException@s, rethrow all other exceptions.+    --+    -- Since: 0.4.6     }     deriving T.Typeable 

@@ -1,5 +1,5 @@ name:                http-client-version:             0.4.5+version:             0.4.6 synopsis:            An HTTP client engine, intended as a base layer for more user-friendly packages. description:         This codebase has been refactored from http-conduit. homepage:            https://github.com/snoyberg/http-client

@@ -1,18 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.ClientSpec where +import           Blaze.ByteString.Builder  (fromByteString) import           Control.Concurrent        (forkIO, threadDelay) import           Control.Concurrent.Async  (withAsync) import           Control.Exception         (bracket) import           Control.Monad             (forever, replicateM_)+import           Data.Monoid               (mappend) import           Network                   (PortID (PortNumber), listenOn, withSocketsDo) import           Network.HTTP.Client-import           Network.HTTP.Types        (status200)+import           Network.HTTP.Types        (status200, status413) import           Network.Socket            (accept, sClose) import           Network.Socket.ByteString (recv, sendAll) import           Test.Hspec import qualified Data.Streaming.Network    as N import qualified Data.ByteString           as S+import qualified Data.ByteString.Lazy      as L import           Data.ByteString.Lazy.Char8 () -- orphan instance  main :: IO ()@@ -53,6 +56,24 @@                 ]             threadDelay 10000 +earlyClose413 :: (Int -> IO a) -> IO a+earlyClose413 inner = bracket+    (N.bindRandomPortTCP "*4")+    (sClose . snd)+    $ \(port, lsocket) -> withAsync+        (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)+        (const $ inner port)+  where+    app ad = do+        let readHeaders front = do+                newBS <- N.appRead ad+                let bs = S.append front newBS+                if "\r\n\r\n" `S.isInfixOf` bs+                    then return ()+                    else readHeaders bs+        readHeaders S.empty+        N.appWrite ad "HTTP/1.1 413 Too Large\r\ncontent-length: 7\r\n\r\ngoodbye"+ spec :: Spec spec = describe "Client" $ do     it "works" $ withSocketsDo $ do@@ -111,3 +132,14 @@         withManager settings $ \man -> do             res <- httpLbs "http://httpbin.org:1234" man             responseStatus res `shouldBe` status200++    it "early close on a 413" $ earlyClose413 $ \port' -> do+        withManager defaultManagerSettings $ \man -> do+            res <- flip httpLbs man "http://localhost"+                { port = port'+                , checkStatus = \_ _ _ -> Nothing+                , requestBody = RequestBodyStreamChunked+                    ($ return (S.replicate 100000 65))+                }+            responseBody res `shouldBe` "goodbye"+            responseStatus res `shouldBe` status413