diff --git a/HTTP.cabal b/HTTP.cabal --- a/HTTP.cabal +++ b/HTTP.cabal @@ -1,5 +1,5 @@ Name: HTTP -Version: 4000.2.18 +Version: 4000.2.19 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3 @@ -98,28 +98,23 @@ -- note the test harness constraints should be kept in sync with these -- where dependencies are shared - Build-depends: base >= 3.0.3.1 && < 4.8, parsec >= 2.0 && < 3.2 - Build-depends: array >= 0.2.0.0 && < 0.6, old-time >= 1.0.0.0 && < 1.2, bytestring >= 0.9.1.3 && < 0.11 + Build-depends: base >= 4.3.0.0 && < 4.9, parsec >= 2.0 && < 3.2 + Build-depends: array >= 0.3.0.2 && < 0.6, old-time >= 1.0.0.0 && < 1.2, bytestring >= 0.9.1.5 && < 0.11 Extensions: FlexibleInstances if flag(mtl1) - Build-depends: mtl >= 1.1.0.0 && < 1.2 + Build-depends: mtl >= 1.1.1.0 && < 1.2 CPP-Options: -DMTL1 else Build-depends: mtl >= 2.0 && < 2.3 - if impl(ghc<6.12) - -- clients get a "no buffering" error with - -- GHC 6.10 and later versions of network - Build-depends: network >= 2.2.0.1 && < 2.3 + if flag(network-uri) + Build-depends: network-uri == 2.6.*, network == 2.6.* else - if flag(network-uri) - Build-depends: network-uri == 2.6.*, network == 2.6.* - else - Build-depends: network >= 2.2.0.1 && < 2.6 + Build-depends: network >= 2.2.1.5 && < 2.6 - build-tools: ghc >= 6.10 && < 7.10 + build-tools: ghc >= 7.0 && < 7.12 if flag(warn-as-error) ghc-options: -Werror @@ -130,7 +125,7 @@ Test-Suite test type: exitcode-stdio-1.0 - build-tools: ghc >= 6.10 && < 7.10 + build-tools: ghc >= 7.0 && < 7.12 hs-source-dirs: test main-is: httpTests.hs @@ -144,34 +139,34 @@ build-depends: HTTP, HUnit >= 1.2.0.1 && < 1.3, httpd-shed >= 0.4 && < 0.5, - mtl >= 1.1.0.0 && < 2.3, - bytestring >= 0.9.1.3 && < 0.11, - deepseq >= 1.3.0.0 && < 1.4, + mtl >= 1.1.1.0 && < 2.3, + bytestring >= 0.9.1.5 && < 0.11, + deepseq >= 1.3.0.0 && < 1.5, pureMD5 >= 0.2.4 && < 2.2, - base >= 3.0.3.1 && < 4.8, + base >= 4.3.0.0 && < 4.9, split >= 0.1.3 && < 0.3, test-framework >= 0.2.0 && < 0.9, - test-framework-hunit >= 0.2.0 && <0.4 + test-framework-hunit >= 0.3.0 && <0.4 if flag(network-uri) Build-depends: network-uri == 2.6.*, network == 2.6.* else - Build-depends: network >= 2.2.0.1 && < 2.6 + Build-depends: network >= 2.2.1.5 && < 2.6 if flag(warp-tests) CPP-Options: -DWARP_TESTS build-depends: case-insensitive >= 0.4.0.1 && < 1.3, http-types >= 0.8.0 && < 0.9, - wai >= 2.1.0 && < 2.2, - warp >= 2.1.0 && < 2.2 + wai >= 2.1.0 && < 3.1, + warp >= 2.1.0 && < 3.1 if flag(conduit10) build-depends: conduit >= 1.0.8 && < 1.1 else build-depends: - conduit >= 1.1 && < 1.2, + conduit >= 1.1 && < 1.3, conduit-extra >= 1.1 && < 1.2 diff --git a/test/Httpd.hs b/test/Httpd.hs --- a/test/Httpd.hs +++ b/test/Httpd.hs @@ -16,11 +16,12 @@ import Control.DeepSeq import Control.Monad import Control.Monad.Trans ( liftIO ) -import Data.ByteString as B ( empty, concat, length, ByteString ) -import Data.ByteString.Char8 as BC ( pack, unpack ) -import Data.ByteString.Lazy.Char8 as BLC ( pack ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy.Char8 as BLC #ifdef WARP_TESTS -import qualified Data.CaseInsensitive as CI ( mk, original ) +import qualified Data.CaseInsensitive as CI #endif import Data.Maybe ( fromJust ) import Network.URI ( URI, parseRelativeReference ) @@ -28,7 +29,7 @@ import Network.Socket ( getAddrInfo, AddrInfo, defaultHints, addrAddress, addrFamily , addrFlags, addrSocketType, AddrInfoFlag(AI_PASSIVE), socket, Family(AF_UNSPEC,AF_INET6) - , defaultProtocol, SocketType(Stream), listen, setSocketOption + , defaultProtocol, SocketType(Stream), listen, setSocketOption, SocketOption(ReuseAddr) ) #ifdef WARP_TESTS #if MIN_VERSION_network(2,4,0) @@ -43,13 +44,13 @@ , reqMethod, reqURI, reqHeaders, reqBody ) #ifdef WARP_TESTS +#if !MIN_VERSION_wai(3,0,0) import qualified Data.Conduit.Lazy as Warp - ( lazyConsume ) +#endif + import qualified Network.HTTP.Types as Warp ( Status(..) ) import qualified Network.Wai as Warp - ( Request(requestMethod, requestHeaders, rawPathInfo, requestBody) - , responseLBS ) import qualified Network.Wai.Handler.Warp as Warp ( runSettingsSocket, defaultSettings, setPort ) #endif @@ -114,12 +115,20 @@ [] -> fail "Couldn't obtain address information in warp" (addri:_) -> do sock <- socket (addrFamily addri) Stream defaultProtocol + setSocketOption sock ReuseAddr 1 bind sock (addrAddress addri) listen sock 5 +#if MIN_VERSION_wai(3,0,0) + Warp.runSettingsSocket (Warp.setPort port Warp.defaultSettings) sock $ \warpRequest warpRespond -> do + request <- requestFromWarp warpRequest + response <- handler request + warpRespond (responseToWarp response) +#else Warp.runSettingsSocket (Warp.setPort port Warp.defaultSettings) sock $ \warpRequest -> do request <- requestFromWarp warpRequest response <- handler request return (responseToWarp response) +#endif where responseToWarp (Response status hdrs body) = Warp.responseLBS @@ -130,8 +139,12 @@ headerFromWarp (name, value) = (BC.unpack (CI.original name), BC.unpack value) requestFromWarp request = do - body <- Warp.lazyConsume (Warp.requestBody request) +#if MIN_VERSION_wai(3,0,1) + body <- fmap BLC.unpack $ Warp.strictRequestBody request +#else + body <- fmap BLC.unpack $ Warp.lazyRequestBody request body `deepseq` return () +#endif return $ Request { @@ -140,6 +153,6 @@ BC.unpack . Warp.rawPathInfo $ request, reqHeaders = map headerFromWarp (Warp.requestHeaders request), - reqBody = BC.unpack (B.concat body) + reqBody = body } #endif