summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2016-04-15 08:54:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-04-15 08:54:00 (GMT)
commit610d681ab4b645e83dc5500938dd98fabf6cec87 (patch)
treefd15928d7234c669bf53c33f531de8b3a8f777f7
parentfb23254f33da0453549f723f6d37b549027585c4 (diff)
version 2.1.102.1.10
-rw-r--r--ChangeLog.md4
-rw-r--r--Network/HTTP/Client/Conduit.hs9
-rw-r--r--Network/HTTP/Conduit.hs15
-rw-r--r--Network/HTTP/Simple.hs382
-rw-r--r--README.md8
-rw-r--r--http-conduit.cabal18
-rw-r--r--test/main.hs48
7 files changed, 470 insertions, 14 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index 82672f6..0a209d3 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
+## 2.1.10
+
+* Add the `Network.HTTP.Simple` module
+
## 2.1.9
* cabal file cleanup
diff --git a/Network/HTTP/Client/Conduit.hs b/Network/HTTP/Client/Conduit.hs
index 19cd9b6..425db79 100644
--- a/Network/HTTP/Client/Conduit.hs
+++ b/Network/HTTP/Client/Conduit.hs
@@ -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 --git a/Network/HTTP/Conduit.hs b/Network/HTTP/Conduit.hs
index 9ac97f4..a9566fa 100644
--- a/Network/HTTP/Conduit.hs
+++ b/Network/HTTP/Conduit.hs
@@ -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 --git a/Network/HTTP/Simple.hs b/Network/HTTP/Simple.hs
new file mode 100644
index 0000000..4e20f7a
--- /dev/null
+++ b/Network/HTTP/Simple.hs
@@ -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 --git a/README.md b/README.md
index 6b8ac14..c769cea 100644
--- a/README.md
+++ b/README.md
@@ -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 --git a/http-conduit.cabal b/http-conduit.cabal
index 829647f..4d900af 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,14 +1,11 @@
name: http-conduit
-version: 2.1.9
+version: 2.1.10
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
maintainer: Michael Snoyman <michael@snoyman.com>
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,18 +22,23 @@ extra-source-files: test/main.hs
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.19 && < 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
@@ -72,6 +74,8 @@ test-suite test
, http-conduit
, conduit-extra
, streaming-commons
+ , aeson
+ , temporary
source-repository head
type: git
diff --git a/test/main.hs b/test/main.hs
index eb7e0ac..7d9e384 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -8,6 +8,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8
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 Data.Time.Calendar
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 @@ main = withSocketsDo $ do
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 @@ main = withSocketsDo $ do
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 @@ rawApp bs =
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)
+ ]