Skip to content

Commit

Permalink
Use latest conduit version
Browse files Browse the repository at this point in the history
  • Loading branch information
@erikd
erikd committed Apr 3, 2019
1 parent cfc7306 commit 35a5fd7
Show file tree
Hide file tree
Showing 6 changed files with 65 additions and 52 deletions.
3 changes: 2 additions & 1 deletion .travis.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,10 @@ os: linux
dist: xenial

env:
- GHCVER=7.10.3
- GHCVER=8.0.2
- GHCVER=8.2.2
- GHCVER=8.4.4
- GHCVER=8.6.4

before_install:
- sudo add-apt-repository -y ppa:hvr/ghc
Expand Down
21 changes: 15 additions & 6 deletions Network/HTTP/Proxy.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,9 +45,12 @@ import Blaze.ByteString.Builder (fromByteString)
import Control.Concurrent.Async (race_)
import Control.Exception -- (SomeException, catch, toException)
import Data.ByteString.Char8 (ByteString)
import Data.Conduit (Flush (..), Sink, Source, ($$), mapOutput, yield)
import Data.Conduit (ConduitT, Flush (..), (.|), mapOutput, runConduit, yield)
import Data.Conduit.Network
import Data.Monoid
#if ! MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Void (Void)
import Network.Socket
import Network.Wai.Conduit hiding (Request, requestMethod)

Expand Down Expand Up @@ -194,7 +197,13 @@ doUpstreamRequest settings mgr respond mwreq
errorResponse = proxyOnException settings . toException


handleConnect :: Wai.Request -> Source IO BS.ByteString -> Sink BS.ByteString IO () -> IO ()
-- handleConnect :: Wai.Request -> ConduitT IO BS.ByteString -> ConduitT BS.ByteString IO () -> IO ()

handleConnect :: Wai.Request
-> ConduitT () ByteString IO ()
-> ConduitT ByteString Void IO a
-> IO ()

handleConnect wreq fromClient toClient = do
let (host, port) =
case BS.break (== ':') $ Wai.rawPathInfo wreq of
Expand All @@ -205,7 +214,7 @@ handleConnect wreq fromClient toClient = do
Nothing -> (x, 80)
settings = clientSettings port host
runTCPClient settings $ \ad -> do
yield "HTTP/1.1 200 OK\r\n\r\n" $$ toClient
_ <- runConduit $ yield "HTTP/1.1 200 OK\r\n\r\n" .| toClient
race_
(fromClient $$ NC.appSink ad)
(NC.appSource ad $$ toClient)
(runConduit $ fromClient .| NC.appSink ad)
(runConduit $ NC.appSource ad .| toClient)
44 changes: 21 additions & 23 deletions http-proxy.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,29 +35,27 @@ library
Network.HTTP.Proxy.Request

build-depends: base >= 4 && < 5
, async >= 2.0
, blaze-builder >= 0.4
, bytestring >= 0.10
, bytestring-lexing >= 0.4
, case-insensitive >= 1.2
, conduit >= 1.2
, conduit-extra >= 1.1 && < 1.3
, http-client
-- More recent versions seem to have broken proxy support.
, http-conduit >= 2.1.11 && < 2.2
, http-types >= 0.8
, mtl >= 2.1
, network == 2.7.*
, resourcet >= 1.1
-- Not used directly but necessary to enforce < 0.2
, streaming-commons >= 0.1 && < 0.2
, tls >= 1.2
, text >= 1.2
, transformers >= 0.3
, wai >= 3.2
, wai-conduit >= 3.0
, warp >= 3.0
, warp-tls >= 3.0
, async == 2.2.*
, blaze-builder == 0.4.*
, bytestring == 0.10.*
, bytestring-lexing == 0.5.*
, case-insensitive == 1.2.*
, conduit == 1.3.*
, conduit-extra == 1.3.*
, http-client == 0.6.*
, http-conduit == 2.3.*
, http-types == 0.12.*
, mtl == 2.2.*
, network == 2.8.*
, resourcet == 1.2.*
, streaming-commons == 0.2.*
, tls == 1.4.*
, text == 1.2.*
, transformers == 0.5.*
, wai == 3.2.*
, wai-conduit == 3.0.*
, warp == 3.2.*
, warp-tls == 3.2.*



Expand Down
13 changes: 8 additions & 5 deletions test/Test/TestServer.hs
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP, OverloadedStrings #-}
------------------------------------------------------------
-- Copyright : Erik de Castro Lopo <[email protected]>
-- License : BSD3
Expand All @@ -10,8 +10,11 @@ module Test.TestServer
) where

import Data.ByteString (ByteString)
import Data.Conduit (ConduitT)
import Data.List (sort)
import Data.Monoid
#if ! MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.String
import Network.HTTP.Types
import Network.Wai
Expand All @@ -20,7 +23,7 @@ import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS

import Data.ByteString.Lex.Integral (readDecimal_)
import Data.Conduit (($$))
import Data.Conduit ((.|))
import Data.Int (Int64)

import qualified Data.ByteString.Char8 as BS
Expand Down Expand Up @@ -97,9 +100,9 @@ responseBody req =
]


largePostCheck :: Int64 -> DC.Source IO ByteString -> IO Response
largePostCheck :: Int64 -> ConduitT () ByteString IO () -> IO Response
largePostCheck len rbody =
maybe success failure <$> (rbody $$ byteSink len)
maybe success failure <$> (DC.runConduit $ rbody .| byteSink len)
where
success = simpleResponse status200 . BS.pack $ "Post-size: " ++ show len
failure = simpleResponse status500
23 changes: 12 additions & 11 deletions test/Test/Util.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,9 @@ import Blaze.ByteString.Builder
import Control.Concurrent.Async
import Control.Exception hiding (assert)
import Control.Monad (forM_, when, unless)
import Control.Monad.Trans.Resource
import Control.Monad.Trans.Resource (runResourceT)
import Data.ByteString (ByteString)
import Data.Conduit (ConduitT, Flush (..), SealedConduitT)
import Data.Int (Int64)
import Data.Maybe
import Data.String (fromString)
Expand Down Expand Up @@ -156,14 +157,14 @@ httpRun req = do
runResourceT $ do
resp <- HC.http (modifyRequest req) mgr
let contentLen = readInt64 <$> lookup HT.hContentLength (HC.responseHeaders resp)
bodyText <- checkBodySize (HC.responseBody resp) contentLen
bodyText <- checkBodySize (DC.sealConduitT $ HC.responseBody resp) contentLen
return $ Result (HC.secure req) (HT.statusCode $ HC.responseStatus resp)
(HC.responseHeaders resp) bodyText
where
modifyRequest r = r { HC.redirectCount = 0 }


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


byteSink :: Monad m => Int64 -> DC.Sink ByteString m (Maybe ByteString)
byteSink :: Monad m => Int64 -> ConduitT ByteString a m (Maybe ByteString)
byteSink bytes = sink 0
where
sink :: Monad m => Int64 -> DC.Sink ByteString m (Maybe ByteString)
sink :: Monad m => Int64 -> ConduitT ByteString a m (Maybe ByteString)
sink !count = DC.await >>= maybe (closeSink count) (sinkBlock count)

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

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


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


byteSource :: Monad m => Int64 -> DC.Source m ByteString
byteSource :: Monad m => Int64 -> ConduitT i ByteString m ()
byteSource bytes = loop 0
where
loop :: Monad m => Int64 -> DC.Source m ByteString
loop :: Monad m => Int64 -> ConduitT i ByteString m ()
loop !count
| count >= bytes = return ()
| count + blockSize64 < bytes = do
Expand All @@ -205,7 +206,7 @@ byteSource bytes = loop 0
| otherwise = do
let n = fromIntegral $ bytes - count
DC.yield $ BS.take n bsbytes
return ()
pure ()

blockSize = 8192 :: Int
blockSize64 = fromIntegral blockSize :: Int64
Expand Down
13 changes: 7 additions & 6 deletions test/test-io.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,10 +8,11 @@
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import Control.Monad.Trans.Resource
import Data.Conduit
import Data.Int (Int64)
import Data.Monoid
#if ! MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import System.Environment
import Test.Hspec

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

0 comments on commit 35a5fd7

Please sign in to comment.