summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2014-04-02 10:37:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-04-02 10:37:00 (GMT)
commit9557c729b60b9568a393682b50a87f298e8f4b70 (patch)
tree0bad1dfbb0ba34d71f68a696a15521d6b272605d
parent443d552a098d9d7d027142b17ad0a3cb774cb60c (diff)
version 2.0.0.102.0.0.10
-rw-r--r--Network/HTTP/Client/Conduit.hs160
-rw-r--r--Network/HTTP/Conduit.hs50
-rw-r--r--http-conduit.cabal17
-rw-r--r--test/main.hs24
4 files changed, 18 insertions, 233 deletions
diff --git a/Network/HTTP/Client/Conduit.hs b/Network/HTTP/Client/Conduit.hs
deleted file mode 100644
index a2bbf3e..0000000
--- a/Network/HTTP/Client/Conduit.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-{-# 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
diff --git a/Network/HTTP/Conduit.hs b/Network/HTTP/Conduit.hs
index 59804bd..2c252c4 100644
--- a/Network/HTTP/Conduit.hs
+++ b/Network/HTTP/Conduit.hs
@@ -199,18 +199,16 @@ module Network.HTTP.Conduit
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
-import Data.Conduit (ResumableSource, ($$+-), await, ($$++), ($$+), Source)
-import qualified Data.Conduit.Internal as CI
+import Data.Conduit (ResumableSource, ($$+-))
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, responseOpen, responseClose)
-import qualified Network.HTTP.Client.Conduit as HCC
+import qualified Network.HTTP.Client as Client (httpLbs)
+import Network.HTTP.Client.Conduit
import Network.HTTP.Client.Internal (createCookieJar,
destroyCookieJar)
import Network.HTTP.Client.Internal (Manager, ManagerSettings,
@@ -296,43 +294,3 @@ lbsResponse res = do
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
diff --git a/http-conduit.cabal b/http-conduit.cabal
index 68792b5..b2baf01 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,5 +1,5 @@
name: http-conduit
-version: 2.1.0
+version: 2.0.0.10
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@@ -9,6 +9,8 @@ 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/>
+ .
+ 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
@@ -25,16 +27,14 @@ library
build-depends: base >= 4 && < 5
, bytestring >= 0.9.1.4
, transformers >= 0.2
- , resourcet >= 1.1 && < 1.2
- , conduit >= 0.5.5 && < 1.2
+ , resourcet >= 0.3 && < 0.5
+ , conduit >= 0.5.5 && < 1.1
, http-types >= 0.7
, lifted-base >= 0.1
- , http-client >= 0.3 && < 0.4
+ , http-client >= 0.2.3.1
, http-client-tls
- , monad-control
- , mtl
+ , http-client-conduit < 0.3
exposed-modules: Network.HTTP.Conduit
- Network.HTTP.Client.Conduit
ghc-options: -Wall
test-suite test
@@ -67,8 +67,7 @@ test-suite test
, network-conduit >= 0.6
, http-client
, http-conduit
- , conduit-extra
- , streaming-commons
+ , http-client-multipart
source-repository head
type: git
diff --git a/test/main.hs b/test/main.hs
index 6e30c08..430633b 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Test.Hspec
@@ -21,13 +20,7 @@ import Network (withSocketsDo)
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)
@@ -104,7 +97,7 @@ nextPort = unsafePerformIO $ I.newIORef 15452
getPort :: IO Int
getPort = do
port <- I.atomicModifyIORef nextPort $ \p -> (p + 1, p)
- esocket <- try $ bindPort port "*4"
+ esocket <- try $ bindPort port HostIPv4
case esocket of
Left (_ :: IOException) -> getPort
Right socket -> do
@@ -217,7 +210,7 @@ main = withSocketsDo $ do
describe "http" $ do
it "response body" $ withApp app $ \port -> do
withManager $ \manager -> do
- req <- liftIO $ parseUrl $ "http://127.0.0.1:" ++ show port
+ req <- parseUrl $ "http://127.0.0.1:" ++ show port
res1 <- http req manager
bss <- responseBody res1 $$+- CL.consume
res2 <- httpLbs req manager
@@ -339,7 +332,7 @@ main = withSocketsDo $ do
["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 <- parseUrl $ "http://127.0.0.1:" ++ show port
res <- httpLbs req manager
liftIO $ do
Network.HTTP.Conduit.responseStatus res `shouldBe` status200
@@ -372,7 +365,7 @@ main = withSocketsDo $ do
_ <- 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 <- parseUrl $ "http://127.0.0.1:" ++ show port
res1 <- httpLbs req manager
res2 <- httpLbs req manager
liftIO $ res1 @?= res2
@@ -404,18 +397,13 @@ main = withSocketsDo $ do
_ <- http req man
return ()
-withCApp :: (Data.Conduit.Network.AppData -> IO ()) -> (Int -> IO ()) -> IO ()
+withCApp :: Data.Conduit.Network.Application 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 "*" :: ServerSettings IO) { serverAfterBind = const start }
-#endif
+ settings = (serverSettings port HostAny :: ServerSettings IO) { serverAfterBind = const start }
bracket
(forkIO $ runTCPServer settings app' `onException` start)
killThread