Skip to content

Commit 35a5fd7

Browse files
erikderikd
committed
Use latest conduit version
1 parent cfc7306 commit 35a5fd7

File tree

6 files changed

+65
-52
lines changed

6 files changed

+65
-52
lines changed

‎.travis.yml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,9 +5,10 @@ os: linux
55
dist: xenial
66

77
env:
8-
- GHCVER=7.10.3
98
- GHCVER=8.0.2
109
- GHCVER=8.2.2
10+
- GHCVER=8.4.4
11+
- GHCVER=8.6.4
1112

1213
before_install:
1314
- sudo add-apt-repository -y ppa:hvr/ghc

‎Network/HTTP/Proxy.hs‎

Lines changed: 15 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -45,9 +45,12 @@ import Blaze.ByteString.Builder (fromByteString)
4545
import Control.Concurrent.Async (race_)
4646
import Control.Exception -- (SomeException, catch, toException)
4747
import Data.ByteString.Char8 (ByteString)
48-
import Data.Conduit (Flush (..), Sink, Source, ($$), mapOutput, yield)
48+
import Data.Conduit (ConduitT, Flush (..), (.|), mapOutput, runConduit, yield)
4949
import Data.Conduit.Network
50-
import Data.Monoid
50+
#if ! MIN_VERSION_base(4,11,0)
51+
import Data.Monoid ((<>))
52+
#endif
53+
import Data.Void (Void)
5154
import Network.Socket
5255
import Network.Wai.Conduit hiding (Request, requestMethod)
5356

@@ -194,7 +197,13 @@ doUpstreamRequest settings mgr respond mwreq
194197
errorResponse = proxyOnException settings . toException
195198

196199

197-
handleConnect :: Wai.Request -> Source IO BS.ByteString -> Sink BS.ByteString IO () -> IO ()
200+
-- handleConnect :: Wai.Request -> ConduitT IO BS.ByteString -> ConduitT BS.ByteString IO () -> IO ()
201+
202+
handleConnect :: Wai.Request
203+
-> ConduitT () ByteString IO ()
204+
-> ConduitT ByteString Void IO a
205+
-> IO ()
206+
198207
handleConnect wreq fromClient toClient = do
199208
let (host, port) =
200209
case BS.break (== ':') $ Wai.rawPathInfo wreq of
@@ -205,7 +214,7 @@ handleConnect wreq fromClient toClient = do
205214
Nothing -> (x, 80)
206215
settings = clientSettings port host
207216
runTCPClient settings $ \ad -> do
208-
yield "HTTP/1.1 200 OK\r\n\r\n" $$ toClient
217+
_ <- runConduit $ yield "HTTP/1.1 200 OK\r\n\r\n" .| toClient
209218
race_
210-
(fromClient $$ NC.appSink ad)
211-
(NC.appSource ad $$ toClient)
219+
(runConduit $ fromClient .| NC.appSink ad)
220+
(runConduit $ NC.appSource ad .| toClient)

‎http-proxy.cabal‎

Lines changed: 21 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -35,29 +35,27 @@ library
3535
Network.HTTP.Proxy.Request
3636

3737
build-depends: base >= 4 && < 5
38-
, async >= 2.0
39-
, blaze-builder >= 0.4
40-
, bytestring >= 0.10
41-
, bytestring-lexing >= 0.4
42-
, case-insensitive >= 1.2
43-
, conduit >= 1.2
44-
, conduit-extra >= 1.1 && < 1.3
45-
, http-client
46-
-- More recent versions seem to have broken proxy support.
47-
, http-conduit >= 2.1.11 && < 2.2
48-
, http-types >= 0.8
49-
, mtl >= 2.1
50-
, network == 2.7.*
51-
, resourcet >= 1.1
52-
-- Not used directly but necessary to enforce < 0.2
53-
, streaming-commons >= 0.1 && < 0.2
54-
, tls >= 1.2
55-
, text >= 1.2
56-
, transformers >= 0.3
57-
, wai >= 3.2
58-
, wai-conduit >= 3.0
59-
, warp >= 3.0
60-
, warp-tls >= 3.0
38+
, async == 2.2.*
39+
, blaze-builder == 0.4.*
40+
, bytestring == 0.10.*
41+
, bytestring-lexing == 0.5.*
42+
, case-insensitive == 1.2.*
43+
, conduit == 1.3.*
44+
, conduit-extra == 1.3.*
45+
, http-client == 0.6.*
46+
, http-conduit == 2.3.*
47+
, http-types == 0.12.*
48+
, mtl == 2.2.*
49+
, network == 2.8.*
50+
, resourcet == 1.2.*
51+
, streaming-commons == 0.2.*
52+
, tls == 1.4.*
53+
, text == 1.2.*
54+
, transformers == 0.5.*
55+
, wai == 3.2.*
56+
, wai-conduit == 3.0.*
57+
, warp == 3.2.*
58+
, warp-tls == 3.2.*
6159

6260

6361

‎test/Test/TestServer.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
{-# LANGUAGE OverloadedStrings #-}
1+
{-# LANGUAGE CPP, OverloadedStrings #-}
22
------------------------------------------------------------
33
-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
44
-- License : BSD3
@@ -10,8 +10,11 @@ module Test.TestServer
1010
) where
1111

1212
import Data.ByteString (ByteString)
13+
import Data.Conduit (ConduitT)
1314
import Data.List (sort)
14-
import Data.Monoid
15+
#if ! MIN_VERSION_base(4,11,0)
16+
import Data.Monoid ((<>))
17+
#endif
1518
import Data.String
1619
import Network.HTTP.Types
1720
import Network.Wai
@@ -20,7 +23,7 @@ import Network.Wai.Handler.Warp
2023
import Network.Wai.Handler.WarpTLS
2124

2225
import Data.ByteString.Lex.Integral (readDecimal_)
23-
import Data.Conduit (($$))
26+
import Data.Conduit ((.|))
2427
import Data.Int (Int64)
2528

2629
import qualified Data.ByteString.Char8 as BS
@@ -97,9 +100,9 @@ responseBody req =
97100
]
98101

99102

100-
largePostCheck :: Int64 -> DC.Source IO ByteString -> IO Response
103+
largePostCheck :: Int64 -> ConduitT () ByteString IO () -> IO Response
101104
largePostCheck len rbody =
102-
maybe success failure <$> (rbody $$ byteSink len)
105+
maybe success failure <$> (DC.runConduit $ rbody .| byteSink len)
103106
where
104107
success = simpleResponse status200 . BS.pack $ "Post-size: " ++ show len
105108
failure = simpleResponse status500

‎test/Test/Util.hs‎

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,9 @@ import Blaze.ByteString.Builder
1010
import Control.Concurrent.Async
1111
import Control.Exception hiding (assert)
1212
import Control.Monad (forM_, when, unless)
13-
import Control.Monad.Trans.Resource
13+
import Control.Monad.Trans.Resource (runResourceT)
1414
import Data.ByteString (ByteString)
15+
import Data.Conduit (ConduitT, Flush (..), SealedConduitT)
1516
import Data.Int (Int64)
1617
import Data.Maybe
1718
import Data.String (fromString)
@@ -156,14 +157,14 @@ httpRun req = do
156157
runResourceT $ do
157158
resp <- HC.http (modifyRequest req) mgr
158159
let contentLen = readInt64 <$> lookup HT.hContentLength (HC.responseHeaders resp)
159-
bodyText <- checkBodySize (HC.responseBody resp) contentLen
160+
bodyText <- checkBodySize (DC.sealConduitT $ HC.responseBody resp) contentLen
160161
return $ Result (HC.secure req) (HT.statusCode $ HC.responseStatus resp)
161162
(HC.responseHeaders resp) bodyText
162163
where
163164
modifyRequest r = r { HC.redirectCount = 0 }
164165

165166

166-
checkBodySize :: (Monad f, Functor f) => DC.ResumableSource f ByteString -> Maybe Int64 -> f ByteString
167+
checkBodySize :: Monad f => SealedConduitT () ByteString f () -> Maybe Int64 -> f ByteString
167168
checkBodySize bodySrc Nothing = fmap (BS.concat . LBS.toChunks) $ bodySrc DC.$$+- CB.take 1000
168169
checkBodySize bodySrc (Just len) = do
169170
let blockSize = 1000
@@ -172,13 +173,13 @@ checkBodySize bodySrc (Just len) = do
172173
else fromMaybe "Success" <$> (bodySrc DC.$$+- byteSink len)
173174

174175

175-
byteSink :: Monad m => Int64 -> DC.Sink ByteString m (Maybe ByteString)
176+
byteSink :: Monad m => Int64 -> ConduitT ByteString a m (Maybe ByteString)
176177
byteSink bytes = sink 0
177178
where
178-
sink :: Monad m => Int64 -> DC.Sink ByteString m (Maybe ByteString)
179+
sink :: Monad m => Int64 -> ConduitT ByteString a m (Maybe ByteString)
179180
sink !count = DC.await >>= maybe (closeSink count) (sinkBlock count)
180181

181-
sinkBlock :: Monad m => Int64 -> ByteString -> DC.Sink ByteString m (Maybe ByteString)
182+
sinkBlock :: Monad m => Int64 -> ByteString -> ConduitT ByteString a m (Maybe ByteString)
182183
sinkBlock !count bs = sink (count + fromIntegral (BS.length bs))
183184

184185
closeSink :: Monad m => Int64 -> m (Maybe ByteString)
@@ -189,14 +190,14 @@ byteSink bytes = sink 0
189190
++ " should have been " ++ show bytes ++ "."
190191

191192

192-
builderSource :: Monad m => Int64 -> DC.Source m (DC.Flush Builder)
193-
builderSource = DC.mapOutput (DC.Chunk . fromByteString) . byteSource
193+
builderSource :: Monad m => Int64 -> ConduitT () (Flush Builder) m ()
194+
builderSource = DC.mapOutput (Chunk . fromByteString) . byteSource
194195

195196

196-
byteSource :: Monad m => Int64 -> DC.Source m ByteString
197+
byteSource :: Monad m => Int64 -> ConduitT i ByteString m ()
197198
byteSource bytes = loop 0
198199
where
199-
loop :: Monad m => Int64 -> DC.Source m ByteString
200+
loop :: Monad m => Int64 -> ConduitT i ByteString m ()
200201
loop !count
201202
| count >= bytes = return ()
202203
| count + blockSize64 < bytes = do
@@ -205,7 +206,7 @@ byteSource bytes = loop 0
205206
| otherwise = do
206207
let n = fromIntegral $ bytes - count
207208
DC.yield $ BS.take n bsbytes
208-
return ()
209+
pure ()
209210

210211
blockSize = 8192 :: Int
211212
blockSize64 = fromIntegral blockSize :: Int64

‎test/test-io.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,11 @@
88
import Control.Concurrent.Async
99
import Control.Exception
1010
import Control.Monad
11-
import Control.Monad.Trans.Resource
1211
import Data.Conduit
1312
import Data.Int (Int64)
14-
import Data.Monoid
13+
#if ! MIN_VERSION_base(4,11,0)
14+
import Data.Monoid ((<>))
15+
#endif
1516
import System.Environment
1617
import Test.Hspec
1718

@@ -57,12 +58,12 @@ testHelpersTest =
5758
-- Test the HTTP and HTTPS servers directly (ie bypassing the Proxy).
5859
describe "Test helper functionality:" $ do
5960
it "Byte Sink catches short response bodies." $
60-
runResourceT (byteSource 80 $$ byteSink 100)
61+
runConduit (byteSource 80 .| byteSink 100)
6162
`shouldReturn` Just "Error : Body length 80 should have been 100."
6263
it "Byte Source and Sink work in constant memory." $
63-
runResourceT (byteSource oneBillion $$ byteSink oneBillion) `shouldReturn` Nothing
64+
runConduit (byteSource oneBillion .| byteSink oneBillion) `shouldReturn` Nothing
6465
it "Byte Sink catches long response bodies." $
65-
runResourceT (byteSource 110 $$ byteSink 100)
66+
runConduit (byteSource 110 .| byteSink 100)
6667
`shouldReturn` Just "Error : Body length 110 should have been 100."
6768
it "Client and server can stream GET response." $ do
6869
let size = oneBillion
@@ -143,7 +144,7 @@ requestTest = describe "Request:" $ do
143144
-- Getting a TlsException shows that we have successfully upgraded
144145
-- from HTTP to HTTPS. Its not possible to ignore this failure
145146
-- because its made by the http-conduit inside the proxy.
146-
BS.takeWhile (/= ' ') (resultBS result) `shouldBe` "TlsExceptionHostPort"
147+
BS.takeWhile (/= ' ') (resultBS result) `shouldBe` "HttpExceptionRequest"
147148
it "Can provide a proxy Response." $
148149
withTestProxy proxySettingsProxyResponse $ \ testProxyPort -> do
149150
req <- addTestProxy testProxyPort <$> mkGetRequest Http "/whatever"

0 commit comments

Comments
 (0)