summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2014-06-09 10:18:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-06-09 10:18:00 (GMT)
commita7ae563c0df85ce11df719bc3268932942dbfd34 (patch)
treeb01078cb6954526760d0df11fc21c3017f7f67b7
parent4d7e8e83514b3038ab15c4daf834fb81b3061d6a (diff)
version 2.1.2.12.1.2.1
-rw-r--r--http-conduit.cabal7
-rw-r--r--test/main.hs25
2 files changed, 21 insertions, 11 deletions
diff --git a/http-conduit.cabal b/http-conduit.cabal
index 3389aef..b75e332 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,5 +1,5 @@
name: http-conduit
-version: 2.1.2
+version: 2.1.2.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@@ -60,8 +60,9 @@ test-suite test
, case-insensitive
, lifted-base
, network
- , wai >= 2.0 && < 2.2
- , warp >= 2.0 && < 2.2
+ , wai >= 3.0 && < 3.1
+ , warp >= 3.0 && < 3.1
+ , wai-conduit
, http-types
, cookie
, network-conduit >= 0.6
diff --git a/test/main.hs b/test/main.hs
index 9a8acf2..7c631aa 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -7,6 +7,7 @@ import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.Char8 as L8
import Test.HUnit
import Network.Wai hiding (requestBody)
+import Network.Wai.Conduit (responseSource, sourceRequestBody)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort, settingsBeforeMainLoop)
import Network.HTTP.Conduit hiding (port)
@@ -72,7 +73,7 @@ cookie = Cookie { cookie_name = "key"
cookie_jar :: CookieJar
cookie_jar = createCookieJar [cookie]
-app :: Application
+app :: Wai.Request -> IO Wai.Response
app req =
case pathInfo req of
[] ->
@@ -112,10 +113,10 @@ getPort = do
sClose socket
return port
-withApp :: Application -> (Int -> IO ()) -> IO ()
+withApp :: (Wai.Request -> IO Wai.Response) -> (Int -> IO ()) -> IO ()
withApp app' f = withApp' (const app') f
-withApp' :: (Int -> Application) -> (Int -> IO ()) -> IO ()
+withApp' :: (Int -> Wai.Request -> IO Wai.Response) -> (Int -> IO ()) -> IO ()
withApp' app' f = do
port <- getPort
baton <- newEmptyMVar
@@ -123,14 +124,18 @@ withApp' app' f = do
(forkIO $ runSettings defaultSettings
{ settingsPort = port
, settingsBeforeMainLoop = putMVar baton ()
- } (app' port) `onException` putMVar baton ())
+ } (app'' port) `onException` putMVar baton ())
killThread
(const $ takeMVar baton >> f port)
+ where
+ app'' port req sendResponse = do
+ res <- app' port req
+ sendResponse res
-withAppTls :: Application -> (Int -> IO ()) -> IO ()
+withAppTls :: (Wai.Request -> IO Wai.Response) -> (Int -> IO ()) -> IO ()
withAppTls app' f = withAppTls' (const app') f
-withAppTls' :: (Int -> Application) -> (Int -> IO ()) -> IO ()
+withAppTls' :: (Int -> Wai.Request -> IO Wai.Response) -> (Int -> IO ()) -> IO ()
withAppTls' app' f = do
port <- getPort
baton <- newEmptyMVar
@@ -138,9 +143,13 @@ withAppTls' app' f = do
(forkIO $ WT.runTLS WT.defaultTlsSettings defaultSettings
{ settingsPort = port
, settingsBeforeMainLoop = putMVar baton ()
- } (app' port) `onException` putMVar baton ())
+ } (app'' port) `onException` putMVar baton ())
killThread
(const $ takeMVar baton >> f port)
+ where
+ app'' port req sendResponse = do
+ res <- app' port req
+ sendResponse res
main :: IO ()
main = withSocketsDo $ do
@@ -471,7 +480,7 @@ redir =
echo :: (Int -> IO ()) -> IO ()
echo = withApp $ \req -> do
- bss <- Wai.requestBody req $$ CL.consume
+ bss <- sourceRequestBody req $$ CL.consume
return $ responseLBS status200 [] $ L.fromChunks bss
noStatusMessage :: (Int -> IO ()) -> IO ()