Hello community, here is the log from the commit of package ghc-http-conduit for openSUSE:Factory checked in at 2016-04-22 16:25:04 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http-conduit (Old) and /work/SRC/openSUSE:Factory/.ghc-http-conduit.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-conduit" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http-conduit/ghc-http-conduit.changes 2015-08-27 08:55:32.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http-conduit.new/ghc-http-conduit.changes 2016-04-22 16:25:24.000000000 +0200 @@ -1,0 +2,12 @@ +Sat Apr 16 07:06:12 UTC 2016 - [email protected] + +- update to 2.1.10 +* Add the Network.HTTP.Simple module + +------------------------------------------------------------------- +Tue Apr 12 09:59:34 UTC 2016 - [email protected] + +- update to 2.1.9 +* cleanup + +------------------------------------------------------------------- Old: ---- http-conduit-2.1.8.tar.gz New: ---- http-conduit-2.1.10.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-conduit.spec ++++++ --- /var/tmp/diff_new_pack.pyGY4O/_old 2016-04-22 16:25:25.000000000 +0200 +++ /var/tmp/diff_new_pack.pyGY4O/_new 2016-04-22 16:25:25.000000000 +0200 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-http-conduit -Version: 2.1.8 +Version: 2.1.10 Release: 0 Summary: HTTP client package with conduit interface and HTTPS support License: BSD-2-Clause @@ -34,8 +34,12 @@ BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros # 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 BuildRequires: ghc-http-types-devel @@ -48,13 +52,12 @@ BuildRequires: ghc-HUnit-devel BuildRequires: ghc-blaze-builder-devel BuildRequires: ghc-case-insensitive-devel -BuildRequires: ghc-conduit-extra-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 +BuildRequires: ghc-temporary-devel BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel BuildRequires: ghc-utf8-string-devel @@ -113,5 +116,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc README.md %changelog ++++++ http-conduit-2.1.8.tar.gz -> http-conduit-2.1.10.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.1.8/ChangeLog.md new/http-conduit-2.1.10/ChangeLog.md --- old/http-conduit-2.1.8/ChangeLog.md 2015-08-10 18:05:04.000000000 +0200 +++ new/http-conduit-2.1.10/ChangeLog.md 2016-04-15 10:51:33.000000000 +0200 @@ -1,3 +1,11 @@ +## 2.1.10 + +* Add the `Network.HTTP.Simple` module + +## 2.1.9 + +* cabal file cleanup + ## 2.1.8 * Move HasHttpManager from http-conduit to http-client [#147](https://github.com/snoyberg/http-client/pull/147) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.1.8/Network/HTTP/Client/Conduit.hs new/http-conduit-2.1.10/Network/HTTP/Client/Conduit.hs --- old/http-conduit-2.1.8/Network/HTTP/Client/Conduit.hs 2015-08-10 18:05:04.000000000 +0200 +++ new/http-conduit-2.1.10/Network/HTTP/Client/Conduit.hs 2016-04-15 10:51:33.000000000 +0200 @@ -3,8 +3,13 @@ {-# LANGUAGE RankNTypes #-} -- | A new, experimental API to replace "Network.HTTP.Conduit". -- --- For more information, please be sure to read the documentation in the --- "Network.HTTP.Client" module. +-- 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>. +-- +-- For more information on using this module, please be sure to read the +-- documentation in the "Network.HTTP.Client" module. module Network.HTTP.Client.Conduit ( -- * Conduit-specific interface withResponse diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.1.8/Network/HTTP/Conduit.hs new/http-conduit-2.1.10/Network/HTTP/Conduit.hs --- old/http-conduit-2.1.8/Network/HTTP/Conduit.hs 2015-08-10 18:05:04.000000000 +0200 +++ new/http-conduit-2.1.10/Network/HTTP/Conduit.hs 2016-04-15 10:51:33.000000000 +0200 @@ -2,7 +2,20 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} --- | This module contains everything you need to initiate HTTP connections. If +-- | +-- +-- = Simpler API +-- +-- The API below is rather low-level. The "Network.HTTP.Simple" module 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 module contains everything you need to initiate HTTP connections. If -- you want a simple interface based on URLs, you can use 'simpleHttp'. If you -- want raw power, 'http' is the underlying workhorse of this package. Some -- examples: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.1.8/Network/HTTP/Simple.hs new/http-conduit-2.1.10/Network/HTTP/Simple.hs --- old/http-conduit-2.1.8/Network/HTTP/Simple.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/http-conduit-2.1.10/Network/HTTP/Simple.hs 2016-04-15 10:51:33.000000000 +0200 @@ -0,0 +1,382 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Simplified interface for common HTTP client interactions. Tutorial +-- available at +-- <https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md>. +-- +-- Important note: 'Request' is an instance of '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 +-- @@@ +module Network.HTTP.Simple + ( -- * Perform requests + httpLBS + , httpJSON + , httpJSONEither + , httpSink + -- * Types + , H.Request + , H.Response + , JSONException (..) + , H.HttpException (..) + , H.Proxy (..) + -- * Request constructions + , defaultRequest + , parseRequest + -- * Request lenses + -- ** Basics + , setRequestMethod + , setRequestSecure + , setRequestHost + , setRequestPort + , setRequestPath + , addRequestHeader + , getRequestHeader + , setRequestHeader + , setRequestHeaders + , setRequestQueryString + , getRequestQueryString + -- ** Request body + , setRequestBody + , setRequestBodyJSON + , setRequestBodyLBS + , setRequestBodySource + , setRequestBodyFile + , setRequestBodyURLEncoded + -- ** Special fields + , setRequestIgnoreStatus + , setRequestBasicAuth + , setRequestManager + , setRequestProxy + -- * Response lenses + , getResponseStatus + , getResponseStatusCode + , getResponseHeader + , getResponseHeaders + , getResponseBody + -- * Alternate spellings + , 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.Class (MonadIO, liftIO) +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.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) + +-- | 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 +-- performed). +-- +-- @since 0.2.4 +httpLBS :: MonadIO m => H.Request -> m (H.Response L.ByteString) +httpLBS req = liftIO $ do + man <- H.getGlobalManager + H.httpLbs 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. +-- +-- @since 0.2.4 +httpJSON :: (MonadIO m, FromJSON a) => H.Request -> m (H.Response a) +httpJSON req = liftIO $ httpJSONEither req >>= T.mapM (either throwIO return) + +-- | Perform an HTTP request and parse the body as JSON. In the event of an +-- JSON parse errors, a @Left@ value will be returned. +-- +-- @since 0.2.4 +httpJSONEither :: (MonadIO m, FromJSON a) + => H.Request + -> m (H.Response (Either JSONException a)) +httpJSONEither req = + liftIO $ httpSink req sink + where + sink orig = fmap (\x -> fmap (const x) orig) $ do + eres1 <- C.sinkParserEither json' + case eres1 of + Left e -> return $ Left $ JSONParseException req orig e + Right value -> + case A.fromJSON value of + A.Error e -> return $ Left $ JSONConversionException + req (fmap (const value) orig) e + A.Success x -> return $ Right x + +-- | An exception that can occur when parsing JSON +-- +-- @since 0.2.4 +data JSONException + = JSONParseException H.Request (H.Response ()) C.ParseError + | JSONConversionException H.Request (H.Response Value) String + deriving (Show, Typeable) +instance Exception JSONException + +-- | The default request value. You'll almost certainly want to set the +-- 'requestHost', and likely the 'requestPath' as well. +-- +-- See also 'parseRequest' +-- +-- @since 0.2.4 +defaultRequest :: H.Request +defaultRequest = def + +-- | Parse a 'H.Request' from a 'String'. This is given as a URL, with an +-- optional leading request method, e.g.: +-- +-- * @http://example.com@ +-- * @https://example.com:1234/foo/bar?baz=bin@ +-- * @PUT http://example.com/some-resource@ +-- +-- If parsing fails, 'Catch.throwM' will be called. The behavior of this +-- function is also used for the @IsString@ instance for use with +-- @OverloadedStrings@. +-- +-- @since 0.2.4 +parseRequest :: Catch.MonadThrow m => String -> m H.Request +parseRequest = H.parseUrl + +-- | Perform an HTTP request and consume the body with the given 'C.Sink' +-- +-- @since 0.2.4 +httpSink :: (MonadIO m, Catch.MonadMask m) + => H.Request + -> (H.Response () -> C.Sink S.ByteString m a) + -> m a +httpSink req sink = do + man <- liftIO H.getGlobalManager + Catch.bracket + (liftIO $ H.responseOpen req man) + (liftIO . H.responseClose) + (\res -> bodyReaderSource (getResponseBody res) + C.$$ sink (fmap (const ()) res)) + +-- | Alternate spelling of 'httpLBS' +-- +-- @since 0.2.4 +httpLbs :: MonadIO m => H.Request -> m (H.Response L.ByteString) +httpLbs = httpLBS + +-- | Set the request method +-- +-- @since 0.2.4 +setRequestMethod :: S.ByteString -> H.Request -> H.Request +setRequestMethod x req = req { H.method = x } + +-- | Set whether this is a secure/HTTPS (@True@) or insecure/HTTP +-- (@False@) request +-- +-- @since 0.2.4 +setRequestSecure :: Bool -> H.Request -> H.Request +setRequestSecure x req = req { H.secure = x } + +-- | Set the destination host of the request +-- +-- @since 0.2.4 +setRequestHost :: S.ByteString -> H.Request -> H.Request +setRequestHost x r = r { H.host = x } + +-- | Set the destination port of the request +-- +-- @since 0.2.4 +setRequestPort :: Int -> H.Request -> H.Request +setRequestPort x r = r { H.port = x } + +-- | Lens for the requested path info of the request +-- +-- @since 0.2.4 +setRequestPath :: S.ByteString -> H.Request -> H.Request +setRequestPath x r = r { H.path = x } + +-- | Add a request header name/value combination +-- +-- @since 0.2.4 +addRequestHeader :: H.HeaderName -> S.ByteString -> H.Request -> H.Request +addRequestHeader name val req = + req { H.requestHeaders = (name, val) : H.requestHeaders req } + +-- | Get all request header values for the given name +-- +-- @since 0.2.4 +getRequestHeader :: H.HeaderName -> H.Request -> [S.ByteString] +getRequestHeader name = + map snd . filter (\(x, _) -> x == name) . H.requestHeaders + +-- | Set the given request header to the given list of values. Removes any +-- previously set header values with the same name. +-- +-- @since 0.2.4 +setRequestHeader :: H.HeaderName -> [S.ByteString] -> H.Request -> H.Request +setRequestHeader name vals req = + req { H.requestHeaders = + filter (\(x, _) -> x /= name) (H.requestHeaders req) + ++ (map (name, ) vals) + } + +-- | Set the request headers, wiping out any previously set headers +-- +-- @since 0.2.4 +setRequestHeaders :: [(H.HeaderName, S.ByteString)] -> H.Request -> H.Request +setRequestHeaders x req = req { H.requestHeaders = x } + +-- | Get the query string parameters +-- +-- @since 0.2.4 +getRequestQueryString :: H.Request -> [(S.ByteString, Maybe S.ByteString)] +getRequestQueryString = H.parseQuery . H.queryString + +-- | Set the query string parameters +-- +-- @since 0.2.4 +setRequestQueryString :: [(S.ByteString, Maybe S.ByteString)] -> H.Request -> H.Request +setRequestQueryString = H.setQueryString + +-- | Set the request body to the given 'H.RequestBody'. You may want to +-- consider using one of the convenience functions in the modules, e.g. +-- 'requestBodyJSON'. +-- +-- /Note/: This will not modify the request method. For that, please use +-- 'requestMethod'. You likely don't want the default of @GET@. +-- +-- @since 0.2.4 +setRequestBody :: H.RequestBody -> H.Request -> H.Request +setRequestBody x req = req { H.requestBody = x } + +-- | Set the request body as a JSON value +-- +-- /Note/: This will not modify the request method. For that, please use +-- 'requestMethod'. You likely don't want the default of @GET@. +-- +-- This also sets the @content-type@ to @application/json; chatset=utf8@ +-- +-- @since 0.2.4 +setRequestBodyJSON :: A.ToJSON a => a -> H.Request -> H.Request +setRequestBodyJSON x req = + 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 + } + +-- | Set the request body as a lazy @ByteString@ +-- +-- /Note/: This will not modify the request method. For that, please use +-- 'requestMethod'. You likely don't want the default of @GET@. +-- +-- @since 0.2.4 +setRequestBodyLBS :: L.ByteString -> H.Request -> H.Request +setRequestBodyLBS = setRequestBody . H.RequestBodyLBS + +-- | Set the request body as a 'C.Source' +-- +-- /Note/: This will not modify the request method. For that, please use +-- 'requestMethod'. You likely don't want the default of @GET@. +-- +-- @since 0.2.4 +setRequestBodySource :: Int64 -- ^ length of source + -> C.Source IO S.ByteString + -> H.Request + -> H.Request +setRequestBodySource len src req = req { H.requestBody = HC.requestBodySource len src } + +-- | Set the request body as a file +-- +-- /Note/: This will not modify the request method. For that, please use +-- 'requestMethod'. You likely don't want the default of @GET@. +-- +-- @since 0.2.4 +setRequestBodyFile :: FilePath -> H.Request -> H.Request +setRequestBodyFile = setRequestBody . HI.RequestBodyIO . H.streamFile + +-- | Set the request body as URL encoded data +-- +-- /Note/: This will not modify the request method. For that, please use +-- 'requestMethod'. You likely don't want the default of @GET@. +-- +-- This also sets the @content-type@ to @application/x-www-form-urlencoded@ +-- +-- @since 0.2.4 +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 0.2.4 +setRequestIgnoreStatus :: H.Request -> H.Request +setRequestIgnoreStatus req = req { H.checkStatus = \_ _ _ -> Nothing } + +-- | Set basic auth with the given username and password +-- +-- @since 0.2.4 +setRequestBasicAuth :: S.ByteString -- ^ username + -> S.ByteString -- ^ password + -> H.Request + -> H.Request +setRequestBasicAuth = H.applyBasicAuth + +-- | Instead of using the default global 'H.Manager', use the supplied +-- @Manager@. +-- +-- @since 0.2.4 +setRequestManager :: H.Manager -> H.Request -> H.Request +setRequestManager x req = req { HI.requestManagerOverride = Just x } + +-- | Override the default proxy server settings +-- +-- @since 0.2.4 +setRequestProxy :: Maybe H.Proxy -> H.Request -> H.Request +setRequestProxy x req = req { H.proxy = x } + +-- | Get the status of the response +-- +-- @since 0.2.4 +getResponseStatus :: H.Response a -> H.Status +getResponseStatus = H.responseStatus + +-- | Get the integral status code of the response +-- +-- @since 0.2.4 +getResponseStatusCode :: H.Response a -> Int +getResponseStatusCode = H.statusCode . getResponseStatus + +-- | Get all response header values with the given name +-- +-- @since 0.2.4 +getResponseHeader :: H.HeaderName -> H.Response a -> [S.ByteString] +getResponseHeader name = map snd . filter (\(x, _) -> x == name) . H.responseHeaders + +-- | Get all response headers +-- +-- @since 0.2.4 +getResponseHeaders :: H.Response a -> [(H.HeaderName, S.ByteString)] +getResponseHeaders = H.responseHeaders + +-- | Get the response body +-- +-- @since 0.2.4 +getResponseBody :: H.Response a -> a +getResponseBody = H.responseBody diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.1.8/README.md new/http-conduit-2.1.10/README.md --- old/http-conduit-2.1.8/README.md 2015-08-10 18:05:04.000000000 +0200 +++ new/http-conduit-2.1.10/README.md 2016-04-15 10:51:33.000000000 +0200 @@ -1 +1,7 @@ -Make HTTP requests using the conduit library for a streaming interface. +http-conduit +============ + +Full tutorial docs are available at: +https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md + +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.8/http-conduit.cabal new/http-conduit-2.1.10/http-conduit.cabal --- old/http-conduit-2.1.8/http-conduit.cabal 2015-08-10 18:05:04.000000000 +0200 +++ new/http-conduit-2.1.10/http-conduit.cabal 2016-04-15 10:51:33.000000000 +0200 @@ -1,14 +1,11 @@ name: http-conduit -version: 2.1.8 +version: 2.1.10 license: BSD3 license-file: LICENSE author: Michael Snoyman <[email protected]> maintainer: Michael Snoyman <[email protected]> synopsis: HTTP client package with conduit interface and HTTPS support. -description: - This package uses conduit for parsing the actual contents of the HTTP connection. It also provides higher-level functions which allow you to avoid directly dealing with streaming data. See <http://www.yesodweb.com/book/http-conduit> for more information. - . - The @Network.HTTP.Conduit.Browser@ module has been moved to <http://hackage.haskell.org/package/http-conduit-browser/> +description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-conduit>. category: Web, Conduit stability: Stable cabal-version: >= 1.8 @@ -25,22 +22,28 @@ library build-depends: base >= 4 && < 5 + , aeson >= 0.8 , bytestring >= 0.9.1.4 , transformers >= 0.2 , resourcet >= 1.1 && < 1.2 , conduit >= 0.5.5 && < 1.3 + , conduit-extra >= 1.1.5 , http-types >= 0.7 , lifted-base >= 0.1 - , http-client >= 0.4.3 && < 0.5 - , http-client-tls >= 0.2.2 + , http-client >= 0.4.28 && < 0.5 + , http-client-tls >= 0.2.4 , monad-control , mtl + , exceptions >= 0.6 + , data-default-class exposed-modules: Network.HTTP.Conduit Network.HTTP.Client.Conduit + Network.HTTP.Simple ghc-options: -Wall test-suite test main-is: main.hs + other-modules: CookieTest type: exitcode-stdio-1.0 hs-source-dirs: test @@ -62,8 +65,8 @@ , case-insensitive , lifted-base , network - , wai >= 3.0 && < 3.1 - , warp >= 3.0.0.2 && < 3.2 + , wai >= 3.0 && < 3.3 + , warp >= 3.0.0.2 && < 3.3 , wai-conduit , http-types , cookie @@ -71,6 +74,8 @@ , http-conduit , conduit-extra , streaming-commons + , aeson + , temporary source-repository head type: git diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.1.8/test/main.hs new/http-conduit-2.1.10/test/main.hs --- old/http-conduit-2.1.8/test/main.hs 2015-08-10 18:05:04.000000000 +0200 +++ new/http-conduit-2.1.10/test/main.hs 2016-04-15 10:51:33.000000000 +0200 @@ -8,6 +8,8 @@ import Test.HUnit import Network.Wai hiding (requestBody) import Network.Wai.Conduit (responseSource, sourceRequestBody) +import Network.HTTP.Client (streamFile) +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) @@ -49,6 +51,8 @@ import qualified Network.Wai.Handler.WarpTLS as WT import Network.Connection (settingDisableCertificateValidation) import Data.Default.Class (def) +import qualified Data.Aeson as A +import qualified Network.HTTP.Simple as Simple past :: UTCTime past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0) @@ -280,12 +284,11 @@ it "works" $ echo $ \port -> do withManager $ \manager -> do let go bss = do - let Just req1 = parseUrl $ "http://127.0.0.1:" ++ show port + let Just req1 = parseUrl $ "POST http://127.0.0.1:" ++ show port src = sourceList bss lbs = L.fromChunks bss res <- httpLbs req1 - { method = "POST" - , requestBody = requestBodySourceChunked src + { requestBody = requestBodySourceChunked src } manager liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 let ts = S.concat . L.toChunks @@ -453,6 +456,32 @@ res <- I.readIORef ref res `shouldBe` qs + describe "Simple" $ do + it "JSON" $ jsonApp $ \port -> do + req <- parseUrl $ "http://localhost:" ++ show port + value <- Simple.httpJSON req + responseBody value `shouldBe` jsonValue + + it "RequestBodyIO" $ echo $ \port -> do + withManager $ \manager -> do + let go bss = withSystemTempFile "request-body-io" $ \tmpfp tmph -> do + liftIO $ do + mapM_ (S.hPutStr tmph) bss + hClose tmph + + let Just req1 = parseUrl $ "POST http://127.0.0.1:" ++ show port + lbs = L.fromChunks bss + res <- httpLbs req1 + { requestBody = RequestBodyIO (streamFile tmpfp) + } manager + liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 + let ts = S.concat . L.toChunks + liftIO $ ts (responseBody res) @?= ts lbs + mapM_ go + [ ["hello", "world"] + , replicate 500 "foo\003\n\r" + ] + withCApp :: (Data.Conduit.Network.AppData -> IO ()) -> (Int -> IO ()) -> IO () withCApp app' f = do port <- getPort @@ -569,3 +598,16 @@ src $$ appSink app' where src = yield bs + +jsonApp :: (Int -> IO ()) -> IO () +jsonApp = withApp $ \_req -> return $ responseLBS + status200 + [ ("Content-Type", "application/json") + ] + (A.encode jsonValue) + +jsonValue :: A.Value +jsonValue = A.object + [ "name" A..= ("Alice" :: String) + , "age" A..= (35 :: Int) + ]
