http-client 0.5.7.0 → 0.5.7.1
raw patch · 14 files changed
+61/−214 lines, 14 filesdep ~network
Dependency ranges changed: network
Files
- ChangeLog.md +5/−0
- Network/HTTP/Client.hs +9/−3
- Network/HTTP/Client/Core.hs +1/−4
- Network/HTTP/Client/Headers.hs +1/−1
- Network/HTTP/Client/Manager.hs +1/−15
- Network/HTTP/Client/MultipartFormData.hs +1/−1
- Network/HTTP/Client/Request.hs +6/−14
- Network/HTTP/Client/Response.hs +10/−0
- Network/HTTP/Client/Util.hs +1/−155
- Network/HTTP/Proxy.hs +12/−7
- http-client.cabal +2/−2
- test-nonet/Network/HTTP/Client/RequestSpec.hs +2/−1
- test-nonet/Network/HTTP/ClientSpec.hs +7/−7
- test/Network/HTTP/ClientSpec.hs +3/−4
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.5.7.1++* Code cleanup/delete dead code+* Compat with Win32 2.6 [#309](https://github.com/snoyberg/http-client/issues/309)+ ## 0.5.7.0 * Support for Windows system proxy settings
Network/HTTP/Client.hs view
@@ -236,8 +236,8 @@ -- -- Since 0.4.1 responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader)-responseOpenHistory req0 man0 = handle (throwIO . toHttpException req0) $ do- reqRef <- newIORef req0+responseOpenHistory reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do+ reqRef <- newIORef reqOrig historyRef <- newIORef id let go req0 = do (man, req) <- getModifiedRequestManager man0 req0@@ -257,7 +257,7 @@ body <- brReadSome (responseBody res) 1024 modifyIORef historyRef (. ((req, res { responseBody = body }):)) return (res, req'', True)- (_, res) <- httpRedirect' (redirectCount req0) go req0+ (_, res) <- httpRedirect' (redirectCount reqOrig) go reqOrig reqFinal <- readIORef reqRef history <- readIORef historyRef return HistoriedResponse@@ -323,6 +323,7 @@ -- > import Network.HTTP.Client -- > import Network.HTTP.Types.Status (statusCode) -- > import Data.Aeson (object, (.=), encode)+-- > import Data.Text (Text) -- > -- > main :: IO () -- > main = do@@ -330,6 +331,11 @@ -- > -- > -- Create the request -- > let requestObject = object ["name" .= "Michael", "age" .= 30]+-- > let requestObject = object+-- > [ "name" .= ("Michael" :: Text)+-- > , "age" .= (30 :: Int)+-- > ]+ -- > initialRequest <- parseRequest "http://httpbin.org/post" -- > let request = initialRequest { method = "POST", requestBody = RequestBodyLBS $ encode requestObject } -- >
Network/HTTP/Client/Core.hs view
@@ -14,9 +14,6 @@ , httpRedirect' ) where -#if !MIN_VERSION_base(4,6,0)-import Prelude hiding (catch)-#endif import Network.HTTP.Types import Network.HTTP.Client.Manager import Network.HTTP.Client.Types@@ -250,7 +247,7 @@ -- The connection may already be closed, e.g. -- when using withResponseHistory. See -- https://github.com/snoyberg/http-client/issues/169- `catch` \se ->+ `Control.Exception.catch` \se -> case () of () | Just ConnectionClosed <-
Network/HTTP/Client/Headers.hs view
@@ -12,7 +12,7 @@ import qualified Data.CaseInsensitive as CI import Network.HTTP.Client.Connection import Network.HTTP.Client.Types-import Network.HTTP.Client.Util (timeout)+import System.Timeout (timeout) import Network.HTTP.Types import Data.Word (Word8)
Network/HTTP/Client/Manager.hs view
@@ -22,23 +22,13 @@ , dropProxyAuthSecure ) where -#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif-#if !MIN_VERSION_base(4,6,0)-import Prelude hiding (catch)-#endif-import Control.Applicative ((<|>))-import Control.Arrow (first) import qualified Data.IORef as I import qualified Data.Map as Map import qualified Data.ByteString.Char8 as S8 -import Data.Char (toLower) import Data.Text (Text) import qualified Data.Text as T-import Data.Text.Read (decimal) import Control.Monad (unless, join, void) import Control.Exception (mask_, catch, throwIO, fromException, mask, IOException, Exception (..), handle)@@ -52,12 +42,8 @@ import Network.HTTP.Client.Types import Network.HTTP.Client.Connection import Network.HTTP.Client.Headers (parseStatusHeaders)-import Network.HTTP.Client.Request (applyBasicProxyAuth, extractBasicAuthInfo) import Network.HTTP.Proxy import Control.Concurrent.MVar (MVar, takeMVar, tryPutMVar, newEmptyMVar)-import System.Environment (getEnvironment)-import qualified Network.URI as U-import Control.Monad (guard) -- | A value for the @managerRawConnection@ setting, but also allows you to -- modify the underlying @Socket@ to set additional settings. For a motivating@@ -325,7 +311,7 @@ {-# DEPRECATED withManager "Use newManager instead" #-} safeConnClose :: Connection -> IO ()-safeConnClose ci = connectionClose ci `catch` \(_ :: IOException) -> return ()+safeConnClose ci = connectionClose ci `Control.Exception.catch` \(_ :: IOException) -> return () nonEmptyMapM_ :: Monad m => (a -> m ()) -> NonEmptyList a -> m () nonEmptyMapM_ f (One x _) = f x
Network/HTTP/Client/MultipartFormData.hs view
@@ -10,7 +10,7 @@ -- > -- > import Control.Monad -- >--- > main = withSocketsDo $ void $ withManager defaultManagerSettings $ \m -> do+-- > main = void $ withManager defaultManagerSettings $ \m -> do -- > req1 <- parseRequest "http://random-cat-photo.net/cat.jpg" -- > res <- httpLbs req1 m -- > req2 <- parseRequest "http://example.org/~friedrich/blog/addPost.hs"
Network/HTTP/Client/Request.hs view
@@ -32,7 +32,7 @@ import Data.Int (Int64) import Data.Maybe (fromMaybe, isJust, isNothing)-import Data.Monoid (mempty, mappend)+import Data.Monoid (mempty, mappend, (<>)) import Data.String (IsString(..)) import Data.Char (toLower) import Control.Applicative as A ((<$>))@@ -103,14 +103,16 @@ -- space, e.g.: -- -- @@@--- parseRequeset "POST http://httpbin.org/post"+-- parseRequest "POST http://httpbin.org/post" -- @@@ -- -- Note that the request method must be provided as all capital letters. -- -- 'Request' created by this function won't cause exceptions on non-2XX--- response status codes.+-- response status codes. --+-- To create a request which throws on non-2XX status codes, see 'parseUrlThrow'+-- -- @since 0.4.30 parseRequest :: MonadThrow m => String -> m Request parseRequest s' =@@ -138,17 +140,7 @@ -- | 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-setUriRelative req uri =-#ifndef MIN_VERSION_network-#define MIN_VERSION_network(x,y,z) 1-#endif-#if MIN_VERSION_network(2,4,0)- setUri req $ uri `relativeTo` getUri req-#else- case uri `relativeTo` getUri req of- Just uri' -> setUri req uri'- Nothing -> throwM $ InvalidUrlException (show uri) "Invalid URL"-#endif+setUriRelative req uri = setUri req $ uri `relativeTo` getUri req -- | Extract a 'URI' from the request. --
Network/HTTP/Client/Response.hs view
@@ -8,6 +8,7 @@ , lbsResponse ) where +import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L @@ -119,3 +120,12 @@ , responseCookieJar = Data.Monoid.mempty , responseClose' = ResponseClose (cleanup False) }++-- | Does this response have no body?+hasNoBody :: ByteString -- ^ request method+ -> Int -- ^ status code+ -> Bool+hasNoBody "HEAD" _ = True+hasNoBody _ 204 = True+hasNoBody _ 304 = True+hasNoBody _ i = 100 <= i && i < 200
Network/HTTP/Client/Util.hs view
@@ -5,169 +5,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Network.HTTP.Client.Util- ( hGetSome- , (<>)- , readDec- , hasNoBody- , fromStrict- , timeout+ ( readDec ) where -import Data.Monoid (Monoid, mappend)--import qualified Data.ByteString.Char8 as S8--#ifndef MIN_VERSION_bytestring-#define MIN_VERSION_bytestring(x,y,z) 1-#endif--#if MIN_VERSION_bytestring(0,10,0)-import Data.ByteString.Lazy (fromStrict)-#else-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString as S-#endif- import qualified Data.Text as T import qualified Data.Text.Read-import System.Timeout (timeout) -#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif-#if MIN_VERSION_base(4,3,0)-import Data.ByteString (hGetSome)-#else-import GHC.IO.Handle.Types-import System.IO (hWaitForInput, hIsEOF)-import System.IO.Error (mkIOError, illegalOperationErrorType)---- | Like 'hGet', except that a shorter 'ByteString' may be returned--- if there are not enough bytes immediately available to satisfy the--- whole request. 'hGetSome' only blocks if there is no data--- available, and EOF has not yet been reached.-hGetSome :: Handle -> Int -> IO S.ByteString-hGetSome hh i- | i > 0 = let- loop = do- s <- S.hGetNonBlocking hh i- if not (S.null s)- then return s- else do eof <- hIsEOF hh- if eof then return s- else hWaitForInput hh (-1) >> loop- -- for this to work correctly, the- -- Handle should be in binary mode- -- (see GHC ticket #3808)- in loop- | i == 0 = return S.empty- | otherwise = illegalBufferSize hh "hGetSome" i--illegalBufferSize :: Handle -> String -> Int -> IO a-illegalBufferSize handle fn sz =- ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)- --TODO: System.IO uses InvalidArgument here, but it's not exported :-(- where- msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []-#endif--infixr 5 <>-(<>) :: Data.Monoid.Monoid m => m -> m -> m-(<>) = Data.Monoid.mappend- readDec :: Integral i => String -> Maybe i readDec s = case Data.Text.Read.decimal $ T.pack s of Right (i, t) | T.null t -> Just i _ -> Nothing--hasNoBody :: S8.ByteString -- ^ request method- -> Int -- ^ status code- -> Bool-hasNoBody "HEAD" _ = True-hasNoBody _ 204 = True-hasNoBody _ 304 = True-hasNoBody _ i = 100 <= i && i < 200--#if !MIN_VERSION_bytestring(0,10,0)-{-# INLINE fromStrict #-}-fromStrict :: S.ByteString -> L.ByteString-fromStrict x = L.fromChunks [x]-#endif---- Disabling the custom timeout code for now. See: https://github.com/snoyberg/http-client/issues/116-{--data TimeoutHandler = TimeoutHandler {-# UNPACK #-} !TimeSpec (IO ())-newtype TimeoutManager = TimeoutManager (IORef ([TimeoutHandler], Bool))--newTimeoutManager :: IO TimeoutManager-newTimeoutManager = fmap TimeoutManager $ newIORef ([], False)--timeoutManager :: TimeoutManager-timeoutManager = unsafePerformIO newTimeoutManager-{-# NOINLINE timeoutManager #-}--spawnWorker :: TimeoutManager -> IO ()-spawnWorker (TimeoutManager ref) = void $ forkIO $ fix $ \loop -> do- threadDelay 500000- join $ atomicModifyIORef ref $ \(hs, isCleaning) -> assert (not isCleaning) $- if null hs- then (([], False), return ())- else (([], True), ) $ do- now <- getTime Monotonic- front <- go now id hs- atomicModifyIORef ref $ \(hs', isCleaning') ->- assert isCleaning' $ ((front hs', False), ())- loop- where- go now =- go'- where- go' front [] = return front- go' front (h@(TimeoutHandler time action):hs)- | time < now = do- _ :: Either SomeException () <- try action- go' front hs- | otherwise = go' (front . (h:)) hs--addHandler :: TimeoutManager -> TimeoutHandler -> IO ()-addHandler man@(TimeoutManager ref) h = mask_ $ join $ atomicModifyIORef ref- $ \(hs, isCleaning) ->- let hs' = h : hs- action- | isCleaning || not (null hs) = return ()- | otherwise = spawnWorker man- in ((hs', isCleaning), action)---- | Has same semantics as @System.Timeout.timeout@, but implemented in such a--- way to avoid high-concurrency contention issues. See:------ https://github.com/snoyberg/http-client/issues/98-timeout :: Int -> IO a -> IO (Maybe a)-timeout delayU inner = do- TimeSpec nowS nowN <- getTime Monotonic- let (delayS, delayU') = delayU `quotRem` 1000000- delayN = delayU' * 1000- stopN' = nowN + delayN- stopS' = nowS + delayS- (stopN, stopS)- | stopN' > 1000000000 = (stopN' - 1000000000, stopS' + 1)- | otherwise = (stopN', stopS')- toStop = TimeSpec stopS stopN- toThrow <- newIORef True- tid <- myThreadId- let handler = TimeoutHandler toStop $ do- toThrow' <- readIORef toThrow- when toThrow' $ throwTo tid TimeoutTriggered- eres <- try $ do- addHandler timeoutManager handler- inner `finally` writeIORef toThrow False- return $ case eres of- Left TimeoutTriggered -> Nothing- Right x -> Just x--data TimeoutTriggered = TimeoutTriggered- deriving (Show, Typeable)-instance Exception TimeoutTriggered--}
Network/HTTP/Proxy.hs view
@@ -56,7 +56,7 @@ httpProtocol, ProxySettings ) where -import Control.Applicative ((<$>), (<|>))+import qualified Control.Applicative as A import Control.Arrow (first) import Control.Monad (guard) import qualified Data.ByteString.Char8 as S8@@ -99,8 +99,8 @@ show HTTPProxy = "http" show HTTPSProxy = "https" -data ProxySettings = ProxySettings { proxyHost :: Proxy,- proxyAuth :: Maybe (UserName, Password) }+data ProxySettings = ProxySettings { _proxyHost :: Proxy,+ _proxyAuth :: Maybe (UserName, Password) } deriving Show httpProtocol :: Bool -> ProxyProtocol@@ -114,7 +114,7 @@ headJust :: [Maybe a] -> Maybe a headJust [] = Nothing headJust (Nothing:xs) = headJust xs-headJust ((y@(Just x)):_) = y+headJust ((y@(Just _)):_) = y systemProxyHelper :: Maybe T.Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request) systemProxyHelper envOveride prot eh = do@@ -171,11 +171,16 @@ registryProxyString :: IO (Maybe (String, String)) registryProxyString = catch (bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do- enable <- toBool . maybe 0 id <$> regQueryValueDWORD hkey "ProxyEnable"+ enable <- toBool . maybe 0 id A.<$> regQueryValueDWORD hkey "ProxyEnable" if enable then do+#if MIN_VERSION_Win32(2, 6, 0)+ server <- regQueryValue hkey "ProxyServer"+ exceptions <- try $ regQueryValue hkey "ProxyOverride" :: IO (Either IOException String)+#else server <- regQueryValue hkey (Just "ProxyServer") exceptions <- try $ regQueryValue hkey (Just "ProxyOverride") :: IO (Either IOException String)+#endif return $ Just (server, either (const "") id exceptions) else return Nothing) hideError where@@ -318,7 +323,7 @@ regQueryValueDWORD hkey name = alloca $ \ptr -> do key <- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD)) if key == rEG_DWORD then- Just <$> peek ptr+ Just A.<$> peek ptr else return Nothing -- defined(mingw32_HOST_OS)@@ -332,7 +337,7 @@ envHelper name = do env <- getEnvironment let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env- lookupEnvVar n = lookup (T.unpack n) env <|> Map.lookup n lenv+ lookupEnvVar n = lookup (T.unpack n) env A.<|> Map.lookup n lenv noProxyDomains = domainSuffixes (lookupEnvVar "no_proxy") case lookupEnvVar name of
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.5.7.0+version: 0.5.7.1 synopsis: An HTTP client engine description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client@@ -42,7 +42,7 @@ , http-types >= 0.8 , blaze-builder >= 0.3 , time >= 1.2- , network >= 2.3+ , network >= 2.4 , streaming-commons >= 0.1.0.2 && < 0.2 , containers , transformers
test-nonet/Network/HTTP/Client/RequestSpec.hs view
@@ -7,8 +7,9 @@ import Data.IORef import Data.Maybe (isJust, fromMaybe, fromJust) import Network.HTTP.Client.Internal-import Network.URI (URI(..), URIAuth(..), parseURI) +import Network.URI (URI(..), URIAuth(..), parseURI) import Test.Hspec+import Data.Monoid ((<>)) spec :: Spec spec = do
test-nonet/Network/HTTP/ClientSpec.hs view
@@ -12,7 +12,7 @@ import qualified Network.HTTP.Client as NC import qualified Network.HTTP.Client.Internal as Internal import Network.HTTP.Types (status413)-import Network.Socket (sClose)+import qualified Network.Socket as NS import Test.Hspec import qualified Data.Streaming.Network as N import qualified Data.ByteString as S@@ -32,7 +32,7 @@ redirectServer :: (Int -> IO a) -> IO a redirectServer inner = bracket (N.bindRandomPortTCP "*4")- (sClose . snd)+ (NS.close . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port)@@ -48,7 +48,7 @@ redirectCloseServer :: (Int -> IO a) -> IO a redirectCloseServer inner = bracket (N.bindRandomPortTCP "*4")- (sClose . snd)+ (NS.close . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port)@@ -63,7 +63,7 @@ -> (Int -> IO a) -> IO a bad100Server extraHeaders inner = bracket (N.bindRandomPortTCP "*4")- (sClose . snd)+ (NS.close . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port)@@ -81,7 +81,7 @@ earlyClose413 :: (Int -> IO a) -> IO a earlyClose413 inner = bracket (N.bindRandomPortTCP "*4")- (sClose . snd)+ (NS.close . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port)@@ -112,7 +112,7 @@ serveWith :: S.ByteString -> (Int -> IO a) -> IO a serveWith resp inner = bracket (N.bindRandomPortTCP "*4")- (sClose . snd)+ (NS.close . snd) $ \(port, lsocket) -> withAsync (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port)@@ -165,7 +165,7 @@ _ -> False it "connecting to missing server gives nice error message" $ do (port, socket) <- N.bindRandomPortTCP "*4"- sClose socket+ NS.close socket req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port man <- newManager defaultManagerSettings httpLbs req man `shouldThrow` \e ->
test/Network/HTTP/ClientSpec.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.ClientSpec where -import Network (withSocketsDo) import qualified Data.ByteString.Char8 as BS import Network.HTTP.Client import Network.HTTP.Client.Internal@@ -16,20 +15,20 @@ spec :: Spec spec = describe "Client" $ do- it "works" $ withSocketsDo $ do+ it "works" $ do req <- parseUrlThrow "http://httpbin.org/" man <- newManager defaultManagerSettings res <- httpLbs req man responseStatus res `shouldBe` status200 describe "method in URL" $ do- it "success" $ withSocketsDo $ do+ it "success" $ do req <- parseUrlThrow "POST http://httpbin.org/post" man <- newManager defaultManagerSettings res <- httpLbs req man responseStatus res `shouldBe` status200 - it "failure" $ withSocketsDo $ do+ it "failure" $ do req <- parseRequest "PUT http://httpbin.org/post" man <- newManager defaultManagerSettings res <- httpLbs req man