Hello community,
here is the log from the commit of package ghc-http-conduit for
openSUSE:Factory checked in at 2017-03-21 22:48:25
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-http-conduit (Old)
and /work/SRC/openSUSE:Factory/.ghc-http-conduit.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-conduit"
Tue Mar 21 22:48:25 2017 rev:9 rq:476919 version:2.2.3.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-http-conduit/ghc-http-conduit.changes
2016-07-21 08:10:22.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-http-conduit.new/ghc-http-conduit.changes
2017-03-21 22:48:25.540312143 +0100
@@ -1,0 +2,10 @@
+Mon Feb 27 10:12:09 UTC 2017 - psim...@suse.com
+
+- Update to version 2.2.3.1 with cabal2obs.
+
+-------------------------------------------------------------------
+Sun Feb 12 14:20:42 UTC 2017 - psim...@suse.com
+
+- Update to version 2.2.3 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
http-conduit-2.1.11.tar.gz
New:
----
http-conduit-2.2.3.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-http-conduit.spec ++++++
--- /var/tmp/diff_new_pack.X6wllI/_old 2017-03-21 22:48:26.168223373 +0100
+++ /var/tmp/diff_new_pack.X6wllI/_new 2017-03-21 22:48:26.172222808 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-http-conduit
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,20 +19,18 @@
%global pkg_name http-conduit
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.1.11
+Version: 2.2.3.1
Release: 0
Summary: HTTP client package with conduit interface and HTTPS support
License: BSD-2-Clause
-Group: System/Libraries
+Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-aeson-devel
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-conduit-devel
BuildRequires: ghc-conduit-extra-devel
-BuildRequires: ghc-data-default-class-devel
BuildRequires: ghc-exceptions-devel
BuildRequires: ghc-http-client-devel
BuildRequires: ghc-http-client-tls-devel
@@ -50,6 +48,7 @@
BuildRequires: ghc-case-insensitive-devel
BuildRequires: ghc-connection-devel
BuildRequires: ghc-cookie-devel
+BuildRequires: ghc-data-default-class-devel
BuildRequires: ghc-hspec-devel
BuildRequires: ghc-network-devel
BuildRequires: ghc-streaming-commons-devel
@@ -62,7 +61,6 @@
BuildRequires: ghc-warp-devel
BuildRequires: ghc-warp-tls-devel
%endif
-# End cabal-rpm deps
%description
Hackage documentation generation is not reliable. For up to date documentation,
@@ -82,20 +80,14 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-
%build
%ghc_lib_build
-
%install
%ghc_lib_install
-
%check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
%post devel
%ghc_pkg_recache
++++++ http-conduit-2.1.11.tar.gz -> http-conduit-2.2.3.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/ChangeLog.md
new/http-conduit-2.2.3.1/ChangeLog.md
--- old/http-conduit-2.1.11/ChangeLog.md 2016-06-30 11:43:27.000000000
+0200
+++ new/http-conduit-2.2.3.1/ChangeLog.md 2017-02-26 15:40:36.000000000
+0100
@@ -1,3 +1,32 @@
+## 2.2.3.1
+
+* Minor README improvement
+
+## 2.2.3
+
+* Add `withResponse` to `Network.HTTP.Simple`
+
+## 2.2.2.1
+
+* setRequestBodyJSON works with aeson's toEncoding function (>= 0.11)
+ [#230](https://github.com/snoyberg/http-client/pull/230)
+
+## 2.2.2
+
+* Add `httpNoBody` to `Network.HTTP.Simple`
+
+## 2.2.1
+
+* Add `httpSource` to `Network.HTTP.Simple`
+
+## 2.2.0.1
+
+* Doc fixes
+
+## 2.2.0
+
+* Upgrade to http-client 0.5
+
## 2.1.11
* Switch to non-throwing behavior in `Network.HTTP.Simple`
[#193](https://github.com/snoyberg/http-client/issues/193)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/Network/HTTP/Client/Conduit.hs
new/http-conduit-2.2.3.1/Network/HTTP/Client/Conduit.hs
--- old/http-conduit-2.1.11/Network/HTTP/Client/Conduit.hs 2016-06-30
11:43:27.000000000 +0200
+++ new/http-conduit-2.2.3.1/Network/HTTP/Client/Conduit.hs 2016-12-19
16:29:45.000000000 +0100
@@ -6,7 +6,7 @@
-- For most users, "Network.HTTP.Simple" is probably a better choice. For more
-- information, see:
--
--- <https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md>.
+-- <https://haskell-lang.org/library/http-client>
--
-- For more information on using this module, please be sure to read the
-- documentation in the "Network.HTTP.Client" module.
@@ -49,7 +49,6 @@
newManager, responseClose,
responseOpen, withManager,
withResponse, BodyReader,
brRead, brConsume, httpNoBody)
-import Network.HTTP.Client (HasHttpManager(..))
import qualified Network.HTTP.Client as H
import Network.HTTP.Client.TLS (tlsManagerSettings)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/Network/HTTP/Conduit.hs
new/http-conduit-2.2.3.1/Network/HTTP/Conduit.hs
--- old/http-conduit-2.1.11/Network/HTTP/Conduit.hs 2016-06-30
11:43:27.000000000 +0200
+++ new/http-conduit-2.2.3.1/Network/HTTP/Conduit.hs 2016-12-19
16:29:45.000000000 +0100
@@ -11,7 +11,7 @@
-- 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
+-- <https://haskell-lang.org/library/http-client>
--
-- = Lower-level API
--
@@ -91,9 +91,13 @@
-- > request' <- parseRequest "http://example.com/secret-page";
-- > manager <- newManager tlsManagerSettings
-- > let request = request' { cookieJar = Just $ createCookieJar [cookie]
}
--- > (fmap Just (httpLbs request manager)) `E.catch`
--- > (\(StatusCodeException s _ _) ->
--- > if statusCode s==403 then (putStrLn "login failed" >>
return Nothing) else return Nothing)
+-- > fmap Just (httpLbs request manager) `E.catch`
+-- > (\ex -> case ex of
+-- > HttpExceptionRequest _ (StatusCodeException res _) ->
+-- > if statusCode (responseStatus res) == 403
+-- > then (putStrLn "login failed" >> return Nothing)
+-- > else return Nothing
+-- > _ -> E.throw ex)
--
-- Any network code on Windows requires some initialization, and the network
-- library provides withSocketsDo to perform it. Therefore, proper usage of
@@ -169,11 +173,10 @@
, rawBody
, decompress
, redirectCount
- , checkStatus
+ , checkResponse
, responseTimeout
, cookieJar
, requestVersion
- , getConnectionWrapper
, HCC.setQueryString
-- *** Request body
, requestBodySource
@@ -201,6 +204,11 @@
, managerConnCount
, managerResponseTimeout
, managerTlsConnection
+ -- ** Response timeout
+ , HC.ResponseTimeout
+ , HC.responseTimeoutMicro
+ , HC.responseTimeoutNone
+ , HC.responseTimeoutDefault
-- * Cookies
, Cookie(..)
, CookieJar
@@ -225,6 +233,7 @@
, urlEncodedBody
-- * Exceptions
, HttpException (..)
+ , HCC.HttpExceptionContent (..)
) where
import qualified Data.ByteString as S
@@ -234,12 +243,12 @@
import qualified Data.Conduit.List as CL
import Data.IORef (readIORef, writeIORef, newIORef)
import Data.Int (Int64)
-import Control.Applicative ((<$>))
-import Control.Exception.Lifted (bracket)
+import Control.Applicative as A ((<$>))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Resource
import qualified Network.HTTP.Client as Client (httpLbs,
responseOpen, responseClose)
+import qualified Network.HTTP.Client as HC
import qualified Network.HTTP.Client.Conduit as HCC
import Network.HTTP.Client.Internal (createCookieJar,
destroyCookieJar)
@@ -303,7 +312,7 @@
simpleHttp url = liftIO $ do
man <- newManager tlsManagerSettings
req <- liftIO $ parseUrlThrow url
- responseBody <$> httpLbs (setConnectionClose req) man
+ responseBody A.<$> httpLbs (setConnectionClose req) man
conduitManagerSettings :: ManagerSettings
conduitManagerSettings = tlsManagerSettings
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/Network/HTTP/Simple.hs
new/http-conduit-2.2.3.1/Network/HTTP/Simple.hs
--- old/http-conduit-2.1.11/Network/HTTP/Simple.hs 2016-06-30
11:43:27.000000000 +0200
+++ new/http-conduit-2.2.3.1/Network/HTTP/Simple.hs 2016-12-19
16:29:45.000000000 +0100
@@ -4,25 +4,26 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Simplified interface for common HTTP client interactions. Tutorial
-- available at
--- <https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md>.
+-- <https://haskell-lang.org/library/http-client>
--
--- Important note: 'Request' is an instance of 'IsString', and therefore
--- recommended usage is to turn on @OverloadedStrings@, e.g.
+-- Important note: 'H.Request' is an instance of 'Data.String.IsString', and
+-- therefore recommended usage is to turn on @OverloadedStrings@, e.g.
--
--- @@@
--- {-# LANGUAGE OverloadedStrings #-}
--- import Network.HTTP.Simple
--- import qualified Data.ByteString.Lazy.Char8 as L8
---
--- main :: IO ()
--- main = httpLBS "http://example.com"; >>= L8.putStrLn
--- @@@
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > import Network.HTTP.Simple
+-- > import qualified Data.ByteString.Lazy.Char8 as L8
+-- >
+-- > main :: IO ()
+-- > main = httpLBS "http://example.com"; >>= L8.putStrLn
module Network.HTTP.Simple
( -- * Perform requests
httpLBS
+ , httpNoBody
, httpJSON
, httpJSONEither
, httpSink
+ , httpSource
+ , withResponse
-- * Types
, H.Request
, H.Response
@@ -54,7 +55,7 @@
, setRequestBodyFile
, setRequestBodyURLEncoded
-- ** Special fields
- , setRequestIgnoreStatus
+ , H.setRequestIgnoreStatus
, setRequestBasicAuth
, setRequestManager
, setRequestProxy
@@ -79,16 +80,16 @@
import Data.Aeson (FromJSON (..), Value)
import Data.Aeson.Parser (json')
import qualified Data.Aeson.Types as A
-import qualified Data.Aeson.Encode as A
+import qualified Data.Aeson as A
import qualified Data.Traversable as T
import Control.Exception (throwIO, Exception)
import Data.Typeable (Typeable)
import qualified Data.Conduit as C
import qualified Data.Conduit.Attoparsec as C
import qualified Control.Monad.Catch as Catch
-import Data.Default.Class (def)
import qualified Network.HTTP.Types as H
import Data.Int (Int64)
+import Control.Monad.Trans.Resource (MonadResource)
-- | Perform an HTTP request and return the body as a lazy @ByteString@. Note
-- that the entire value will be read into memory at once (no lazy I\/O will be
@@ -100,6 +101,14 @@
man <- H.getGlobalManager
H.httpLbs req man
+-- | Perform an HTTP request and ignore the response body.
+--
+-- @since 2.2.2
+httpNoBody :: MonadIO m => H.Request -> m (H.Response ())
+httpNoBody req = liftIO $ do
+ man <- H.getGlobalManager
+ H.httpNoBody req man
+
-- | Perform an HTTP request and parse the body as JSON. In the event of an
-- JSON parse errors, a 'JSONException' runtime exception will be thrown.
--
@@ -151,6 +160,65 @@
(\res -> bodyReaderSource (getResponseBody res)
C.$$ sink (fmap (const ()) res))
+-- | Perform an HTTP request, and get the response body as a Source.
+--
+-- The second argument to this function tells us how to make the
+-- Source from the Response itself. This allows you to perform actions
+-- with the status or headers, for example, in addition to the raw
+-- bytes themselves. If you just care about the response body, you can
+-- use 'getResponseBody' as the second argument here.
+--
+-- @
+-- \{\-# LANGUAGE OverloadedStrings \#\-}
+-- import Control.Monad.IO.Class (liftIO)
+-- import Control.Monad.Trans.Resource (runResourceT)
+-- import Data.Conduit (($$))
+-- import qualified Data.Conduit.Binary as CB
+-- import qualified Data.Conduit.List as CL
+-- import Network.HTTP.Simple
+-- import System.IO (stdout)
+--
+-- main :: IO ()
+-- main =
+-- runResourceT
+-- $ httpSource "http://httpbin.org/robots.txt"; getSrc
+-- $$ CB.sinkHandle stdout
+-- where
+-- getSrc res = do
+-- liftIO $ print (getResponseStatus res, getResponseHeaders res)
+-- getResponseBody res
+-- @
+--
+-- @since 2.2.1
+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 req withRes = do
+ man <- liftIO H.getGlobalManager
+ C.bracketP (H.responseOpen req man) H.responseClose
+ (withRes . fmap bodyReaderSource)
+
+-- | Perform an action with the given request. This employes the
+-- bracket pattern.
+--
+-- This is similar to 'httpSource', but does not require
+-- 'MonadResource' and allows the result to not contain a 'C.ConduitM'
+-- value.
+--
+-- @since 2.2.3
+withResponse :: (MonadIO m, Catch.MonadMask m, MonadIO n)
+ => H.Request
+ -> (H.Response (C.ConduitM i S.ByteString n ()) -> m a)
+ -> m a
+withResponse req withRes = do
+ man <- liftIO H.getGlobalManager
+ Catch.bracket
+ (liftIO (H.responseOpen req man))
+ (liftIO . H.responseClose)
+ (withRes . fmap bodyReaderSource)
+
-- | Alternate spelling of 'httpLBS'
--
-- @since 2.1.10
@@ -255,7 +323,7 @@
req { H.requestHeaders
= (H.hContentType, "application/json; charset=utf-8")
: filter (\(y, _) -> y /= H.hContentType) (H.requestHeaders req)
- , H.requestBody = H.RequestBodyLBS $ A.encode $ A.toJSON x
+ , H.requestBody = H.RequestBodyLBS $ A.encode x
}
-- | Set the request body as a lazy @ByteString@
@@ -299,13 +367,6 @@
setRequestBodyURLEncoded :: [(S.ByteString, S.ByteString)] -> H.Request ->
H.Request
setRequestBodyURLEncoded = H.urlEncodedBody
--- | Modify the request so that non-2XX status codes do not generate a runtime
--- exception.
---
--- @since 2.1.10
-setRequestIgnoreStatus :: H.Request -> H.Request
-setRequestIgnoreStatus req = req { H.checkStatus = \_ _ _ -> Nothing }
-
-- | Set basic auth with the given username and password
--
-- @since 2.1.10
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/README.md
new/http-conduit-2.2.3.1/README.md
--- old/http-conduit-2.1.11/README.md 2016-06-30 11:43:27.000000000 +0200
+++ new/http-conduit-2.2.3.1/README.md 2017-02-20 09:36:23.000000000 +0100
@@ -1,7 +1,10 @@
http-conduit
============
+Provides for making efficient HTTP/HTTPS requests, providing either a simple or
+streaming interface.
+
Full tutorial docs are available at:
-https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md
+https://haskell-lang.org/library/http-client
The `Network.HTTP.Conduit.Browser` module has been moved to
<http://hackage.haskell.org/package/http-conduit-browser/>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/http-conduit.cabal
new/http-conduit-2.2.3.1/http-conduit.cabal
--- old/http-conduit-2.1.11/http-conduit.cabal 2016-06-30 11:43:27.000000000
+0200
+++ new/http-conduit-2.2.3.1/http-conduit.cabal 2017-02-26 15:40:28.000000000
+0100
@@ -1,5 +1,5 @@
name: http-conduit
-version: 2.1.11
+version: 2.2.3.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman <mich...@snoyman.com>
@@ -30,12 +30,11 @@
, conduit-extra >= 1.1.5
, http-types >= 0.7
, lifted-base >= 0.1
- , http-client >= 0.4.30 && < 0.5
- , http-client-tls >= 0.2.4
+ , http-client >= 0.5 && < 0.6
+ , http-client-tls >= 0.3 && < 0.4
, monad-control
, mtl
, exceptions >= 0.6
- , data-default-class
exposed-modules: Network.HTTP.Conduit
Network.HTTP.Client.Conduit
Network.HTTP.Simple
@@ -76,6 +75,7 @@
, streaming-commons
, aeson
, temporary
+ , resourcet
source-repository head
type: git
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/test/CookieTest.hs
new/http-conduit-2.2.3.1/test/CookieTest.hs
--- old/http-conduit-2.1.11/test/CookieTest.hs 2016-06-30 11:43:27.000000000
+0200
+++ new/http-conduit-2.2.3.1/test/CookieTest.hs 2016-12-19 16:29:45.000000000
+0100
@@ -8,14 +8,13 @@
import qualified Network.HTTP.Conduit as HC
import Data.ByteString.UTF8
import Data.Monoid
-import Data.Maybe
import Data.Time.Clock
import Data.Time.Calendar
import qualified Data.CaseInsensitive as CI
import Web.Cookie
default_request :: HC.Request
-default_request = fromJust $ HC.parseUrl "http://www.google.com/";
+default_request = HC.parseRequest_ "http://www.google.com/";
default_cookie :: Cookie
default_cookie = Cookie { cookie_name = fromString "name"
@@ -444,7 +443,7 @@
testMonoidPreferRecent :: IO ()
testMonoidPreferRecent = assertEqual "Monoid prefers more recent cookies"
- (cct $ createCookieJar [c2]) (cct $ createCookieJar [c1] `mappend`
createCookieJar [c2])
+ (cct $ createCookieJar [c2]) (cct $ createCookieJar [c1]
`Data.Monoid.mappend` createCookieJar [c2])
where c1 = default_cookie {cookie_creation_time = UTCTime (ModifiedJulianDay
0) (secondsToDiffTime 1)}
c2 = default_cookie {cookie_creation_time = UTCTime (ModifiedJulianDay
0) (secondsToDiffTime 2)}
cct cj = cookie_creation_time $ head $ destroyCookieJar cj
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/http-conduit-2.1.11/test/main.hs
new/http-conduit-2.2.3.1/test/main.hs
--- old/http-conduit-2.1.11/test/main.hs 2016-06-30 11:43:27.000000000
+0200
+++ new/http-conduit-2.2.3.1/test/main.hs 2016-12-19 16:29:45.000000000
+0100
@@ -12,7 +12,7 @@
import System.IO.Temp (withSystemTempFile)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort,
setBeforeMainLoop, Settings, setTimeout)
-import Network.HTTP.Conduit hiding (port)
+import Network.HTTP.Conduit hiding (port, withManager, withManagerSettings)
import qualified Network.HTTP.Conduit as NHC
import Network.HTTP.Client.MultipartFormData
import Control.Concurrent (forkIO, killThread, putMVar, takeMVar,
newEmptyMVar, threadDelay)
@@ -25,7 +25,7 @@
import qualified Network.BSD
import CookieTest (cookieTest)
#if MIN_VERSION_conduit(1,1,0)
-import Data.Conduit.Network (runTCPServer, serverSettings, HostPreference
(..), appSink, appSource, ServerSettings)
+import Data.Conduit.Network (runTCPServer, serverSettings, appSink, appSource,
ServerSettings)
import Data.Streaming.Network (bindPortTCP, setAfterBind)
#define bindPort bindPortTCP
#else
@@ -53,6 +53,15 @@
import Data.Default.Class (def)
import qualified Data.Aeson as A
import qualified Network.HTTP.Simple as Simple
+import Data.Monoid (mempty)
+import Control.Monad.Trans.Resource (ResourceT, runResourceT)
+
+-- I'm too lazy to rewrite code below
+withManager :: (Manager -> ResourceT IO a) -> IO a
+withManager = withManagerSettings tlsManagerSettings
+
+withManagerSettings :: ManagerSettings -> (Manager -> ResourceT IO a) -> IO a
+withManagerSettings set f = newManager set >>= (runResourceT . f)
past :: UTCTime
past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
@@ -174,49 +183,49 @@
it "throws exception on 404" $ withApp app $ \port -> do
elbs <- try $ simpleHttp $ concat ["http://127.0.0.1:";, show port,
"/404"]
case elbs of
- Left (StatusCodeException _ _ _) -> return ()
+ Left (HttpExceptionRequest _ StatusCodeException {}) -> return
()
_ -> error "Expected an exception"
describe "httpLbs" $ do
it "preserves 'set-cookie' headers" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/cookies"]
withManager $ \manager -> do
response <- httpLbs request manager
let setCookie = mk (fromString "Set-Cookie")
(setCookieHeaders, _) = partition ((== setCookie) . fst)
(NHC.responseHeaders response)
liftIO $ assertBool "response contains a 'set-cookie' header"
$ length setCookieHeaders > 0
it "redirects set cookies" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/cookie_redir1"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/cookie_redir1"]
withManager $ \manager -> do
response <- httpLbs request manager
liftIO $ (responseBody response) @?= "nom-nom-nom"
it "user-defined cookie jar works" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/dump_cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/dump_cookies"]
withManager $ \manager -> do
response <- httpLbs (request {redirectCount = 1, cookieJar =
Just cookie_jar}) manager
liftIO $ (responseBody response) @?= "key=value"
it "user-defined cookie jar is not ignored when redirection is
disabled" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/dump_cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/dump_cookies"]
withManager $ \manager -> do
response <- httpLbs (request {redirectCount = 0, cookieJar =
Just cookie_jar}) manager
liftIO $ (responseBody response) @?= "key=value"
it "cookie jar is available in response" $ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/cookies"]
withManager $ \manager -> do
- response <- httpLbs (request {cookieJar = Just def}) manager
+ response <- httpLbs (request {cookieJar = Just
Data.Monoid.mempty}) manager
liftIO $ (length $ destroyCookieJar $ responseCookieJar
response) @?= 1
it "Cookie header isn't touched when no cookie jar supplied" $ withApp
app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/dump_cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/dump_cookies"]
withManager $ \manager -> do
let request_headers = (mk "Cookie", "key2=value2") : filter
((/= mk "Cookie") . fst) (NHC.requestHeaders request)
response <- httpLbs (request {NHC.requestHeaders =
request_headers, cookieJar = Nothing}) manager
liftIO $ (responseBody response) @?= "key2=value2"
it "Response cookie jar is nothing when request cookie jar is nothing"
$ withApp app $ \port -> do
- request <- parseUrl $ concat ["http://127.0.0.1:";, show port,
"/cookies"]
+ request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port,
"/cookies"]
withManager $ \manager -> do
response <- httpLbs (request {cookieJar = Nothing}) manager
- liftIO $ (responseCookieJar response) @?= def
+ liftIO $ (responseCookieJar response) @?= mempty
it "TLS" $ withAppTls app $ \port -> do
- request <- parseUrl $ "https://127.0.0.1:"; ++ show port
+ request <- parseUrlThrow $ "https://127.0.0.1:"; ++ show port
let set = mkManagerSettings
def
{ settingDisableCertificateValidation = True
@@ -228,8 +237,8 @@
it "closes all connections" $ withApp app $ \port1 -> withApp app $
\port2 -> do
--FIXME clearSocketsList
withManager $ \manager -> do
- let Just req1 = parseUrl $ "http://127.0.0.1:"; ++ show port1
- let Just req2 = parseUrl $ "http://127.0.0.1:"; ++ show port2
+ let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show
port1
+ let Just req2 = parseUrlThrow $ "http://127.0.0.1:"; ++ show
port2
_res1a <- http req1 manager
_res1b <- http req1 manager
_res2 <- http req2 manager
@@ -238,7 +247,7 @@
describe "http" $ do
it "response body" $ withApp app $ \port -> do
withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:"; ++ show
port
res1 <- http req manager
bss <- responseBody res1 $$+- CL.consume
res2 <- httpLbs req manager
@@ -246,21 +255,21 @@
describe "DOS protection" $ do
it "overlong headers" $ overLongHeaders $ \port -> do
withManager $ \manager -> do
- let Just req1 = parseUrl $ "http://127.0.0.1:"; ++ show port
+ let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show
port
res1 <- try $ http req1 manager
case res1 of
- Left e -> liftIO $ show (e :: SomeException) @?= show
OverlongHeaders
+ Left e -> liftIO $ show (e :: SomeException) @?= show
(HttpExceptionRequest req1 OverlongHeaders)
_ -> error "Shouldn't have worked"
it "not overlong headers" $ notOverLongHeaders $ \port -> do
withManager $ \manager -> do
- let Just req1 = parseUrl $ "http://127.0.0.1:"; ++ show port
+ let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show
port
_ <- httpLbs req1 manager
return ()
describe "redirects" $ do
it "doesn't double escape" $ redir $ \port -> do
withManager $ \manager -> do
let go (encoded, final) = do
- let Just req1 = parseUrl $ concat
["http://127.0.0.1:";, show port, "/redir/", encoded]
+ let Just req1 = parseUrlThrow $ concat
["http://127.0.0.1:";, show port, "/redir/", encoded]
res <- httpLbs req1 manager
liftIO $ Network.HTTP.Conduit.responseStatus res @?=
status200
liftIO $ responseBody res @?= L.fromChunks
[TE.encodeUtf8 final]
@@ -272,19 +281,19 @@
, ("hello%20world%3f%23", "hello world?#")
]
it "TooManyRedirects: redirect request body is preserved" $ withApp
app $ \port -> do
- let Just req = parseUrl $ concat ["http://127.0.0.1:";, show port,
"/infredir/0"]
+ let Just req = parseUrlThrow $ concat ["http://127.0.0.1:";, show
port, "/infredir/0"]
let go (res, i) = liftIO $ responseBody res @?= (L8.pack $ show i)
E.catch (withManager $ \manager -> do
void $ http req{redirectCount=5} manager) $ \e ->
case e of
- TooManyRedirects redirs ->
+ HttpExceptionRequest _ (TooManyRedirects redirs) ->
mapM_ go (zip redirs [5,4..0 :: Int])
_ -> error $ show e
describe "chunked request body" $ do
it "works" $ echo $ \port -> do
withManager $ \manager -> do
let go bss = do
- let Just req1 = parseUrl $ "POST http://127.0.0.1:"; ++
show port
+ let Just req1 = parseUrlThrow $ "POST
http://127.0.0.1:"; ++ show port
src = sourceList bss
lbs = L.fromChunks bss
res <- httpLbs req1
@@ -299,7 +308,7 @@
]
describe "no status message" $ do
it "works" $ noStatusMessage $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
res <- httpLbs req manager
liftIO $ do
@@ -308,49 +317,49 @@
describe "response body too short" $ do
it "throws an exception" $ wrongLength $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String))
(Right . id) eres
- `shouldBe` Left (show $ ResponseBodyTooShort 50 18)
+ `shouldBe` Left (show $ HttpExceptionRequest req $
ResponseBodyTooShort 50 18)
describe "chunked response body" $ do
it "no chunk terminator" $ wrongLengthChunk1 $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String))
(Right . id) eres
- `shouldBe` Left (show IncompleteHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req
IncompleteHeaders))
it "incomplete chunk" $ wrongLengthChunk2 $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String))
(Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req
InvalidChunkHeaders))
it "invalid chunk" $ invalidChunk $ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String))
(Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req
InvalidChunkHeaders))
it "missing header" $ rawApp
"HTTP/1.1 200 OK\r\nTransfer-Encoding:
chunked\r\n\r\n4\r\nabcd\r\n\r\n\r\n"
$ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String))
(Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req
InvalidChunkHeaders))
it "junk header" $ rawApp
"HTTP/1.1 200 OK\r\nTransfer-Encoding:
chunked\r\n\r\n4\r\nabcd\r\njunk\r\n\r\n"
$ \port -> do
- req <- parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port
withManager $ \manager -> do
eres <- try $ httpLbs req manager
liftIO $ either (Left . (show :: HttpException -> String))
(Right . id) eres
- `shouldBe` Left (show InvalidChunkHeaders)
+ `shouldBe` Left (show (HttpExceptionRequest req
InvalidChunkHeaders))
describe "redirect" $ do
it "ignores large response bodies" $ do
@@ -359,7 +368,7 @@
["foo"] -> return $ responseLBS status200 [] "Hello
World!"
_ -> return $ responseSource status301 [("location",
S8.pack $ "http://127.0.0.1:"; ++ show port ++ "/foo")] $ forever $ yield $
Chunk $ fromByteString "hello\n"
withApp' app' $ \port -> withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:"; ++ show
port
res <- httpLbs req manager
liftIO $ do
Network.HTTP.Conduit.responseStatus res `shouldBe`
status200
@@ -392,7 +401,7 @@
_ <- appSource app' $$ await
yield "HTTP/1.0 200 OK\r\n\r\nThis is it!" $$ appSink app'
withCApp baseHTTP $ \port -> withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:"; ++ show port
+ req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:"; ++ show
port
res1 <- httpLbs req manager
res2 <- httpLbs req manager
liftIO $ res1 @?= res2
@@ -400,33 +409,33 @@
describe "hostAddress" $ do
it "overrides host" $ withApp app $ \port -> do
entry <- Network.BSD.getHostByName "127.0.0.1"
- req' <- parseUrl $ "http://example.com:"; ++ show port
+ req' <- parseUrlThrow $ "http://example.com:"; ++ show port
let req = req' { hostAddress = Just $ Network.BSD.hostAddress
entry }
res <- withManager $ httpLbs req
responseBody res @?= "homepage for example.com"
describe "managerResponseTimeout" $ do
it "works" $ withApp app $ \port -> do
- req1 <- parseUrl $ "http://localhost:"; ++ show port
- let req2 = req1 { responseTimeout = Just 5000000 }
- withManagerSettings conduitManagerSettings {
managerResponseTimeout = Just 1 } $ \man -> do
+ req1 <- parseUrlThrow $ "http://localhost:"; ++ show port
+ let req2 = req1 { responseTimeout = responseTimeoutMicro 5000000 }
+ withManagerSettings tlsManagerSettings { managerResponseTimeout =
responseTimeoutMicro 1 } $ \man -> do
eres1 <- try $ httpLbs req1 { NHC.path = "/delayed" } man
case eres1 of
- Left (FailedConnectionException _ _) -> return ()
+ Left (HttpExceptionRequest _ ConnectionTimeout{}) ->
return ()
_ -> error "Did not time out"
_ <- httpLbs req2 man
return ()
describe "delayed body" $ do
it "works" $ withApp app $ \port -> do
- req <- parseUrl $ "http://localhost:"; ++ show port ++ "/delayed"
+ req <- parseUrlThrow $ "http://localhost:"; ++ show port ++
"/delayed"
withManager $ \man -> do
_ <- http req man
return ()
it "reuse/connection close tries again" $ do
withAppSettings (setTimeout 1) (const app) $ \port -> do
- req <- parseUrl $ "http://localhost:"; ++ show port
+ req <- parseUrlThrow $ "http://localhost:"; ++ show port
withManager $ \man -> do
res1 <- httpLbs req man
liftIO $ threadDelay 3000000
@@ -450,7 +459,7 @@
, ("noval", Nothing)
]
withManager $ \man -> do
- req <- parseUrl $ "http://localhost:"; ++ show port
+ req <- parseUrlThrow $ "http://localhost:"; ++ show port
_ <- httpLbs (setQueryString qs req) man
return ()
res <- I.readIORef ref
@@ -458,7 +467,7 @@
describe "Simple" $ do
it "JSON" $ jsonApp $ \port -> do
- req <- parseUrl $ "http://localhost:"; ++ show port
+ req <- parseUrlThrow $ "http://localhost:"; ++ show port
value <- Simple.httpJSON req
responseBody value `shouldBe` jsonValue
@@ -469,7 +478,7 @@
mapM_ (S.hPutStr tmph) bss
hClose tmph
- let Just req1 = parseUrl $ "POST http://127.0.0.1:"; ++
show port
+ let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:";
++ show port
lbs = L.fromChunks bss
res <- httpLbs req1
{ requestBody = RequestBodyIO (streamFile tmpfp)
