master..eb33f4b · typeable/wai

.azure/azure-linux-template.yml+22−8

since splitsnapshots

unifiedsplit

@@ -5,6 +5,16 @@ jobs:

5 vmImage: ${{ parameters.vmImage }}

6 strategy:

7 matrix:

8+ stack-def:

9+ BUILD: stack

10+ stack-lts-6:

11+ BUILD: stack

12+ STACK_YAML: stack-lts-6.yaml

13+ ARGS: "--resolver lts-6"

14+ stack-lts-9:

15+ BUILD: stack

16+ STACK_YAML: stack-lts-9.yaml

17+ ARGS: "--resolver lts-9"

8 stack-lts-11:

18 stack-lts-11:

9 BUILD: stack

19 BUILD: stack

10 STACK_YAML: stack-lts-11.yaml

20 STACK_YAML: stack-lts-11.yaml

@@ -13,13 +23,17 @@ jobs:

13 BUILD: stack

23 BUILD: stack

14 STACK_YAML: stack-lts-12.yaml

24 STACK_YAML: stack-lts-12.yaml

15 ARGS: "--resolver lts-12"

25 ARGS: "--resolver lts-12"

16− stack-lts-14:

26+ stack-lts-13:

17 BUILD: stack

27 BUILD: stack

18− ARGS: "--resolver lts-14"

28+ ARGS: "--resolver lts-13"

19− stack-nightly:

29+ cabal-7.10.3:

20− BUILD: stack

30+ BUILD: cabal

21− STACK_YAML: stack-nightly.yaml

31+ GHCVER: 7.10.3

22− ARGS: "--resolver nightly"

32+ CABALVER: 1.22

33+ cabal-8.0.2:

34+ BUILD: cabal

35+ GHCVER: 8.0.2

36+ CABALVER: 1.24

23 cabal-8.2.2:

37 cabal-8.2.2:

24 BUILD: cabal

38 BUILD: cabal

25 GHCVER: 8.4.4

39 GHCVER: 8.4.4

@@ -28,9 +42,9 @@ jobs:

28 BUILD: cabal

42 BUILD: cabal

29 GHCVER: 8.4.4

43 GHCVER: 8.4.4

30 CABALVER: 2.2

44 CABALVER: 2.2

31− cabal-8.6.5:

45+ cabal-8.6.4:

32 BUILD: cabal

46 BUILD: cabal

33− GHCVER: 8.6.5

47+ GHCVER: 8.6.4

34 CABALVER: 2.4

48 CABALVER: 2.4

35 maxParallel: 6

49 maxParallel: 6

36 steps:

50 steps:

.azure/azure-osx-template.yml+12−2

@@ -5,6 +5,16 @@ jobs:

5 vmImage: ${{ parameters.vmImage }}

6 strategy:

7 matrix:

8+ stack-def:

9+ BUILD: stack

10+ stack-lts-6:

11+ BUILD: stack

12+ STACK_YAML: stack-lts-6.yaml

13+ ARGS: "--resolver lts-6"

14+ stack-lts-9:

15+ BUILD: stack

16+ STACK_YAML: stack-lts-9.yaml

17+ ARGS: "--resolver lts-9"

8 stack-lts-11:

18 stack-lts-11:

9 BUILD: stack

19 BUILD: stack

10 STACK_YAML: stack-lts-11.yaml

20 STACK_YAML: stack-lts-11.yaml

@@ -13,9 +23,9 @@ jobs:

13 BUILD: stack

23 BUILD: stack

14 STACK_YAML: stack-lts-12.yaml

24 STACK_YAML: stack-lts-12.yaml

15 ARGS: "--resolver lts-12"

25 ARGS: "--resolver lts-12"

16− stack-lts-14:

26+ stack-lts-13:

17 BUILD: stack

27 BUILD: stack

18− ARGS: "--resolver lts-14"

28+ ARGS: "--resolver lts-13"

19 maxParallel: 3

29 maxParallel: 3

20 steps:

30 steps:

21 - script: |

31 - script: |

.azure/azure-windows-template.yml+3−4

@@ -5,9 +5,9 @@ jobs:

5 vmImage: ${{ parameters.vmImage }}

6 strategy:

7 matrix:

8− stack-lts-14:

8+ stack-lts-13:

9 BUILD: stack

10− ARGS: "--resolver lts-14"

10+ ARGS: "--resolver lts-13"

11 maxParallel: 3

12 steps:

13 - bash: |

@@ -16,8 +16,7 @@ jobs:

16 unzip -o /usr/bin/stack.zip -d /usr/bin/

17 stack setup $ARGS > /dev/null

18 stack --install-ghc $ARGS test --bench --only-dependencies

19− stack $ARGS test --bench --no-run-benchmarks --no-run-tests

19+ stack $ARGS test --bench --no-run-benchmarks

20− stack $ARGS test --bench --no-run-benchmarks --jobs 1 # non-parallel test execution

21 env:

20 env:

22 OS_NAME: ${{ parameters.os }}

21 OS_NAME: ${{ parameters.os }}

23 displayName: 'Installation ${{parameters.os}} & Test'

22 displayName: 'Installation ${{parameters.os}} & Test'

.gitignore−1

@@ -9,4 +9,3 @@ tarballs/

9cabal.sandbox.config

10.stack-work/

11*~

12−stack*.yaml.lock

stack-lts-11.yaml+6−3

@@ -17,11 +17,14 @@ extra-deps:

17- streaming-commons-0.2.1.0@sha256:163af02944f374f316e35257c1afbffefd2c2852a85a151d1ea0ad22152cf28d,4990

18- http2-2.0.0

19- network-byte-order-0.1.1.0

20−- tls-1.5.3

21−- tls-session-manager-0.0.4

22−- x509-1.7.5

23nix:

20nix:

24 enable: false

21 enable: false

25 packages:

22 packages:

26 - fcgi

23 - fcgi

27 - zlib

24 - zlib

25+image:

26+ containers:

27+ - base: "fpco/pid1"

28+ name: "yesodweb/warp"

29+ executables:

30+ - warp

stack-lts-12.yaml+6−3

@@ -18,9 +18,12 @@ nix:

18 packages:

19 - fcgi

20 - zlib

21+image:

22+ containers:

23+ - base: "fpco/pid1"

24+ name: "yesodweb/warp"

25+ executables:

26+ - warp

21extra-deps:

27extra-deps:

22- http2-2.0.0

28- http2-2.0.0

23- network-byte-order-0.1.1.0

29- network-byte-order-0.1.1.0

24−- tls-1.5.3

25−- tls-session-manager-0.0.4

26−- x509-1.7.5

stack-lts-6.yamlnew file+35

@@ -0,0 +1,35 @@

1+resolver: lts-6.35

2+packages:

3+- ./auto-update

4+- ./mime-types

5+- ./wai

6+- ./wai-extra

7+- ./warp

8+- ./warp-tls

9+- ./wai-app-static

10+- ./wai-websockets

11+- ./wai-conduit

12+- ./time-manager

13+extra-deps:

14+- bsb-http-chunked-0.0.0.2@sha256:0571ef33ec5530104503d32eaf24f2d7c221f350e5fc475a6dd8e84311bc0ca1,1792

15+- streaming-commons-0.2.1.0@sha256:163af02944f374f316e35257c1afbffefd2c2852a85a151d1ea0ad22152cf28d,4990

16+- tls-session-manager-0.0.0.2@sha256:e3d3f8a026196df46746a19d3d7d31211b2fca3aefed9074e951b2dcc1b8833c,872

17+- wai-logger-2.3.2@sha256:7f5dbc72c0753bd3e0e73f8f542d9d159d1d70f8ff3a3ec16d0b74b500534fc6,1572

18+- gauge-0.2.3@sha256:ce41cb66ebf730a5050181db0338b1a4b3f76ac71331bf5070089bcd4352ff46,3777

19+- psqueues-0.2.7.0@sha256:189970837d0aae01f48cd2a8aac6ce314191939e118cc0488aee1fb12da1956a,4757

20+- basement-0.0.7@rev:0

21+- http-client-0.5.13.1@rev:0

22+- http-types-0.12.3@rev:0

23+- http2-2.0.0

24+- network-byte-order-0.1.1.0

25+nix:

26+ enable: false

27+ packages:

28+ - fcgi

29+ - zlib

30+image:

31+ containers:

32+ - base: "fpco/pid1"

33+ name: "yesodweb/warp"

34+ executables:

35+ - warp

stack-lts-9.yamlnew file+31

@@ -0,0 +1,31 @@

1+resolver: lts-9.21

2+packages:

3+- ./auto-update

4+- ./mime-types

5+- ./wai

6+- ./wai-extra

7+- ./warp

8+- ./warp-tls

9+- ./wai-app-static

10+- ./wai-websockets

11+- ./wai-conduit

12+- ./time-manager

13+extra-deps:

14+- bsb-http-chunked-0.0.0.2@sha256:0571ef33ec5530104503d32eaf24f2d7c221f350e5fc475a6dd8e84311bc0ca1,1792

15+- streaming-commons-0.2.1.0@sha256:163af02944f374f316e35257c1afbffefd2c2852a85a151d1ea0ad22152cf28d,4990

16+- wai-logger-2.3.2@sha256:7f5dbc72c0753bd3e0e73f8f542d9d159d1d70f8ff3a3ec16d0b74b500534fc6,1572

17+- http-client-0.5.13.1@rev:0

18+- http-types-0.12.3@rev:0

19+- http2-2.0.0

20+- network-byte-order-0.1.1.0

21+nix:

22+ enable: false

23+ packages:

24+ - fcgi

25+ - zlib

26+image:

27+ containers:

28+ - base: "fpco/pid1"

29+ name: "yesodweb/warp"

30+ executables:

31+ - warp

stack-nightly.yamldeleted−20

@@ -1,20 +0,0 @@

1−resolver: nightly-2020-01-08

2−packages:

3−- ./auto-update

4−- ./mime-types

5−- ./wai

6−- ./wai-extra

7−- ./warp

8−- ./warp-tls

9−- ./wai-app-static

10−- ./wai-websockets

11−- ./wai-conduit

12−- ./time-manager

13−flags:

14− wai-extra:

15− build-example: true

16−nix:

17− enable: false

18− packages:

19− - fcgi

20− - zlib

stack.yaml+7−3

@@ -1,4 +1,4 @@

1−resolver: lts-14.22

1+resolver: lts-13.14

2packages:

3- ./auto-update

4- ./mime-types

@@ -18,8 +18,12 @@ nix:

18 packages:

19 - fcgi

20 - zlib

21+image:

22+ containers:

23+ - base: "fpco/pid1"

24+ name: "yesodweb/warp"

25+ executables:

26+ - warp

21extra-deps:

27extra-deps:

22- http2-2.0.0

28- http2-2.0.0

23- network-byte-order-0.1.1.0

29- network-byte-order-0.1.1.0

24−- tls-1.5.3

25−- tls-session-manager-0.0.4

wai-app-static/ChangeLog.md−10

@@ -1,13 +1,3 @@

1−# wai-app-static changelog

2−

3−## 3.1.7.1

4−

5−* Update the test suite too

6−

7−## 3.1.7

8−

9−* Use 302 instead of 301 redirect, to avoid caching the presence of an index.html file

10−

11## 3.1.6.3

1## 3.1.6.3

12

2

13* The executable warp obeys `-h` option properly for host

3* The executable warp obeys `-h` option properly for host

wai-app-static/Network/Wai/Application/Static.hs+8−10

@@ -164,13 +164,11 @@ serveFile StaticSettings {..} req file

164 -- Didn't match, but we have a hash value. Send the file contents

165 -- with an ETag header.

166 --

167− -- RFC7232 (HTTP 1.1):

167+ -- Note: It would be arguably better to next check

168− -- > A recipient MUST ignore If-Modified-Since if the request contains an

168+ -- if-modified-since and return a 304 if that indicates a match as

169− -- > If-None-Match header field; the condition in If-None-Match is

169+ -- well. However, the circumstances under which such a situation

170− -- > considered to be a more accurate replacement for the condition in

170+ -- could arise would be very anomolous, and should likely warrant a

171− -- > If-Modified-Since, and the two are only combined for the sake of

171+ -- new file being sent anyway.

172− -- > interoperating with older intermediaries that might not implement

173− -- > If-None-Match.

174 (Just hash, _) -> respond [("ETag", hash)]

172 (Just hash, _) -> respond [("ETag", hash)]

175

173

176 -- No hash value available, fall back to last modified support.

174 -- No hash value available, fall back to last modified support.

@@ -245,7 +243,7 @@ staticAppPieces ss rawPieces req sendResponse = liftIO $ do

245 response :: StaticResponse -> IO W.ResponseReceived

243 response :: StaticResponse -> IO W.ResponseReceived

246 response (FileResponse file ch) = do

244 response (FileResponse file ch) = do

247 mimetype <- ssGetMimeType ss file

245 mimetype <- ssGetMimeType ss file

248− -- let filesize = fileGetSize file

246+ let filesize = fileGetSize file

249 let headers = ("Content-Type", mimetype)

247 let headers = ("Content-Type", mimetype)

250 -- Let Warp provide the content-length, since it takes

248 -- Let Warp provide the content-length, since it takes

251 -- range requests into account

249 -- range requests into account

@@ -269,13 +267,13 @@ staticAppPieces ss rawPieces req sendResponse = liftIO $ do

269 Just hash -> replace "etag" (Just hash) (W.queryString req)

267 Just hash -> replace "etag" (Just hash) (W.queryString req)

270 Nothing -> remove "etag" (W.queryString req)

268 Nothing -> remove "etag" (W.queryString req)

271

269

272− sendResponse $ W.responseLBS H.status302

270+ sendResponse $ W.responseLBS H.status301

273 [ ("Content-Type", "text/plain")

271 [ ("Content-Type", "text/plain")

274 , ("Location", S8.append loc $ H.renderQuery True qString)

272 , ("Location", S8.append loc $ H.renderQuery True qString)

275 ] "Redirect"

273 ] "Redirect"

276

274

277 response (RawRedirect path) =

275 response (RawRedirect path) =

278− sendResponse $ W.responseLBS H.status302

276+ sendResponse $ W.responseLBS H.status301

279 [ ("Content-Type", "text/plain")

277 [ ("Content-Type", "text/plain")

280 , ("Location", path)

278 , ("Location", path)

281 ] "Redirect"

279 ] "Redirect"

wai-app-static/WaiAppStatic/CmdLine.hs−1

@@ -39,7 +39,6 @@ data Args = Args

39 }

40

41#if MIN_VERSION_optparse_applicative(0, 10, 0)

42−option' :: Mod OptionFields Int -> Parser Int

43option' = option auto

42option' = option auto

44#else

43#else

45option' = option

44option' = option

wai-app-static/WaiAppStatic/Listing.hs+1−1

@@ -64,7 +64,7 @@ defaultListing pieces (Folder contents) = do

64

65 -- Add a link to the root of the tree

66 showFolder' :: Bool -> Pieces -> H.Html

67− showFolder' hasTrailingSlash pieces' = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces')

67+ showFolder' hasTrailingSlash pieces = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces)

68

69 showFolder :: Bool -> Pieces -> H.Html

70 showFolder _ [] = "/" -- won't happen

wai-app-static/WaiAppStatic/Storage/Embedded/TH.hs+1

@@ -7,6 +7,7 @@ module WaiAppStatic.Storage.Embedded.TH(

7

8import Data.ByteString.Builder.Extra (byteStringInsert)

9import Codec.Compression.GZip (compress)

10+import Control.Applicative

10import Data.ByteString.Unsafe (unsafePackAddressLen)

11import Data.ByteString.Unsafe (unsafePackAddressLen)

11import Data.Either (lefts, rights)

12import Data.Either (lefts, rights)

12import GHC.Exts (Int(..))

13import GHC.Exts (Int(..))

wai-app-static/WaiAppStatic/Types.hs−2

@@ -59,8 +59,6 @@ toPieces :: [Text] -> Maybe Pieces

59toPieces = mapM toPiece

60

61-- | Request coming from a user. Corresponds to @pathInfo@.

62−--

63−-- The root path is the empty list.

64type Pieces = [Piece]

62type Pieces = [Piece]

65

63

66-- | Values for the max-age component of the cache-control response header.

64-- | Values for the max-age component of the cache-control response header.

wai-app-static/test/WaiAppStaticTest.hs+9−9

@@ -57,22 +57,22 @@ spec = do

57 assertStatus 200 =<<

58 request (setRawPathInfo defRequest path)

59

60− it "404 for non-existent files" $ webApp $

60+ it "404 for non-existant files" $ webApp $

61 assertStatus 404 =<<

62 request (setRawPathInfo defRequest "doesNotExist")

63

64− it "302 redirect when multiple slashes" $ webApp $ do

64+ it "301 redirect when multiple slashes" $ webApp $ do

65 req <- request (setRawPathInfo defRequest "a//b/c")

66− assertStatus 302 req

66+ assertStatus 301 req

67 assertHeader "Location" "../../a/b/c" req

68

69 let absoluteApp = flip runSession $ staticApp $ (defaultWebAppSettings "test") {

70 ssMkRedirect = \_ u -> S8.append "http://www.example.com" u

71 }

72− it "302 redirect when multiple slashes" $ absoluteApp $

72+ it "301 redirect when multiple slashes" $ absoluteApp $

73 flip mapM_ ["/a//b/c", "a//b/c"] $ \path -> do

74 req <- request (setRawPathInfo defRequest path)

75− assertStatus 302 req

75+ assertStatus 301 req

76 assertHeader "Location" "http://www.example.com/a/b/c" req

77

78 describe "webApp when requesting a static asset" $ do

@@ -131,10 +131,10 @@ spec = do

131 assertStatus 304 req

132 assertNoHeader "Cache-Control" req

133

134− context "302 redirect to add a trailing slash on directories if missing" $ do

134+ context "301 redirect to add a trailing slash on directories if missing" $ do

135 it "works at the root" $ fileServerApp $ do

136 req <- request (setRawPathInfo defRequest "/a")

137− assertStatus 302 req

137+ assertStatus 301 req

138 assertHeader "Location" "/a/" req

139

140 it "works when an index.html is delivered" $ do

@@ -144,7 +144,7 @@ spec = do

144 inTempDirectory $ fileServerAppWithSettings settings $ do

145 liftIO $ touch "foo/index.html"

146 req <- request (setRawPathInfo defRequest "/foo")

147− assertStatus 302 req

147+ assertStatus 301 req

148 assertHeader "Location" "/foo/" req

149

150 let urlMapApp = flip runSession $ \req send ->

@@ -158,7 +158,7 @@ spec = do

158 "urlMapApp: only works at subPath"

159 it "works with subpath at the root of the file server" $ urlMapApp $ do

160 req <- request (setRawPathInfo defRequest "/subPath")

161− assertStatus 302 req

161+ assertStatus 301 req

162 assertHeader "Location" "/subPath/" req

163

164 context "with defaultWebAppSettings" $ do

wai-app-static/wai-app-static.cabal+1−1

@@ -1,5 +1,5 @@

1name: wai-app-static

2−version: 3.1.7.1

2+version: 3.1.6.3

3license: MIT

4license-file: LICENSE

5author: Michael Snoyman <michael@snoyman.com>

wai-conduit/Network/Wai/Conduit.hs+6−5

@@ -17,16 +17,17 @@ import qualified Data.ByteString as S

17import Control.Monad (unless)

18import Network.HTTP.Types

19import Data.ByteString.Builder (Builder)

20+import Data.IORef

20import qualified Data.Conduit.List as CL

21import qualified Data.Conduit.List as CL

21

22

22-- | Stream the request body.

23-- | Stream the request body.

23--

24--

24-- Since 3.0.0

25-- Since 3.0.0

25−sourceRequestBody :: MonadIO m => Request -> ConduitT () ByteString m ()

26+sourceRequestBody :: MonadIO m => Request -> Source m ByteString

26sourceRequestBody req =

27sourceRequestBody req =

27 loop

28 loop

28 where

29 where

29− go = liftIO (getRequestBodyChunk req)

30+ go = liftIO (requestBody req)

30

31

31 loop = do

32 loop = do

32 bs <- go

33 bs <- go

@@ -37,9 +38,9 @@ sourceRequestBody req =

37-- | Create an HTTP response out of a @Source@.

38-- | Create an HTTP response out of a @Source@.

38--

39--

39-- Since 3.0.0

40-- Since 3.0.0

40−responseSource :: Status -> ResponseHeaders -> ConduitT () (Flush Builder) IO () -> Response

41+responseSource :: Status -> ResponseHeaders -> Source IO (Flush Builder) -> Response

41responseSource s hs src = responseStream s hs $ \send flush ->

42responseSource s hs src = responseStream s hs $ \send flush ->

42− runConduit $ src .| CL.mapM_ (\mbuilder ->

43+ src $$ CL.mapM_ (\mbuilder ->

43 case mbuilder of

44 case mbuilder of

44 Chunk b -> send b

45 Chunk b -> send b

45 Flush -> flush)

46 Flush -> flush)

@@ -49,7 +50,7 @@ responseSource s hs src = responseStream s hs $ \send flush ->

49--

50--

50-- Since 3.0.0

51-- Since 3.0.0

51responseRawSource :: (MonadIO m, MonadIO n)

52responseRawSource :: (MonadIO m, MonadIO n)

52− => (ConduitT () ByteString m () -> ConduitT ByteString Void n () -> IO ())

53+ => (Source m ByteString -> Sink ByteString n () -> IO ())

53 -> Response

54 -> Response

55 -> Response

55responseRawSource app =

56responseRawSource app =

wai-extra/ChangeLog.md−8

@@ -1,13 +1,5 @@

1# Changelog for wai-extra

2

3−## 3.0.29.1

4−

5−* Fix `Network.Wai.Test.request` always sending an empty request body [#794](https://github.com/yesodweb/wai/pull/794)

6−

7−## 3.0.29

8−

9−* Export `Network.Wai.EventSource.eventStreamAppRaw` [#786](https://github.com/yesodweb/wai/pull/786)

10−

11## 3.0.28

3## 3.0.28

12

4

13* Add `Network.Wai.EventSource.eventStreamAppRaw` [#767](https://github.com/yesodweb/wai/pull/767)

5* Add `Network.Wai.EventSource.eventStreamAppRaw` [#767](https://github.com/yesodweb/wai/pull/767)

wai-extra/Network/Wai/EventSource.hs+1−2

@@ -11,8 +11,7 @@

11module Network.Wai.EventSource (

12 ServerEvent(..),

13 eventSourceAppChan,

14− eventSourceAppIO,

14+ eventSourceAppIO

15− eventStreamAppRaw

16 ) where

15 ) where

17

16

18import Data.Function (fix)

17import Data.Function (fix)

wai-extra/Network/Wai/EventSource/EventStream.hs+1−1

@@ -1,5 +1,5 @@

1{-# LANGUAGE CPP #-}

2−{- code adapted by Mathias Billman originally from Chris Smith https://github.com/cdsmith/gloss-web -}

2+{- code adapted by Mathias Billman originaly from Chris Smith https://github.com/cdsmith/gloss-web -}

3

4{-|

5 Internal module, usually you don't need to use it.

wai-extra/Network/Wai/Middleware/Rewrite.hs+1−1

@@ -169,7 +169,7 @@ import Control.Applicative

169--

170-- as the following example demonstrates.

171--

172−-- Old versions of the library could only handle path pieces, not queries.

172+-- Old versions of the libary could only handle path pieces, not queries.

173-- This could have been supplied to 'rewritePure'.

174--

175-- @

wai-extra/Network/Wai/Test.hs+14−22

@@ -99,10 +99,6 @@ runSession session app = ST.evalStateT (runReaderT session app) initState

99data SRequest = SRequest

100 { simpleRequest :: Request

101 , simpleRequestBody :: L.ByteString

102− -- ^ Request body that will override the one set in 'simpleRequest'.

103− --

104− -- This is usually simpler than setting the body as a stateful IO-action

105− -- in 'simpleRequest'.

106 }

102 }

107data SResponse = SResponse

103data SResponse = SResponse

108 { simpleStatus :: H.Status

104 { simpleStatus :: H.Status

@@ -110,16 +106,8 @@ data SResponse = SResponse

110 , simpleBody :: L.ByteString

106 , simpleBody :: L.ByteString

111 }

107 }

112 deriving (Show, Eq)

108 deriving (Show, Eq)

113−

114request :: Request -> Session SResponse

109request :: Request -> Session SResponse

115−request req = do

110+request = srequest . flip SRequest L.empty

116− app <- ask

117− req' <- addCookiesToRequest req

118− response <- liftIO $ do

119− ref <- newIORef $ error "runResponse gave no result"

120− ResponseReceived <- app req' (runResponse ref)

121− readIORef ref

122− extractSetCookieFromSResponse response

123

111

124-- | Set whole path (request path + query string).

112-- | Set whole path (request path + query string).

125setPath :: Request -> S8.ByteString -> Request

113setPath :: Request -> S8.ByteString -> Request

@@ -178,18 +166,22 @@ extractSetCookieFromSResponse response = do

178 (Map.fromList [(Cookie.setCookieName c, c) | c <- newClientCookies ]))

166 (Map.fromList [(Cookie.setCookieName c, c) | c <- newClientCookies ]))

179 return response

167 return response

180

168

181−-- | Similar to 'request', but allows setting the request body as a plain

182−-- 'L.ByteString'.

183srequest :: SRequest -> Session SResponse

169srequest :: SRequest -> Session SResponse

184srequest (SRequest req bod) = do

170srequest (SRequest req bod) = do

171+ app <- ask

185 refChunks <- liftIO $ newIORef $ L.toChunks bod

172 refChunks <- liftIO $ newIORef $ L.toChunks bod

186− request $

187− req

173+ let req' = req

188− { requestBody = atomicModifyIORef refChunks $ \bss ->

174+ { requestBody = atomicModifyIORef refChunks $ \bss ->

189− case bss of

175+ case bss of

190− [] -> ([], S.empty)

176+ [] -> ([], S.empty)

191− x:y -> (y, x)

177+ x:y -> (y, x)

192− }

178+ }

179+ req'' <- addCookiesToRequest req'

180+ response <- liftIO $ do

181+ ref <- newIORef $ error "runResponse gave no result"

182+ ResponseReceived <- app req'' (runResponse ref)

183+ readIORef ref

184+ extractSetCookieFromSResponse response

193

185

194runResponse :: IORef SResponse -> Response -> IO ResponseReceived

186runResponse :: IORef SResponse -> Response -> IO ResponseReceived

195runResponse ref res = do

187runResponse ref res = do

wai-extra/example/Main.hs+2−2

@@ -42,10 +42,10 @@ eventRaw = handle 0

42 where

43 handle counter emit flush = do

44 threadDelay 1000000

45− _ <- emit $ ServerEvent (Just $ string8 "raw")

45+ emit $ ServerEvent (Just $ string8 "raw")

46 Nothing

47 [string8 . show $ counter]

48− _ <- flush

48+ flush

49 handle (counter + 1) emit flush

50

51main :: IO ()

wai-extra/test/Network/Wai/TestSpec.hs+11−41

@@ -3,8 +3,6 @@ module Network.Wai.TestSpec (main, spec) where

3

4import Control.Monad (void)

5

6−import qualified Data.IORef as IORef

7−

8import qualified Data.Text.Encoding as TE

6import qualified Data.Text.Encoding as TE

9

7

10import Data.Time.Calendar (fromGregorian)

8import Data.Time.Calendar (fromGregorian)

@@ -55,53 +53,25 @@ spec = do

55 it "sets rawQueryString to empty string" $ do

53 it "sets rawQueryString to empty string" $ do

56 rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""

54 rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""

57

55

58− describe "srequest" $ do

59−

60− let echoApp req respond = do

61− reqBody <- L8.fromStrict <$> getRequestBodyChunk req

62− let reqHeaders = requestHeaders req

63− respond $

64− responseLBS

65− status200

66− reqHeaders

67− reqBody

68−

69− it "returns the response body of an echo app" $ do

70− sresp <- flip runSession echoApp $

71− srequest $ SRequest defaultRequest "request body"

72− simpleBody sresp `shouldBe` "request body"

73−

74 describe "request" $ do

56 describe "request" $ do

75

57

76− let echoApp req respond = do

58+ let simpleApp _req respond =

77− reqBody <- L8.fromStrict <$> getRequestBodyChunk req

78− let reqHeaders = requestHeaders req

79 respond $

59 respond $

80 responseLBS

60 responseLBS

81 status200

61 status200

82− reqHeaders

62+ [("foo", "bar")]

83− reqBody

63+ "simple"

84

64

85− it "returns the status code of an echo app on default request" $ do

65+ it "returns the status code of a simple app on default request" $ do

86− sresp <- runSession (request defaultRequest) echoApp

66+ sresp <- runSession (request defaultRequest) simpleApp

87 simpleStatus sresp `shouldBe` status200

67 simpleStatus sresp `shouldBe` status200

88

68

89− it "returns the response body of an echo app" $ do

69+ it "returns the response body of a simple app on default request" $ do

90− bodyRef <- IORef.newIORef "request body"

91− let getBodyChunk = IORef.atomicModifyIORef bodyRef $ \leftover -> ("", leftover)

92− sresp <- flip runSession echoApp $

93− request $

94− defaultRequest

70+ sresp <- runSession (request defaultRequest) simpleApp

95− { requestBody = getBodyChunk

96− }

97− simpleBody sresp `shouldBe` "request body"

71+ simpleBody sresp `shouldBe` "simple"

98−

72+

99− it "returns the response headers of an echo app" $ do

73+ it "returns the response headers of a simple app on default request" $ do

100− sresp <- flip runSession echoApp $

101− request $

102− defaultRequest

74+ sresp <- runSession (request defaultRequest) simpleApp

103− { requestHeaders = [("foo", "bar")]

104− }

105 simpleHeaders sresp `shouldBe` [("foo", "bar")]

75 simpleHeaders sresp `shouldBe` [("foo", "bar")]

106

76

107 let cookieApp req respond =

77 let cookieApp req respond =

wai-extra/wai-extra.cabal+1−1

@@ -1,5 +1,5 @@

1Name: wai-extra

2−Version: 3.0.29.1

2+Version: 3.0.28

3Synopsis: Provides some basic WAI handlers and middleware.

4description:

5 Provides basic WAI handler and middleware functionality:

wai-websockets/server.lhs+1−7

@@ -8,8 +8,6 @@ this example, keep the [reference](http://jaspervdj.be/websockets/reference)

8nearby to check out the functions we use.

9

10> {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}

11−> {-# LANGUAGE CPP #-}

12−> {-# OPTIONS_GHC -Wno-unused-top-binds #-} -- for numClients

13> import Data.Char (isPunctuation, isSpace)

11> import Data.Char (isPunctuation, isSpace)

14> import Data.Monoid (mappend)

12> import Data.Monoid (mappend)

15> import Data.Text (Text)

13> import Data.Text (Text)

@@ -101,13 +99,9 @@ stays alive on some browsers.

101

99

102> application state pending = do

100> application state pending = do

103> conn <- WS.acceptRequest pending

101> conn <- WS.acceptRequest pending

104−#if __GLASGOW_HASKELL__ >= 806

105−> WS.withPingThread conn 30 (return ()) $ do

106−#else

107> WS.forkPingThread conn 30

102> WS.forkPingThread conn 30

108−#endif

109

103

110−When a client is successfully connected, we read the first message. This should

104+When a client is succesfully connected, we read the first message. This should

111be in the format of "Hi! I am Jasper", where Jasper is the requested username.

105be in the format of "Hi! I am Jasper", where Jasper is the requested username.

112

106

113> msg <- WS.receiveData conn

107> msg <- WS.receiveData conn

wai-websockets/wai-websockets.cabal−1

@@ -45,7 +45,6 @@ Executable wai-websockets-example

45 , text

46 , file-embed

47 , http-types

48− other-modules: Network.Wai.Handler.WebSockets

49 else

48 else

50 buildable: False

49 buildable: False

51

50

warp-tls/ChangeLog.md−14

@@ -1,17 +1,3 @@

1−## 3.2.11

2−

3−* Ignoring an exception from shutdown (gracefulClose).

4−

5−## 3.2.10

6−

7−* Passing client certificate, if any, to Warp

8− [#783](https://github.com/yesodweb/wai/pull/783)

9−

10−## 3.2.9

11−

12−* Cooperating setGracefulCloseTimeout1 and setGracefulCloseTimeout2 of Warp.

13− [#782](https://github.com/yesodweb/wai/pull/782)

14−

15## 3.2.8

1## 3.2.8

16

2

17* Using gracefullClose of network 3.1.1 or later if available.

3* Using gracefullClose of network 3.1.1 or later if available.

warp-tls/Network/Wai/Handler/WarpTLS.hs+16−21

@@ -281,7 +281,7 @@ runTLSSocket' :: TLSSettings -> Settings -> TLS.Credential -> TLS.SessionManager

281runTLSSocket' tlsset@TLSSettings{..} set credential mgr sock app =

282 runSettingsConnectionMakerSecure set get app

283 where

284− get = getter tlsset set sock params

284+ get = getter tlsset sock params

285 params = def { -- TLS.ServerParams

286 TLS.serverWantClientCert = tlsWantClientCert

287 , TLS.serverCACertificates = []

@@ -322,46 +322,44 @@ alpn xs

322

323----------------------------------------------------------------

324

325−getter :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> params -> IO (IO (Connection, Transport), SockAddr)

325+getter :: TLS.TLSParams params => TLSSettings -> Socket -> params -> IO (IO (Connection, Transport), SockAddr)

326−getter tlsset@TLSSettings{..} set sock params = do

326+getter tlsset@TLSSettings{..} sock params = do

327#if WINDOWS

328 (s, sa) <- windowsThreadBlockHack $ accept sock

329#else

330 (s, sa) <- accept sock

331#endif

332 setSocketCloseOnExec s

333− return (mkConn tlsset set s params, sa)

333+ return (mkConn tlsset s params, sa)

334

335−mkConn :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> params -> IO (Connection, Transport)

335+mkConn :: TLS.TLSParams params => TLSSettings -> Socket -> params -> IO (Connection, Transport)

336−mkConn tlsset set s params = switch `onException` close s

336+mkConn tlsset s params = switch `onException` close s

337 where

338 switch = do

339 firstBS <- safeRecv s 4096

340 if not (S.null firstBS) && S.head firstBS == 0x16 then

341− httpOverTls tlsset set s firstBS params

341+ httpOverTls tlsset s firstBS params

342 else

343− plainHTTP tlsset set s firstBS

343+ plainHTTP tlsset s firstBS

344

345----------------------------------------------------------------

346

347−httpOverTls :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> S.ByteString -> params -> IO (Connection, Transport)

347+httpOverTls :: TLS.TLSParams params => TLSSettings -> Socket -> S.ByteString -> params -> IO (Connection, Transport)

348−httpOverTls TLSSettings{..} _set s bs0 params = do

348+httpOverTls TLSSettings{..} s bs0 params = do

349 recvN <- makePlainReceiveN s bs0

350 ctx <- TLS.contextNew (backend recvN) params

351 TLS.contextHookSetLogging ctx tlsLogging

352 TLS.handshake ctx

353− h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx

354− isH2 <- I.newIORef h2

355 writeBuf <- allocateBuffer bufferSize

353 writeBuf <- allocateBuffer bufferSize

356 -- Creating a cache for leftover input data.

354 -- Creating a cache for leftover input data.

357 ref <- I.newIORef ""

355 ref <- I.newIORef ""

358 tls <- getTLSinfo ctx

356 tls <- getTLSinfo ctx

359− return (conn ctx writeBuf ref isH2, tls)

357+ return (conn ctx writeBuf ref, tls)

360 where

358 where

361 backend recvN = TLS.Backend {

359 backend recvN = TLS.Backend {

362 TLS.backendFlush = return ()

360 TLS.backendFlush = return ()

363#if MIN_VERSION_network(3,1,1)

361#if MIN_VERSION_network(3,1,1)

364− , TLS.backendClose = gracefulClose s 5000 `E.catch` \(SomeException _) -> return ()

362+ , TLS.backendClose = gracefulClose s 5000

365#else

363#else

366 , TLS.backendClose = close s

364 , TLS.backendClose = close s

367#endif

365#endif

@@ -370,7 +368,7 @@ httpOverTls TLSSettings{..} _set s bs0 params = do

370 }

368 }

371 sendAll' sock bs = sendAll sock bs `E.catch` \(SomeException _) ->

369 sendAll' sock bs = sendAll sock bs `E.catch` \(SomeException _) ->

372 throwIO ConnectionClosedByPeer

370 throwIO ConnectionClosedByPeer

373− conn ctx writeBuf ref isH2 = Connection {

371+ conn ctx writeBuf ref = Connection {

374 connSendMany = TLS.sendData ctx . L.fromChunks

372 connSendMany = TLS.sendData ctx . L.fromChunks

375 , connSendAll = sendall

373 , connSendAll = sendall

376 , connSendFile = sendfile

374 , connSendFile = sendfile

@@ -380,7 +378,6 @@ httpOverTls TLSSettings{..} _set s bs0 params = do

380 , connRecvBuf = recvBuf ref

378 , connRecvBuf = recvBuf ref

381 , connWriteBuffer = writeBuf

379 , connWriteBuffer = writeBuf

382 , connBufferSize = bufferSize

380 , connBufferSize = bufferSize

383− , connHTTP2 = isH2

384 }

381 }

385 where

382 where

386 sendall = TLS.sendData ctx . L.fromChunks . return

383 sendall = TLS.sendData ctx . L.fromChunks . return

@@ -468,13 +465,11 @@ getTLSinfo ctx = do

468#if MIN_VERSION_tls(1,5,0)

465#if MIN_VERSION_tls(1,5,0)

469 TLS.TLS13 -> (3,4)

466 TLS.TLS13 -> (3,4)

470#endif

467#endif

471− clientCert <- TLS.getClientCertificateChain ctx

472 return TLS {

468 return TLS {

473 tlsMajorVersion = major

469 tlsMajorVersion = major

474 , tlsMinorVersion = minor

470 , tlsMinorVersion = minor

475 , tlsNegotiatedProtocol = proto

471 , tlsNegotiatedProtocol = proto

476 , tlsChiperID = TLS.cipherID infoCipher

472 , tlsChiperID = TLS.cipherID infoCipher

477− , tlsClientCertificate = clientCert

478 }

473 }

479

474

480tryIO :: IO a -> IO (Either IOException a)

475tryIO :: IO a -> IO (Either IOException a)

@@ -482,10 +477,10 @@ tryIO = try

482

477

483----------------------------------------------------------------

478----------------------------------------------------------------

484

479

485−plainHTTP :: TLSSettings -> Settings -> Socket -> S.ByteString -> IO (Connection, Transport)

480+plainHTTP :: TLSSettings -> Socket -> S.ByteString -> IO (Connection, Transport)

486−plainHTTP TLSSettings{..} set s bs0 = case onInsecure of

481+plainHTTP TLSSettings{..} s bs0 = case onInsecure of

487 AllowInsecure -> do

482 AllowInsecure -> do

488− conn' <- socketConnection set s

483+ conn' <- socketConnection s

489 cachedRef <- I.newIORef bs0

484 cachedRef <- I.newIORef bs0

490 let conn'' = conn'

485 let conn'' = conn'

491 { connRecv = recvPlain cachedRef (connRecv conn')

486 { connRecv = recvPlain cachedRef (connRecv conn')

warp-tls/warp-tls.cabal+5−5

@@ -1,5 +1,5 @@

1Name: warp-tls

2−Version: 3.2.11

2+Version: 3.2.8

3Synopsis: HTTP over TLS support for Warp via the TLS package

4License: MIT

5License-file: LICENSE

@@ -18,16 +18,16 @@ description: SSLv1 and SSLv2 are obsoleted by IETF.

18extra-source-files: ChangeLog.md README.md

19

20Library

21− Build-Depends: base >= 4.10 && < 5

21+ Build-Depends: base >= 4.8 && < 5

22 , bytestring >= 0.9

23 , wai >= 3.2 && < 3.3

24− , warp >= 3.3.6 && < 3.4

24+ , warp >= 3.2.17 && < 3.4

25 , data-default-class >= 0.0.1

26− , tls >= 1.5.3

26+ , tls >= 1.3.10

27 , cryptonite >= 0.12

28 , network >= 2.2.1

29 , streaming-commons

30− , tls-session-manager >= 0.0.4

30+ , tls-session-manager >= 0.0.0.1

31 Exposed-modules: Network.Wai.Handler.WarpTLS

32 ghc-options: -Wall

33 if os(windows)

warp/ChangeLog.md+1−35

@@ -1,37 +1,3 @@

1−## 3.3.9

2−

3−* Don't insert Last-Modified: if exists.

4− [#791](https://github.com/yesodweb/wai/pull/791)

5−

6−## 3.3.8

7−

8−* Maximum header size is configurable.

9− [#781](https://github.com/yesodweb/wai/pull/781)

10−* Ignoring an exception from shutdown (gracefulClose).

11−

12−## 3.3.7

13−

14−* InvalidArgument (Bad file descriptor) is ignored in `receive`.

15− [#787](https://github.com/yesodweb/wai/pull/787)

16−

17−## 3.3.6

18−

19−* Fixing a bug of thread killed in the case of event source with

20− HTTP/2 (fixing #692 and #785)

21−* New APIs: clientCertificate to get client's certificate

22− [#783](https://github.com/yesodweb/wai/pull/783)

23−

24−## 3.3.5

25−

26−* New APIs: setGracefulCloseTimeout1 and setGracefulCloseTimeout2.

27− For HTTP/1.x, connections are closed immediately by default.

28− gracefullClose is used for HTTP/2 by default.

29− [#782](https://github.com/yesodweb/wai/pull/782)

30−

31−## 3.3.4

32−

33−* Setting isSecure of HTTP/2 correctly.

34−

35## 3.3.3

1## 3.3.3

36

2

37* Calling setOnException in HTTP/2.

3* Calling setOnException in HTTP/2.

@@ -50,7 +16,7 @@

50## 3.3.0

16## 3.3.0

51

17

52* Switching from the original implementation to HTTP/2 server library.

18* Switching from the original implementation to HTTP/2 server library.

53− [#754](https://github.com/yesodweb/wai/pull/754)

19+ [#752](https://github.com/yesodweb/wai/pull/752)

54* Breaking change: The type of `http2dataTrailers` is now

20* Breaking change: The type of `http2dataTrailers` is now

55 `HTTP2Data -> TrailersMaker`.

21 `HTTP2Data -> TrailersMaker`.

56

22

warp/Network/Wai/Handler/Warp.hs+1−51

@@ -72,9 +72,6 @@ module Network.Wai.Handler.Warp (

72 , setLogger

73 , setServerPushLogger

74 , setGracefulShutdownTimeout

75− , setGracefulCloseTimeout1

76− , setGracefulCloseTimeout2

77− , setMaxTotalHeaderLength

78 -- ** Getters

75 -- ** Getters

79 , getPort

76 , getPort

80 , getHost

77 , getHost

@@ -82,8 +79,6 @@ module Network.Wai.Handler.Warp (

82 , getOnClose

79 , getOnClose

83 , getOnException

80 , getOnException

84 , getGracefulShutdownTimeout

81 , getGracefulShutdownTimeout

85− , getGracefulCloseTimeout1

86− , getGracefulCloseTimeout2

87 -- ** Exception handler

82 -- ** Exception handler

88 , defaultOnException

83 , defaultOnException

89 , defaultShouldDisplayException

84 , defaultShouldDisplayException

@@ -98,7 +93,6 @@ module Network.Wai.Handler.Warp (

98 , pauseTimeout

93 , pauseTimeout

99 , FileInfo(..)

94 , FileInfo(..)

100 , getFileInfo

95 , getFileInfo

101− , clientCertificate

102 , withApplication

96 , withApplication

103 , withApplicationSettings

97 , withApplicationSettings

104 , testWithApplication

98 , testWithApplication

@@ -127,7 +121,6 @@ module Network.Wai.Handler.Warp (

127import Control.Exception (SomeException, throwIO)

121import Control.Exception (SomeException, throwIO)

128import Data.Streaming.Network (HostPreference)

122import Data.Streaming.Network (HostPreference)

129import qualified Data.Vault.Lazy as Vault

123import qualified Data.Vault.Lazy as Vault

130−import Data.X509

131import qualified Network.HTTP.Types as H

124import qualified Network.HTTP.Types as H

132import Network.Socket (SockAddr)

125import Network.Socket (SockAddr)

133import Network.Wai (Request, Response, vault)

126import Network.Wai (Request, Response, vault)

@@ -385,7 +378,7 @@ setProxyProtocolRequired y = y { settingsProxyProtocol = ProxyProtocolRequired }

385--

378--

386-- WARNING: This is contrary to the PROXY protocol specification and

379-- WARNING: This is contrary to the PROXY protocol specification and

387-- using it can indicate a security problem with your

380-- using it can indicate a security problem with your

388−-- architecture if the web server is directly accessible

381+-- architecture if the web server is directly accessable

389-- to the public, since it would allow easy IP address

382-- to the public, since it would allow easy IP address

390-- spoofing. However, it can be useful in some cases,

383-- spoofing. However, it can be useful in some cases,

391-- such as if a load balancer health check uses regular

384-- such as if a load balancer health check uses regular

@@ -437,13 +430,6 @@ setGracefulShutdownTimeout :: Maybe Int

437 -> Settings -> Settings

430 -> Settings -> Settings

438setGracefulShutdownTimeout time y = y { settingsGracefulShutdownTimeout = time }

431setGracefulShutdownTimeout time y = y { settingsGracefulShutdownTimeout = time }

439

432

440−-- | Set the maximum header size that Warp will tolerate when using HTTP/1.x.

441−--

442−-- Since 3.3.8

443−setMaxTotalHeaderLength :: Int -> Settings -> Settings

444−setMaxTotalHeaderLength maxTotalHeaderLength settings = settings

445− { settingsMaxTotalHeaderLength = maxTotalHeaderLength }

446−

447-- | Explicitly pause the slowloris timeout.

433-- | Explicitly pause the slowloris timeout.

448--

434--

449-- This is useful for cases where you partially consume a request body. For

435-- This is useful for cases where you partially consume a request body. For

@@ -471,39 +457,3 @@ pauseTimeout = fromMaybe (return ()) . Vault.lookup pauseTimeoutKey . vault

471-- Since 3.1.10

457-- Since 3.1.10

472getFileInfo :: Request -> FilePath -> IO FileInfo

458getFileInfo :: Request -> FilePath -> IO FileInfo

473getFileInfo = fromMaybe (\_ -> throwIO (userError "getFileInfo")) . Vault.lookup getFileInfoKey . vault

459getFileInfo = fromMaybe (\_ -> throwIO (userError "getFileInfo")) . Vault.lookup getFileInfoKey . vault

474−

475−-- | A timeout to limit the time (in milliseconds) waiting for

476−-- FIN for HTTP/1.x. 0 means uses immediate close.

477−-- Default: 0.

478−--

479−-- Since 3.3.5

480−setGracefulCloseTimeout1 :: Int -> Settings -> Settings

481−setGracefulCloseTimeout1 x y = y { settingsGracefulCloseTimeout1 = x }

482−

483−-- | A timeout to limit the time (in milliseconds) waiting for

484−-- FIN for HTTP/1.x. 0 means uses immediate close.

485−--

486−-- Since 3.3.5

487−getGracefulCloseTimeout1 :: Settings -> Int

488−getGracefulCloseTimeout1 = settingsGracefulCloseTimeout1

489−

490−-- | A timeout to limit the time (in milliseconds) waiting for

491−-- FIN for HTTP/2. 0 means uses immediate close.

492−-- Default: 2000.

493−--

494−-- Since 3.3.5

495−setGracefulCloseTimeout2 :: Int -> Settings -> Settings

496−setGracefulCloseTimeout2 x y = y { settingsGracefulCloseTimeout2 = x }

497−

498−-- | A timeout to limit the time (in milliseconds) waiting for

499−-- FIN for HTTP/2. 0 means uses immediate close.

500−--

501−-- Since 3.3.5

502−getGracefulCloseTimeout2 :: Settings -> Int

503−getGracefulCloseTimeout2 = settingsGracefulCloseTimeout2

504−

505−-- | Getting information of client certificate.

506−--

507−-- Since 3.3.5

508−clientCertificate :: Request -> Maybe CertificateChain

509−clientCertificate = join . Vault.lookup getClientCertificateKey . vault

warp/Network/Wai/Handler/Warp/File.hs+4−7

@@ -34,15 +34,12 @@ data RspFileInfo = WithoutBody H.Status

34----------------------------------------------------------------

35

36conditionalRequest :: I.FileInfo

37− -> H.ResponseHeaders

37+ -> H.ResponseHeaders -> IndexedHeader

38− -> IndexedHeader -- ^ Response

39− -> IndexedHeader -- ^ Request

40 -> RspFileInfo

38 -> RspFileInfo

41−conditionalRequest finfo hs0 rspidx reqidx = case condition of

39+conditionalRequest finfo hs0 reqidx = case condition of

42 nobody@(WithoutBody _) -> nobody

40 nobody@(WithoutBody _) -> nobody

43− WithBody s _ off len -> let !hs1 = addContentHeaders hs0 off len size

44− !hasLM = isJust $ rspidx ! fromEnum ResLastModified

45− !hs = [ (H.hLastModified,date) | not hasLM ] ++ hs1

41+ WithBody s _ off len -> let !hs = (H.hLastModified,date) :

42+ addContentHeaders hs0 off len size

46 in WithBody s hs off len

43 in WithBody s hs off len

47 where

44 where

48 !mtime = I.fileInfoTime finfo

45 !mtime = I.fileInfoTime finfo

warp/Network/Wai/Handler/Warp/HTTP2.hs+5−4

@@ -24,14 +24,14 @@ import Network.Wai.Handler.Warp.Types

24

25----------------------------------------------------------------

26

27−http2 :: Connection -> Transport -> InternalInfo -> SockAddr -> S.Settings -> (BufSize -> IO ByteString) -> (ByteString -> IO ()) -> Application -> IO ()

27+http2 :: Connection -> Transport -> InternalInfo -> SockAddr -> S.Settings -> (BufSize -> IO ByteString) -> Application -> IO ()

28−http2 conn transport ii addr settings readN send app =

28+http2 conn transport ii addr settings readN app =

29 H2.run conf http2server

30 where

31 conf = H2.Config {

32 confWriteBuffer = connWriteBuffer conn

33 , confBufferSize = connBufferSize conn

34− , confSendAll = send

34+ , confSendAll = connSendAll conn

35 , confReadN = readN

36 , confPositionReadMaker = pReadMaker ii

37 }

@@ -63,12 +63,13 @@ http2 conn transport ii addr settings readN send app =

63 logResponse h2rsp' req

64 return ()

65

66− toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th transport

66+ toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th secure

67 where

68 !hdr = H2.requestHeaders h2req

69 !bdy = H2.getRequestBodyChunk h2req

70 !bdylen = H2.requestBodySize h2req

71 !th = H2.auxTimeHandle aux

72+ !secure = isTransportSecure transport

72

73

73 logResponse h2rsp req = logger req st msiz

74 logResponse h2rsp req = logger req st msiz

74 where

75 where

warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+6−7

@@ -22,23 +22,23 @@ import qualified System.TimeManager as T

22

23import Network.Wai.Handler.Warp.HTTP2.Types

24import Network.Wai.Handler.Warp.Imports

25−import Network.Wai.Handler.Warp.Request (getFileInfoKey, pauseTimeoutKey, getClientCertificateKey)

25+import Network.Wai.Handler.Warp.Request (getFileInfoKey, pauseTimeoutKey)

26import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)

27import Network.Wai.Handler.Warp.Types

28

29−type ToReq = (TokenHeaderList,ValueTable) -> Maybe Int -> IO ByteString -> T.Handle -> Transport -> IO Request

29+type ToReq = (TokenHeaderList,ValueTable) -> Maybe Int -> IO ByteString -> T.Handle -> Bool -> IO Request

30

31----------------------------------------------------------------

32

33toRequest :: InternalInfo -> S.Settings -> SockAddr -> ToReq

34−toRequest ii settings addr ht bodylen body th transport = do

34+toRequest ii settings addr ht bodylen body th secure = do

35 ref <- newIORef Nothing

36− toRequest' ii settings addr ref ht bodylen body th transport

36+ toRequest' ii settings addr ref ht bodylen body th secure

37

38toRequest' :: InternalInfo -> S.Settings -> SockAddr

39 -> IORef (Maybe HTTP2Data)

40 -> ToReq

41−toRequest' ii settings addr ref (reqths,reqvt) bodylen body th transport = return req

41+toRequest' ii settings addr ref (reqths,reqvt) bodylen body th secure = return req

42 where

43 !req = Request {

44 requestMethod = colonMethod

@@ -48,7 +48,7 @@ toRequest' ii settings addr ref (reqths,reqvt) bodylen body th transport = retur

48 , rawQueryString = query

49 , queryString = H.parseQuery query

50 , requestHeaders = headers

51− , isSecure = isTransportSecure transport

51+ , isSecure = secure

52 , remoteHost = addr

53 , requestBody = body

54 , vault = vaultValue

@@ -83,7 +83,6 @@ toRequest' ii settings addr ref (reqths,reqvt) bodylen body th transport = retur

83 $ Vault.insert setHTTP2DataKey (writeIORef ref)

84 $ Vault.insert modifyHTTP2DataKey (modifyIORef' ref)

85 $ Vault.insert pauseTimeoutKey (T.pause th)

86− $ Vault.insert getClientCertificateKey (tlsClientCertificate transport)

87 Vault.empty

86 Vault.empty

88

87

89getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data))

88getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data))

warp/Network/Wai/Handler/Warp/HTTP2/Response.hs+1−2

@@ -72,8 +72,7 @@ responseFile _ rsphdr isHead path Nothing ii reqhdr = do

72 Left (_ex :: E.IOException) -> return $ response404 rsphdr

73 Right finfo -> do

74 let reqidx = indexRequestHeader reqhdr

75− rspidx = indexResponseHeader rsphdr

76− case conditionalRequest finfo rsphdr rspidx reqidx of

75+ case conditionalRequest finfo rsphdr reqidx of

77 WithoutBody s -> return $ responseNoBody s rsphdr

76 WithoutBody s -> return $ responseNoBody s rsphdr

78 WithBody s rsphdr' off bytes -> do

77 WithBody s rsphdr' off bytes -> do

79 let !off' = fromIntegral off

78 let !off' = fromIntegral off

warp/Network/Wai/Handler/Warp/Header.hs−2

@@ -69,7 +69,6 @@ indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex

69data ResponseHeaderIndex = ResContentLength

70 | ResServer

71 | ResDate

72− | ResLastModified

73 deriving (Enum,Bounded)

72 deriving (Enum,Bounded)

74

73

75-- | The size for 'IndexedHeader' for HTTP Response.

74-- | The size for 'IndexedHeader' for HTTP Response.

@@ -80,7 +79,6 @@ responseKeyIndex :: HeaderName -> Int

80responseKeyIndex hn = case BS.length bs of

79responseKeyIndex hn = case BS.length bs of

81 4 -> if bs == "date" then fromEnum ResDate else -1

80 4 -> if bs == "date" then fromEnum ResDate else -1

82 6 -> if bs == "server" then fromEnum ResServer else -1

81 6 -> if bs == "server" then fromEnum ResServer else -1

83− 13 -> if bs == "last-modified" then fromEnum ResLastModified else -1

84 14 -> if bs == "content-length" then fromEnum ResContentLength else -1

82 14 -> if bs == "content-length" then fromEnum ResContentLength else -1

85 _ -> -1

83 _ -> -1

86 where

84 where

warp/Network/Wai/Handler/Warp/Recv.hs+1−13

@@ -17,9 +17,7 @@ import Foreign.C.Types

17import Foreign.ForeignPtr (withForeignPtr)

18import Foreign.Ptr (Ptr, castPtr, plusPtr)

19import GHC.Conc (threadWaitRead)

20−import qualified GHC.IO.Exception as E

21import Network.Socket (Socket)

20import Network.Socket (Socket)

22−import qualified System.IO.Error as E

23#if MIN_VERSION_network(3,1,0)

21#if MIN_VERSION_network(3,1,0)

24import Network.Socket (withFdSocket)

22import Network.Socket (withFdSocket)

25#else

23#else

@@ -96,11 +94,8 @@ spell init0 siz0 recv recvBuf

96 siz' = siz - len

94 siz' = siz - len

97 loop bss' siz'

95 loop bss' siz'

98

96

99−-- The timeout manager may close the socket.

100−-- In that case, an error of "Bad file descriptor" occurs.

101−-- We ignores it because we expect TimeoutThread.

102receive :: Socket -> BufferPool -> Recv

97receive :: Socket -> BufferPool -> Recv

103−receive sock pool = E.handle handler $ withBufferPool pool $ \ (ptr, size) -> do

98+receive sock pool = withBufferPool pool $ \ (ptr, size) -> do

104#if MIN_VERSION_network(3,1,0)

99#if MIN_VERSION_network(3,1,0)

105 withFdSocket sock $ \fd -> do

100 withFdSocket sock $ \fd -> do

106#elif MIN_VERSION_network(3,0,0)

101#elif MIN_VERSION_network(3,0,0)

@@ -110,11 +105,6 @@ receive sock pool = E.handle handler $ withBufferPool pool $ \ (ptr, size) -> do

110#endif

105#endif

111 let size' = fromIntegral size

106 let size' = fromIntegral size

112 fromIntegral <$> receiveloop fd ptr size'

107 fromIntegral <$> receiveloop fd ptr size'

113− where

114− handler :: E.IOException -> IO ByteString

115− handler e

116− | E.ioeGetErrorType e == E.InvalidArgument = return ""

117− | otherwise = E.throwIO e

118

108

119receiveBuf :: Socket -> RecvBuf

109receiveBuf :: Socket -> RecvBuf

120receiveBuf sock buf0 siz0 = do

110receiveBuf sock buf0 siz0 = do

@@ -153,8 +143,6 @@ receiveloop sock ptr size = do

153 else

143 else

154 return bytes

144 return bytes

155

145

156−#ifndef mingw32_HOST_OS

157-- fixme: the type of the return value

146-- fixme: the type of the return value

158foreign import ccall unsafe "recv"

147foreign import ccall unsafe "recv"

159 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

148 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt

160−#endif

warp/Network/Wai/Handler/Warp/Request.hs+19−21

@@ -9,7 +9,6 @@ module Network.Wai.Handler.Warp.Request (

9 , headerLines

10 , pauseTimeoutKey

11 , getFileInfoKey

12− , getClientCertificateKey

13 , NoKeepAliveRequest (..)

12 , NoKeepAliveRequest (..)

14 ) where

13 ) where

15

14

@@ -22,7 +21,6 @@ import qualified Data.CaseInsensitive as CI

22import qualified Data.IORef as I

21import qualified Data.IORef as I

23import Data.Typeable (Typeable)

22import Data.Typeable (Typeable)

24import qualified Data.Vault.Lazy as Vault

23import qualified Data.Vault.Lazy as Vault

25−import Data.X509

26import qualified Network.HTTP.Types as H

24import qualified Network.HTTP.Types as H

27import Network.Socket (SockAddr)

25import Network.Socket (SockAddr)

28import Network.Wai

26import Network.Wai

@@ -38,7 +36,13 @@ import Network.Wai.Handler.Warp.Header

38import Network.Wai.Handler.Warp.Imports hiding (readInt, lines)

36import Network.Wai.Handler.Warp.Imports hiding (readInt, lines)

39import Network.Wai.Handler.Warp.ReadInt

37import Network.Wai.Handler.Warp.ReadInt

40import Network.Wai.Handler.Warp.RequestHeader

38import Network.Wai.Handler.Warp.RequestHeader

41−import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath, settingsMaxTotalHeaderLength)

39+import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath)

40+

41+----------------------------------------------------------------

42+

43+-- FIXME come up with good values here

44+maxTotalHeaderLength :: Int

45+maxTotalHeaderLength = 50 * 1024

42

46

43----------------------------------------------------------------

47----------------------------------------------------------------

44

48

@@ -51,7 +55,6 @@ recvRequest :: Bool -- ^ first request on this connection?

51 -> Timeout.Handle

55 -> Timeout.Handle

52 -> SockAddr -- ^ Peer's address.

56 -> SockAddr -- ^ Peer's address.

53 -> Source -- ^ Where HTTP request comes from.

57 -> Source -- ^ Where HTTP request comes from.

54− -> Transport

55 -> IO (Request

58 -> IO (Request

56 ,Maybe (I.IORef Int)

59 ,Maybe (I.IORef Int)

57 ,IndexedHeader

60 ,IndexedHeader

@@ -61,8 +64,8 @@ recvRequest :: Bool -- ^ first request on this connection?

61 -- 'IndexedHeader' of HTTP request for internal use,

64 -- 'IndexedHeader' of HTTP request for internal use,

62 -- Body producing action used for flushing the request body

65 -- Body producing action used for flushing the request body

63

66

64−recvRequest firstRequest settings conn ii th addr src transport = do

67+recvRequest firstRequest settings conn ii th addr src = do

65− hdrlines <- headerLines (settingsMaxTotalHeaderLength settings) firstRequest src

68+ hdrlines <- headerLines firstRequest src

66 (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines

69 (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines

67 let idxhdr = indexRequestHeader hdr

70 let idxhdr = indexRequestHeader hdr

68 expect = idxhdr ! fromEnum ReqExpect

71 expect = idxhdr ! fromEnum ReqExpect

@@ -72,7 +75,6 @@ recvRequest firstRequest settings conn ii th addr src transport = do

72 rawPath = if settingsNoParsePath settings then unparsedPath else path

75 rawPath = if settingsNoParsePath settings then unparsedPath else path

73 vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)

76 vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)

74 $ Vault.insert getFileInfoKey (getFileInfo ii)

77 $ Vault.insert getFileInfoKey (getFileInfo ii)

75− $ Vault.insert getClientCertificateKey (tlsClientCertificate transport)

76 Vault.empty

78 Vault.empty

77 (rbody, remainingRef, bodyLength) <- bodyAndSource src cl te

79 (rbody, remainingRef, bodyLength) <- bodyAndSource src cl te

78 -- body producing function which will produce '100-continue', if needed

80 -- body producing function which will produce '100-continue', if needed

@@ -87,7 +89,7 @@ recvRequest firstRequest settings conn ii th addr src transport = do

87 , rawQueryString = query

89 , rawQueryString = query

88 , queryString = H.parseQuery query

90 , queryString = H.parseQuery query

89 , requestHeaders = hdr

91 , requestHeaders = hdr

90− , isSecure = isTransportSecure transport

92+ , isSecure = False

91 , remoteHost = addr

93 , remoteHost = addr

92 , requestBody = rbody'

94 , requestBody = rbody'

93 , vault = vaultValue

95 , vault = vaultValue

@@ -101,8 +103,8 @@ recvRequest firstRequest settings conn ii th addr src transport = do

101

103

102----------------------------------------------------------------

104----------------------------------------------------------------

103

105

104−headerLines :: Int -> Bool -> Source -> IO [ByteString]

106+headerLines :: Bool -> Source -> IO [ByteString]

105−headerLines maxTotalHeaderLength firstRequest src = do

107+headerLines firstRequest src = do

106 bs <- readSource src

108 bs <- readSource src

107 if S.null bs

109 if S.null bs

108 -- When we're working on a keep-alive connection and trying to

110 -- When we're working on a keep-alive connection and trying to

@@ -110,7 +112,7 @@ headerLines maxTotalHeaderLength firstRequest src = do

110 -- lack of data as a real exception. See the http1 function in

112 -- lack of data as a real exception. See the http1 function in

111 -- the Run module for more details.

113 -- the Run module for more details.

112 then if firstRequest then throwIO ConnectionClosedByPeer else throwIO NoKeepAliveRequest

114 then if firstRequest then throwIO ConnectionClosedByPeer else throwIO NoKeepAliveRequest

113− else push maxTotalHeaderLength src (THStatus 0 id id) bs

115+ else push src (THStatus 0 id id) bs

114

116

115data NoKeepAliveRequest = NoKeepAliveRequest

117data NoKeepAliveRequest = NoKeepAliveRequest

116 deriving (Show, Typeable)

118 deriving (Show, Typeable)

@@ -220,8 +222,8 @@ close :: Sink ByteString IO a

220close = throwIO IncompleteHeaders

222close = throwIO IncompleteHeaders

221-}

223-}

222

224

223−push :: Int -> Source -> THStatus -> ByteString -> IO [ByteString]

225+push :: Source -> THStatus -> ByteString -> IO [ByteString]

224−push maxTotalHeaderLength src (THStatus len lines prepend) bs'

226+push src (THStatus len lines prepend) bs'

225 -- Too many bytes

227 -- Too many bytes

226 | len > maxTotalHeaderLength = throwIO OverLargeHeader

228 | len > maxTotalHeaderLength = throwIO OverLargeHeader

227 | otherwise = push' mnl

229 | otherwise = push' mnl

@@ -249,13 +251,13 @@ push maxTotalHeaderLength src (THStatus len lines prepend) bs'

249 push' Nothing = do

251 push' Nothing = do

250 bst <- readSource' src

252 bst <- readSource' src

251 when (S.null bst) $ throwIO IncompleteHeaders

253 when (S.null bst) $ throwIO IncompleteHeaders

252− push maxTotalHeaderLength src status bst

254+ push src status bst

253 where

255 where

254 len' = len + bsLen

256 len' = len + bsLen

255 prepend' = S.append bs

257 prepend' = S.append bs

256 status = THStatus len' lines prepend'

258 status = THStatus len' lines prepend'

257 -- Found a newline, but next line continues as a multiline header

259 -- Found a newline, but next line continues as a multiline header

258− push' (Just (end, True)) = push maxTotalHeaderLength src status rest

260+ push' (Just (end, True)) = push src status rest

259 where

261 where

260 rest = S.drop (end + 1) bs

262 rest = S.drop (end + 1) bs

261 prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)

263 prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)

@@ -274,12 +276,12 @@ push maxTotalHeaderLength src (THStatus len lines prepend) bs'

274 in if start < bsLen then

276 in if start < bsLen then

275 -- more bytes in this chunk, push again

277 -- more bytes in this chunk, push again

276 let bs'' = SU.unsafeDrop start bs

278 let bs'' = SU.unsafeDrop start bs

277− in push maxTotalHeaderLength src status bs''

279+ in push src status bs''

278 else do

280 else do

279 -- no more bytes in this chunk, ask for more

281 -- no more bytes in this chunk, ask for more

280 bst <- readSource' src

282 bst <- readSource' src

281 when (S.null bs) $ throwIO IncompleteHeaders

283 when (S.null bs) $ throwIO IncompleteHeaders

282− push maxTotalHeaderLength src status bst

284+ push src status bst

283 where

285 where

284 start = end + 1 -- start of next chunk

286 start = end + 1 -- start of next chunk

285 line = SU.unsafeTake (checkCR bs end) bs

287 line = SU.unsafeTake (checkCR bs end) bs

@@ -297,7 +299,3 @@ pauseTimeoutKey = unsafePerformIO Vault.newKey

297getFileInfoKey :: Vault.Key (FilePath -> IO FileInfo)

299getFileInfoKey :: Vault.Key (FilePath -> IO FileInfo)

298getFileInfoKey = unsafePerformIO Vault.newKey

300getFileInfoKey = unsafePerformIO Vault.newKey

299{-# NOINLINE getFileInfoKey #-}

301{-# NOINLINE getFileInfoKey #-}

300−

301−getClientCertificateKey :: Vault.Key (Maybe CertificateChain)

302−getClientCertificateKey = unsafePerformIO Vault.newKey

303−{-# NOINLINE getClientCertificateKey #-}

warp/Network/Wai/Handler/Warp/Response.hs+16−19

@@ -116,14 +116,14 @@ sendResponse settings conn ii th req reqidxhdr src response = do

116 -- and status, the response to HEAD is processed here.

117 --

118 -- See definition of rsp below for proper body stripping.

119− (ms, mlen) <- sendRsp conn ii ver s hs rspidxhdr rsp

119+ (ms, mlen) <- sendRsp conn ii ver s hs rsp

120 case ms of

121 Nothing -> return ()

122 Just realStatus -> logger req realStatus mlen

123 T.tickle th

124 return ret

125 else do

126− _ <- sendRsp conn ii ver s hs rspidxhdr RspNoBody

126+ _ <- sendRsp conn ii ver s hs RspNoBody

127 logger req s Nothing

128 T.tickle th

129 return isPersist

@@ -196,13 +196,12 @@ sendRsp :: Connection

196 -> H.HttpVersion

197 -> H.Status

198 -> H.ResponseHeaders

199− -> IndexedHeader -- Response

200 -> Rsp

199 -> Rsp

201 -> IO (Maybe H.Status, Maybe Integer)

200 -> IO (Maybe H.Status, Maybe Integer)

202

201

203----------------------------------------------------------------

202----------------------------------------------------------------

204

203

205−sendRsp conn _ ver s hs _ RspNoBody = do

204+sendRsp conn _ ver s hs RspNoBody = do

206 -- Not adding Content-Length.

205 -- Not adding Content-Length.

207 -- User agents treats it as Content-Length: 0.

206 -- User agents treats it as Content-Length: 0.

208 composeHeader ver s hs >>= connSendAll conn

207 composeHeader ver s hs >>= connSendAll conn

@@ -210,7 +209,7 @@ sendRsp conn _ ver s hs _ RspNoBody = do

210

209

211----------------------------------------------------------------

210----------------------------------------------------------------

212

211

213−sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do

212+sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do

214 header <- composeHeaderBuilder ver s hs needsChunked

213 header <- composeHeaderBuilder ver s hs needsChunked

215 let hdrBdy

214 let hdrBdy

216 | needsChunked = header <> chunkedTransferEncoding body

215 | needsChunked = header <> chunkedTransferEncoding body

@@ -223,7 +222,7 @@ sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do

223

222

224----------------------------------------------------------------

223----------------------------------------------------------------

225

224

226−sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = do

225+sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do

227 header <- composeHeaderBuilder ver s hs needsChunked

226 header <- composeHeaderBuilder ver s hs needsChunked

228 (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy

227 (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy

229 $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)

228 $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)

@@ -247,7 +246,7 @@ sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = do

247

246

248----------------------------------------------------------------

247----------------------------------------------------------------

249

248

250−sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do

249+sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do

251 withApp recv send

250 withApp recv send

252 return (Nothing, Nothing)

251 return (Nothing, Nothing)

253 where

252 where

@@ -261,8 +260,8 @@ sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do

261

260

262-- Sophisticated WAI applications.

261-- Sophisticated WAI applications.

263-- We respect s0. s0 MUST be a proper value.

262-- We respect s0. s0 MUST be a proper value.

264−sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =

263+sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) =

265− sendRspFile2XX conn ii ver s0 hs rspidxhdr path beg len isHead hook

264+ sendRspFile2XX conn ii ver s0 hs path beg len isHead hook

266 where

265 where

267 beg = filePartOffset part

266 beg = filePartOffset part

268 len = filePartByteCount part

267 len = filePartByteCount part

@@ -272,17 +271,17 @@ sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =

272

271

273-- Simple WAI applications.

272-- Simple WAI applications.

274-- Status is ignored

273-- Status is ignored

275−sendRsp conn ii ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do

274+sendRsp conn ii ver _ hs0 (RspFile path Nothing idxhdr isHead hook) = do

276 efinfo <- E.try $ getFileInfo ii path

275 efinfo <- E.try $ getFileInfo ii path

277 case efinfo of

276 case efinfo of

278 Left (_ex :: E.IOException) ->

277 Left (_ex :: E.IOException) ->

279#ifdef WARP_DEBUG

278#ifdef WARP_DEBUG

280 print _ex >>

279 print _ex >>

281#endif

280#endif

282− sendRspFile404 conn ii ver hs0 rspidxhdr

281+ sendRspFile404 conn ii ver hs0

283− Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of

282+ Right finfo -> case conditionalRequest finfo hs0 idxhdr of

284− WithoutBody s -> sendRsp conn ii ver s hs0 rspidxhdr RspNoBody

283+ WithoutBody s -> sendRsp conn ii ver s hs0 RspNoBody

285− WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook

284+ WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs path beg len isHead hook

286

285

287----------------------------------------------------------------

286----------------------------------------------------------------

288

287

@@ -291,15 +290,14 @@ sendRspFile2XX :: Connection

291 -> H.HttpVersion

290 -> H.HttpVersion

292 -> H.Status

291 -> H.Status

293 -> H.ResponseHeaders

292 -> H.ResponseHeaders

294− -> IndexedHeader

295 -> FilePath

293 -> FilePath

296 -> Integer

294 -> Integer

297 -> Integer

295 -> Integer

298 -> Bool

296 -> Bool

299 -> IO ()

297 -> IO ()

300 -> IO (Maybe H.Status, Maybe Integer)

298 -> IO (Maybe H.Status, Maybe Integer)

301−sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook

299+sendRspFile2XX conn ii ver s hs path beg len isHead hook

302− | isHead = sendRsp conn ii ver s hs rspidxhdr RspNoBody

300+ | isHead = sendRsp conn ii ver s hs RspNoBody

303 | otherwise = do

301 | otherwise = do

304 lheader <- composeHeader ver s hs

302 lheader <- composeHeader ver s hs

305 (mfd, fresher) <- getFd ii path

303 (mfd, fresher) <- getFd ii path

@@ -312,9 +310,8 @@ sendRspFile404 :: Connection

312 -> InternalInfo

310 -> InternalInfo

313 -> H.HttpVersion

311 -> H.HttpVersion

314 -> H.ResponseHeaders

312 -> H.ResponseHeaders

315− -> IndexedHeader

316 -> IO (Maybe H.Status, Maybe Integer)

313 -> IO (Maybe H.Status, Maybe Integer)

317−sendRspFile404 conn ii ver hs0 rspidxhdr = sendRsp conn ii ver s hs rspidxhdr (RspBuilder body True)

314+sendRspFile404 conn ii ver hs0 = sendRsp conn ii ver s hs (RspBuilder body True)

318 where

315 where

319 s = H.notFound404

316 s = H.notFound404

320 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0

317 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0

warp/Network/Wai/Handler/Warp/Run.hs+26−35

@@ -17,7 +17,7 @@ import qualified Control.Concurrent as Conc (yield)

17import Control.Exception as E

18import qualified Data.ByteString as S

19import Data.Char (chr)

20−import Data.IORef (IORef, newIORef, readIORef, writeIORef)

20+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef')

21import Data.Streaming.Network (bindPortTCP)

22import Foreign.C.Error (Errno(..), eCONNABORTED)

23import GHC.IO.Exception (IOException(..))

@@ -58,29 +58,17 @@ import Network.Socket (fdSocket)

58#endif

59

60-- | Creating 'Connection' for plain HTTP based on a given socket.

61−socketConnection :: Settings -> Socket -> IO Connection

61+socketConnection :: Socket -> IO Connection

62−#if MIN_VERSION_network(3,1,1)

63−socketConnection set s = do

64−#else

65−socketConnection _ s = do

62+socketConnection s = do

66−#endif

67 bufferPool <- newBufferPool

63 bufferPool <- newBufferPool

68 writeBuf <- allocateBuffer bufferSize

64 writeBuf <- allocateBuffer bufferSize

69 let sendall = Sock.sendAll s

65 let sendall = Sock.sendAll s

70− isH2 <- newIORef False -- HTTP/1.x

71 return Connection {

66 return Connection {

72 connSendMany = Sock.sendMany s

67 connSendMany = Sock.sendMany s

73 , connSendAll = sendall

68 , connSendAll = sendall

74 , connSendFile = sendFile s writeBuf bufferSize sendall

69 , connSendFile = sendFile s writeBuf bufferSize sendall

75#if MIN_VERSION_network(3,1,1)

70#if MIN_VERSION_network(3,1,1)

76− , connClose = do

71+ , connClose = gracefulClose s 5000

77− h2 <- readIORef isH2

78− let tm = if h2 then settingsGracefulCloseTimeout2 set

79− else settingsGracefulCloseTimeout1 set

80− if tm == 0 then

81− close s

82− else

83− gracefulClose s tm `E.catch` \(E.SomeException _) -> return ()

84#else

72#else

85 , connClose = close s

73 , connClose = close s

86#endif

74#endif

@@ -89,7 +77,6 @@ socketConnection _ s = do

89 , connRecvBuf = receiveBuf s

77 , connRecvBuf = receiveBuf s

90 , connWriteBuffer = writeBuf

78 , connWriteBuffer = writeBuf

91 , connBufferSize = bufferSize

79 , connBufferSize = bufferSize

92− , connHTTP2 = isH2

93 }

80 }

94

81

95-- | Run an 'Application' on the given port.

82-- | Run an 'Application' on the given port.

@@ -151,7 +138,7 @@ runSettingsSocket set socket app = do

151 setSocketCloseOnExec s

138 setSocketCloseOnExec s

152 -- NoDelay causes an error for AF_UNIX.

139 -- NoDelay causes an error for AF_UNIX.

153 setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()

140 setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()

154− conn <- socketConnection set s

141+ conn <- socketConnection s

155 return (conn, sa)

142 return (conn, sa)

156

143

157 closeListenSocket = close socket

144 closeListenSocket = close socket

@@ -286,7 +273,10 @@ fork :: Settings

286fork set mkConn addr app counter ii = settingsFork set $ \unmask ->

273fork set mkConn addr app counter ii = settingsFork set $ \unmask ->

287 -- Call the user-supplied on exception code if any

274 -- Call the user-supplied on exception code if any

288 -- exceptions are thrown.

275 -- exceptions are thrown.

289− handle (settingsOnException set Nothing) $

276+ handle (settingsOnException set Nothing) .

277+ -- Allocate a new IORef indicating whether the connection has been

278+ -- closed, to avoid double-freeing a connection

279+ withClosedRef $ \ref ->

290 -- Run the connection maker to get a new connection, and ensure

280 -- Run the connection maker to get a new connection, and ensure

291 -- that the connection is closed. If the mkConn call throws an

281 -- that the connection is closed. If the mkConn call throws an

292 -- exception, we will leak the connection. If the mkConn call is

282 -- exception, we will leak the connection. If the mkConn call is

@@ -297,13 +287,21 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->

297 -- We grab the connection before registering timeouts since the

287 -- We grab the connection before registering timeouts since the

298 -- timeouts will be useless during connection creation, due to the

288 -- timeouts will be useless during connection creation, due to the

299 -- fact that async exceptions are still masked.

289 -- fact that async exceptions are still masked.

300− bracket mkConn cleanUp (serve unmask)

290+ bracket mkConn (cleanUp ref) (serve unmask ref)

301 where

291 where

292+ withClosedRef inner = newIORef False >>= inner

293+

294+ closeConn ref conn = do

295+ isClosed <- atomicModifyIORef' ref $ \x -> (True, x)

296+ unless isClosed $ connClose conn

297+

302− cleanUp (conn, _) = connClose conn `finally` connFree conn

298+ cleanUp ref (conn, _) = closeConn ref conn `finally` connFree conn

303

299

304 -- We need to register a timeout handler for this thread, and

300 -- We need to register a timeout handler for this thread, and

305− -- cancel that handler as soon as we exit.

301+ -- cancel that handler as soon as we exit. We additionally close

302+ -- the connection immediately in case the child thread catches the

303+ -- async exception or performs some long-running cleanup action.

306− serve unmask (conn, transport) = bracket register cancel $ \th -> do

304+ serve unmask ref (conn, transport) = bracket register cancel $ \th -> do

307 -- We now have fully registered a connection close handler in

305 -- We now have fully registered a connection close handler in

308 -- the case of all exceptions, so it is safe to once again

306 -- the case of all exceptions, so it is safe to once again

309 -- allow async exceptions.

307 -- allow async exceptions.

@@ -315,7 +313,8 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->

315 -- above ensures the connection is closed.

313 -- above ensures the connection is closed.

316 when goingon $ serveConnection conn ii th addr transport set app

314 when goingon $ serveConnection conn ii th addr transport set app

317 where

315 where

318− register = T.registerKillThread (timeoutManager ii) (connClose conn)

316+ register = T.registerKillThread (timeoutManager ii)

317+ (closeConn ref conn)

319 cancel = T.cancel

318 cancel = T.cancel

320

319

321 onOpen adr = increase counter >> settingsOnOpen set adr

320 onOpen adr = increase counter >> settingsOnOpen set adr

@@ -342,19 +341,10 @@ serveConnection conn ii th origAddr transport settings app = do

342 istatus <- newIORef False

341 istatus <- newIORef False

343 if settingsHTTP2Enabled settings && h2 then do

342 if settingsHTTP2Enabled settings && h2 then do

344 rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)

343 rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)

345− -- This thread becomes the sender in http2 library.

346− -- In the case of event source, one request comes and one

347− -- worker gets busy. But it is likely that the receiver does

348− -- not receive any data at all while the sender is sending

349− -- output data from the worker. It's not good enough to tickle

350− -- the time handler in the receiver only. So, we should tickle

351− -- the time handler in both the receiver and the sender.

352 let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN

344 let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN

353− sendBS x = connSendAll conn x >> T.tickle th

354 -- fixme: origAddr

345 -- fixme: origAddr

355 checkTLS

346 checkTLS

356− setConnHTTP2 conn True

357− http2 conn transport ii origAddr settings recvN sendBS app

347+ http2 conn transport ii origAddr settings recvN app

358 else do

348 else do

359 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))

349 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))

360 writeIORef istatus True

350 writeIORef istatus True

@@ -429,7 +419,8 @@ serveConnection conn ii th origAddr transport settings app = do

429 errorResponse e = settingsOnExceptionResponse settings e

419 errorResponse e = settingsOnExceptionResponse settings e

430

420

431 http1 firstRequest addr istatus src = do

421 http1 firstRequest addr istatus src = do

432− (req, mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src transport

422+ (req', mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src

423+ let req = req' { isSecure = isTransportSecure transport }

433 keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush

424 keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush

434 `E.catch` \e -> do

425 `E.catch` \e -> do

435 settingsOnException settings (Just req) e

426 settingsOnException settings (Just req) e

warp/Network/Wai/Handler/Warp/Settings.hs+5−31

@@ -76,13 +76,6 @@ data Settings = Settings

76 --

77 -- Since 2.0.3

78 , settingsInstallShutdownHandler :: IO () -> IO ()

79− -- ^ An action to install a handler (e.g. Unix signal handler)

80− -- to close a listen socket.

81− -- The first argument is an action to close the listen socket.

82− --

83− -- Default: no action

84− --

85− -- Since 3.0.1

86 , settingsServerName :: ByteString

79 , settingsServerName :: ByteString

87 -- ^ Default server name if application does not set one.

80 -- ^ Default server name if application does not set one.

88 --

81 --

@@ -94,44 +87,28 @@ data Settings = Settings

94 , settingsProxyProtocol :: ProxyProtocol

87 , settingsProxyProtocol :: ProxyProtocol

95 -- ^ Specify usage of the PROXY protocol.

88 -- ^ Specify usage of the PROXY protocol.

96 --

89 --

97− -- Since 3.0.5

90+ -- Since 3.0.5.

98 , settingsSlowlorisSize :: Int

91 , settingsSlowlorisSize :: Int

99 -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048

92 -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048

100 --

93 --

101− -- Since 3.1.2

94+ -- Since 3.1.2.

102 , settingsHTTP2Enabled :: Bool

95 , settingsHTTP2Enabled :: Bool

103 -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True

96 -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True

104 --

97 --

105− -- Since 3.1.7

98+ -- Since 3.1.7.

106 , settingsLogger :: Request -> H.Status -> Maybe Integer -> IO ()

99 , settingsLogger :: Request -> H.Status -> Maybe Integer -> IO ()

107 -- ^ A log function. Default: no action.

100 -- ^ A log function. Default: no action.

108 --

101 --

109− -- Since 3.1.10

102+ -- Since 3.X.X.

110 , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()

103 , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()

111 -- ^ A HTTP/2 server push log function. Default: no action.

104 -- ^ A HTTP/2 server push log function. Default: no action.

112 --

105 --

113− -- Since 3.2.7

106+ -- Since 3.X.X.

114 , settingsGracefulShutdownTimeout :: Maybe Int

107 , settingsGracefulShutdownTimeout :: Maybe Int

115 -- ^ An optional timeout to limit the time (in seconds) waiting for

108 -- ^ An optional timeout to limit the time (in seconds) waiting for

116 -- a graceful shutdown of the web server.

109 -- a graceful shutdown of the web server.

117 --

110 --

118 -- Since 3.2.8

111 -- Since 3.2.8

119− , settingsGracefulCloseTimeout1 :: Int

120− -- ^ A timeout to limit the time (in milliseconds) waiting for

121− -- FIN for HTTP/1.x. 0 means uses immediate close.

122− -- Default: 0.

123− --

124− -- Since 3.3.5

125− , settingsGracefulCloseTimeout2 :: Int

126− -- ^ A timeout to limit the time (in milliseconds) waiting for

127− -- FIN for HTTP/2. 0 means uses immediate close.

128− -- Default: 2000.

129− --

130− -- Since 3.3.5

131− , settingsMaxTotalHeaderLength :: Int

132− -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.

133− --

134− -- Since 3.3.8

135 }

112 }

136

113

137-- | Specify usage of the PROXY protocol.

114-- | Specify usage of the PROXY protocol.

@@ -168,9 +145,6 @@ defaultSettings = Settings

168 , settingsLogger = \_ _ _ -> return ()

145 , settingsLogger = \_ _ _ -> return ()

169 , settingsServerPushLogger = \_ _ _ -> return ()

146 , settingsServerPushLogger = \_ _ _ -> return ()

170 , settingsGracefulShutdownTimeout = Nothing

147 , settingsGracefulShutdownTimeout = Nothing

171− , settingsGracefulCloseTimeout1 = 0

172− , settingsGracefulCloseTimeout2 = 2000

173− , settingsMaxTotalHeaderLength = 50 * 1024

174 }

148 }

175

149

176-- | Apply the logic provided by 'defaultOnException' to determine if an

150-- | Apply the logic provided by 'defaultOnException' to determine if an

warp/Network/Wai/Handler/Warp/Types.hs−10

@@ -8,7 +8,6 @@ import Control.Exception

8import qualified Data.ByteString as S

9import Data.IORef (IORef, readIORef, writeIORef, newIORef)

10import Data.Typeable (Typeable)

11−import Data.X509

12import Foreign.Ptr (Ptr)

11import Foreign.Ptr (Ptr)

13import System.Posix.Types (Fd)

12import System.Posix.Types (Fd)

14import qualified System.TimeManager as T

13import qualified System.TimeManager as T

@@ -123,16 +122,8 @@ data Connection = Connection {

123 , connWriteBuffer :: Buffer

122 , connWriteBuffer :: Buffer

124 -- | The size of the write buffer.

123 -- | The size of the write buffer.

125 , connBufferSize :: BufSize

124 , connBufferSize :: BufSize

126− -- | Is this connection HTTP/2?

127− , connHTTP2 :: IORef Bool

128 }

125 }

129

126

130−getConnHTTP2 :: Connection -> IO Bool

131−getConnHTTP2 conn = readIORef (connHTTP2 conn)

132−

133−setConnHTTP2 :: Connection -> Bool -> IO ()

134−setConnHTTP2 conn b = writeIORef (connHTTP2 conn) b

135−

136----------------------------------------------------------------

127----------------------------------------------------------------

137

128

138data InternalInfo = InternalInfo {

129data InternalInfo = InternalInfo {

@@ -180,7 +171,6 @@ data Transport = TCP -- ^ Plain channel: TCP

180 , tlsMinorVersion :: Int

171 , tlsMinorVersion :: Int

181 , tlsNegotiatedProtocol :: Maybe ByteString -- ^ The result of Application Layer Protocol Negociation in RFC 7301

172 , tlsNegotiatedProtocol :: Maybe ByteString -- ^ The result of Application Layer Protocol Negociation in RFC 7301

182 , tlsChiperID :: Word16

173 , tlsChiperID :: Word16

183− , tlsClientCertificate :: Maybe CertificateChain

184 } -- ^ Encrypted channel: TLS or SSL

174 } -- ^ Encrypted channel: TLS or SSL

185

175

186isTransportSecure :: Transport -> Bool

176isTransportSecure :: Transport -> Bool

warp/test/FileSpec.hs+1−1

@@ -21,7 +21,7 @@ testFileRange desc reqhs file ans = it desc $ do

21 let WithBody s hs off len = ans

22 hs' = ("Last-Modified",fileInfoDate finfo) : hs

23 ans' = WithBody s hs' off len

24− conditionalRequest finfo [] (indexResponseHeader hs) (indexRequestHeader reqhs) `shouldBe` ans'

24+ conditionalRequest finfo [] (indexRequestHeader reqhs) `shouldBe` ans'

25

26spec :: Spec

27spec = do

warp/test/RequestSpec.hs+7−11

@@ -7,7 +7,6 @@ module RequestSpec (main, spec) where

7import Network.Wai.Handler.Warp.File (parseByteRanges)

8import Network.Wai.Handler.Warp.Request

9import Network.Wai.Handler.Warp.Types

10−import Network.Wai.Handler.Warp.Settings (settingsMaxTotalHeaderLength, defaultSettings)

11import Test.Hspec

10import Test.Hspec

12import Test.Hspec.QuickCheck

11import Test.Hspec.QuickCheck

13import qualified Data.ByteString as S

12import qualified Data.ByteString as S

@@ -18,9 +17,6 @@ import Data.IORef

18main :: IO ()

17main :: IO ()

19main = hspec spec

18main = hspec spec

20

19

21−defaultMaxTotalHeaderLength :: Int

22−defaultMaxTotalHeaderLength = settingsMaxTotalHeaderLength defaultSettings

23−

24spec :: Spec

20spec :: Spec

25spec = do

21spec = do

26 describe "headerLines" $ do

22 describe "headerLines" $ do

@@ -67,29 +63,29 @@ spec = do

67 describe "headerLines" $ do

63 describe "headerLines" $ do

68 it "can handle a nomarl case" $ do

64 it "can handle a nomarl case" $ do

69 src <- mkSourceFunc ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"] >>= mkSource

65 src <- mkSourceFunc ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"] >>= mkSource

70− x <- headerLines defaultMaxTotalHeaderLength True src

66+ x <- headerLines True src

71 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

67 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

72

68

73 it "can handle a nasty case (1)" $ do

69 it "can handle a nasty case (1)" $ do

74 src <- mkSourceFunc ["Status: 200", "\r\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource

70 src <- mkSourceFunc ["Status: 200", "\r\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource

75− x <- headerLines defaultMaxTotalHeaderLength True src

71+ x <- headerLines True src

76 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

72 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

77

73

78 it "can handle a nasty case (1)" $ do

74 it "can handle a nasty case (1)" $ do

79 src <- mkSourceFunc ["Status: 200", "\r", "\nContent-Type: text/plain", "\r", "\n\r\n"] >>= mkSource

75 src <- mkSourceFunc ["Status: 200", "\r", "\nContent-Type: text/plain", "\r", "\n\r\n"] >>= mkSource

80− x <- headerLines defaultMaxTotalHeaderLength True src

76+ x <- headerLines True src

81 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

77 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

82

78

83 it "can handle a nasty case (1)" $ do

79 it "can handle a nasty case (1)" $ do

84 src <- mkSourceFunc ["Status: 200", "\r", "\n", "Content-Type: text/plain", "\r", "\n", "\r", "\n"] >>= mkSource

80 src <- mkSourceFunc ["Status: 200", "\r", "\n", "Content-Type: text/plain", "\r", "\n", "\r", "\n"] >>= mkSource

85− x <- headerLines defaultMaxTotalHeaderLength True src

81+ x <- headerLines True src

86 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

82 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]

87

83

88 it "can handle an illegal case (1)" $ do

84 it "can handle an illegal case (1)" $ do

89 src <- mkSourceFunc ["\nStatus:", "\n 200", "\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource

85 src <- mkSourceFunc ["\nStatus:", "\n 200", "\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource

90− x <- headerLines defaultMaxTotalHeaderLength True src

86+ x <- headerLines True src

91 x `shouldBe` []

87 x `shouldBe` []

92− y <- headerLines defaultMaxTotalHeaderLength True src

88+ y <- headerLines True src

93 y `shouldBe` ["Status: 200", "Content-Type: text/plain"]

89 y `shouldBe` ["Status: 200", "Content-Type: text/plain"]

94

90

95 where

91 where

@@ -115,7 +111,7 @@ headerLinesList' orig = do

115 writeIORef ref z

111 writeIORef ref z

116 return y

112 return y

117 src' <- mkSource src

113 src' <- mkSource src

118− res <- headerLines defaultMaxTotalHeaderLength True src'

114+ res <- headerLines True src'

119 return (res, src')

115 return (res, src')

120

116

121consumeLen :: Int -> Source -> IO S8.ByteString

117consumeLen :: Int -> Source -> IO S8.ByteString

warp/test/ResponseSpec.hs+1−1

@@ -83,7 +83,7 @@ spec = do

83 it "discards empty lines" $ do

84 sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar"

85

86− context "when sanitizing single occurrences of \n" $ do

86+ context "when sanitizing single occurences of \n" $ do

87 it "replaces \n with \r\n" $ do

88 sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar"

89

warp/warp.cabal+1−4

@@ -1,5 +1,5 @@

1Name: warp

2−Version: 3.3.9

2+Version: 3.3.3

3Synopsis: A fast, light-weight web server for WAI applications.

4License: MIT

5License-file: LICENSE

@@ -56,7 +56,6 @@ Library

56 , vault >= 0.3

57 , wai >= 3.2 && < 3.3

58 , word8

59− , x509

60 if impl(ghc < 8)

59 if impl(ghc < 8)

61 Build-Depends: semigroups

60 Build-Depends: semigroups

62 if flag(network-bytestring)

61 if flag(network-bytestring)

@@ -212,7 +211,6 @@ Test-Suite spec

212 , vault

211 , vault

213 , wai >= 3.2 && < 3.3

212 , wai >= 3.2 && < 3.3

214 , word8

213 , word8

215− , x509

216 -- Build-Tool-Depends: hspec-discover:hspec-discover

214 -- Build-Tool-Depends: hspec-discover:hspec-discover

217 if impl(ghc < 8)

215 if impl(ghc < 8)

218 Build-Depends: semigroups

216 Build-Depends: semigroups

@@ -251,7 +249,6 @@ Benchmark parser

251 , network

249 , network

252 , time-manager

250 , time-manager

253 , unix-compat

251 , unix-compat

254− , x509

255 if impl(ghc < 8)

252 if impl(ghc < 8)

256 Build-Depends: semigroups

253 Build-Depends: semigroups

257

254