http-conduit 2.0.0.10 → 2.1.0
raw patch · 4 files changed
+233/−18 lines, 4 filesdep +conduit-extradep +monad-controldep +mtldep −http-client-conduitdep −http-client-multipartdep ~conduitdep ~http-clientdep ~resourcet
Dependencies added: conduit-extra, monad-control, mtl, streaming-commons
Dependencies removed: http-client-conduit, http-client-multipart
Dependency ranges changed: conduit, http-client, resourcet
Files
- Network/HTTP/Client/Conduit.hs +160/−0
- Network/HTTP/Conduit.hs +46/−4
- http-conduit.cabal +9/−8
- test/main.hs +18/−6
+ Network/HTTP/Client/Conduit.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+-- | A new, experimental API to replace "Network.HTTP.Conduit".+module Network.HTTP.Client.Conduit+ ( -- * Conduit-specific interface+ withResponse+ , responseOpen+ , responseClose+ , acquireResponse+ -- * Manager helpers+ , defaultManagerSettings+ , newManager+ , withManager+ , withManagerSettings+ , newManagerSettings+ , HasHttpManager (..)+ -- * General HTTP client interface+ , module Network.HTTP.Client+ -- * Lower-level conduit functions+ , requestBodySource+ , requestBodySourceChunked+ , bodyReaderSource+ ) where++import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader (..), ReaderT (..))+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Acquire (Acquire, mkAcquire, with)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Data.Conduit (ConduitM, Producer, Source,+ await, yield, ($$+), ($$++))+import Data.Int (Int64)+import Data.IORef (newIORef, readIORef, writeIORef)+import Network.HTTP.Client hiding (closeManager,+ defaultManagerSettings, httpLbs,+ newManager, responseClose,+ responseOpen, withManager,+ withResponse, BodyReader, brRead, brConsume)+import qualified Network.HTTP.Client as H+import Network.HTTP.Client.TLS (tlsManagerSettings)++-- | Conduit powered version of 'H.withResponse'. Differences are:+--+-- * Response body is represented as a @Producer@.+--+-- * Generalized to any instance of @MonadBaseControl@, not just @IO@.+--+-- * The @Manager@ is contained by a @MonadReader@ context.+--+-- Since 2.1.0+withResponse :: (MonadBaseControl IO m, MonadIO n, MonadReader env m, HasHttpManager env)+ => Request+ -> (Response (ConduitM i ByteString n ()) -> m a)+ -> m a+withResponse req f = do+ env <- ask+ with (acquireResponse req env) f++-- | An @Acquire@ for getting a @Response@.+--+-- Since 2.1.0+acquireResponse :: (MonadIO n, MonadReader env m, HasHttpManager env)+ => Request+ -> m (Acquire (Response (ConduitM i ByteString n ())))+acquireResponse req = do+ env <- ask+ let man = getHttpManager env+ return $ do+ res <- mkAcquire (H.responseOpen req man) H.responseClose+ return $ fmap bodyReaderSource res++-- | TLS-powered manager settings.+--+-- Since 2.1.0+defaultManagerSettings :: ManagerSettings+defaultManagerSettings = tlsManagerSettings++-- | Get a new manager using 'defaultManagerSettings'.+--+-- Since 2.1.0+newManager :: MonadIO m => m Manager+newManager = newManagerSettings defaultManagerSettings++-- | Get a new manager using the given settings.+--+-- Since 2.1.0+newManagerSettings :: MonadIO m => ManagerSettings -> m Manager+newManagerSettings = liftIO . H.newManager++-- | Get a new manager with 'defaultManagerSettings' and construct a @ReaderT@ containing it.+--+-- Since 2.1.0+withManager :: MonadIO m => (ReaderT Manager m a) -> m a+withManager = withManagerSettings defaultManagerSettings++-- | Get a new manager with the given settings and construct a @ReaderT@ containing it.+--+-- Since 2.1.0+withManagerSettings :: MonadIO m => ManagerSettings -> (ReaderT Manager m a) -> m a+withManagerSettings settings (ReaderT inner) = newManagerSettings settings >>= inner++-- | Conduit-powered version of 'H.responseOpen'.+--+-- See 'withResponse' for the differences with 'H.responseOpen'.+--+-- Since 2.1.0+responseOpen :: (MonadIO m, MonadIO n, MonadReader env m, HasHttpManager env)+ => Request+ -> m (Response (ConduitM i ByteString n ()))+responseOpen req = do+ env <- ask+ liftIO $ fmap bodyReaderSource `fmap` H.responseOpen req (getHttpManager env)++-- | Generalized version of 'H.responseClose'.+--+-- Since 2.1.0+responseClose :: MonadIO m => Response body -> m ()+responseClose = liftIO . H.responseClose++class HasHttpManager a where+ getHttpManager :: a -> Manager+instance HasHttpManager Manager where+ getHttpManager = id++bodyReaderSource :: MonadIO m+ => H.BodyReader+ -> Producer m ByteString+bodyReaderSource br =+ loop+ where+ loop = do+ bs <- liftIO $ H.brRead br+ unless (S.null bs) $ do+ yield bs+ loop++requestBodySource :: Int64 -> Source IO ByteString -> RequestBody+requestBodySource size = RequestBodyStream size . srcToPopperIO++requestBodySourceChunked :: Source IO ByteString -> RequestBody+requestBodySourceChunked = RequestBodyStreamChunked . srcToPopperIO++srcToPopperIO :: Source IO ByteString -> GivesPopper ()+srcToPopperIO src f = do+ (rsrc0, ()) <- src $$+ return ()+ irsrc <- newIORef rsrc0+ let popper :: IO ByteString+ popper = do+ rsrc <- readIORef irsrc+ (rsrc', mres) <- rsrc $$++ await+ writeIORef irsrc rsrc'+ case mres of+ Nothing -> return S.empty+ Just bs+ | S.null bs -> popper+ | otherwise -> return bs+ f popper
Network/HTTP/Conduit.hs view
@@ -199,16 +199,18 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import Data.Conduit (ResumableSource, ($$+-))+import Data.Conduit (ResumableSource, ($$+-), await, ($$++), ($$+), Source)+import qualified Data.Conduit.Internal as CI 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.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Resource -import qualified Network.HTTP.Client as Client (httpLbs)-import Network.HTTP.Client.Conduit+import qualified Network.HTTP.Client as Client (httpLbs, responseOpen, responseClose)+import qualified Network.HTTP.Client.Conduit as HCC import Network.HTTP.Client.Internal (createCookieJar, destroyCookieJar) import Network.HTTP.Client.Internal (Manager, ManagerSettings,@@ -294,3 +296,43 @@ return res { responseBody = L.fromChunks bss }++http :: MonadResource m+ => Request+ -> Manager+ -> m (Response (ResumableSource m S.ByteString))+http req man = do+ (key, res) <- allocate (Client.responseOpen req man) Client.responseClose+ let rsrc = CI.ResumableSource+ (HCC.bodyReaderSource $ responseBody res)+ (release key)+ return res { responseBody = rsrc }++requestBodySource :: Int64 -> Source (ResourceT IO) S.ByteString -> RequestBody+requestBodySource size = RequestBodyStream size . srcToPopper++requestBodySourceChunked :: Source (ResourceT IO) S.ByteString -> RequestBody+requestBodySourceChunked = RequestBodyStreamChunked . srcToPopper++srcToPopper :: Source (ResourceT IO) S.ByteString -> HCC.GivesPopper ()+srcToPopper src f = runResourceT $ do+ (rsrc0, ()) <- src $$+ return ()+ irsrc <- liftIO $ newIORef rsrc0+ is <- getInternalState+ let popper :: IO S.ByteString+ popper = do+ rsrc <- readIORef irsrc+ (rsrc', mres) <- runInternalState (rsrc $$++ await) is+ writeIORef irsrc rsrc'+ case mres of+ Nothing -> return S.empty+ Just bs+ | S.null bs -> popper+ | otherwise -> return bs+ liftIO $ f popper++requestBodySourceIO :: Int64 -> Source IO S.ByteString -> RequestBody+requestBodySourceIO = HCC.requestBodySource++requestBodySourceChunkedIO :: Source IO S.ByteString -> RequestBody+requestBodySourceChunkedIO = HCC.requestBodySourceChunked
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 2.0.0.10+version: 2.1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -9,8 +9,6 @@ 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/>- .- The @Network.HTTP.Conduit.MultipartFormData@ module has been moved to <http://hackage.haskell.org/package/http-client-multipart/> category: Web, Conduit stability: Stable cabal-version: >= 1.8@@ -27,14 +25,16 @@ build-depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 , transformers >= 0.2- , resourcet >= 0.3 && < 0.5- , conduit >= 0.5.5 && < 1.1+ , resourcet >= 1.1 && < 1.2+ , conduit >= 0.5.5 && < 1.2 , http-types >= 0.7 , lifted-base >= 0.1- , http-client >= 0.2.3.1+ , http-client >= 0.3 && < 0.4 , http-client-tls- , http-client-conduit < 0.3+ , monad-control+ , mtl exposed-modules: Network.HTTP.Conduit+ Network.HTTP.Client.Conduit ghc-options: -Wall test-suite test@@ -67,7 +67,8 @@ , network-conduit >= 0.6 , http-client , http-conduit- , http-client-multipart+ , conduit-extra+ , streaming-commons source-repository head type: git
test/main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} import Test.Hspec@@ -20,7 +21,13 @@ import Network.Socket (sClose) 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.Streaming.Network (bindPortTCP, setAfterBind)+#define bindPort bindPortTCP+#else import Data.Conduit.Network (runTCPServer, serverSettings, HostPreference (..), appSink, appSource, bindPort, serverAfterBind, ServerSettings)+#endif import qualified Data.Conduit.Network import System.IO.Unsafe (unsafePerformIO) import Data.Conduit (($$), ($$+-), yield, Flush (Chunk, Flush), await)@@ -97,7 +104,7 @@ getPort :: IO Int getPort = do port <- I.atomicModifyIORef nextPort $ \p -> (p + 1, p)- esocket <- try $ bindPort port HostIPv4+ esocket <- try $ bindPort port "*4" case esocket of Left (_ :: IOException) -> getPort Right socket -> do@@ -210,7 +217,7 @@ describe "http" $ do it "response body" $ withApp app $ \port -> do withManager $ \manager -> do- req <- parseUrl $ "http://127.0.0.1:" ++ show port+ req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port res1 <- http req manager bss <- responseBody res1 $$+- CL.consume res2 <- httpLbs req manager@@ -332,7 +339,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 <- parseUrl $ "http://127.0.0.1:" ++ show port+ req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port res <- httpLbs req manager liftIO $ do Network.HTTP.Conduit.responseStatus res `shouldBe` status200@@ -365,7 +372,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 <- parseUrl $ "http://127.0.0.1:" ++ show port+ req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port res1 <- httpLbs req manager res2 <- httpLbs req manager liftIO $ res1 @?= res2@@ -397,13 +404,18 @@ _ <- http req man return () -withCApp :: Data.Conduit.Network.Application IO -> (Int -> IO ()) -> IO ()+withCApp :: (Data.Conduit.Network.AppData -> IO ()) -> (Int -> IO ()) -> IO () withCApp app' f = do port <- getPort baton <- newEmptyMVar let start = putMVar baton ()+#if MIN_VERSION_conduit(1,1,0)+ settings :: ServerSettings+ settings = setAfterBind (const start) (serverSettings port "*")+#else settings :: ServerSettings IO- settings = (serverSettings port HostAny :: ServerSettings IO) { serverAfterBind = const start }+ settings = (serverSettings port "*" :: ServerSettings IO) { serverAfterBind = const start }+#endif bracket (forkIO $ runTCPServer settings app' `onException` start) killThread