on 7553bd4 help sign in
27 files changed+70−147
since splitsnapshots
unifiedsplit
stack.yaml+1−1 wai-app-static/Network/Wai/Application/Static.hs+6−8 wai-app-static/WaiAppStatic/CmdLine.hs−1 wai-app-static/WaiAppStatic/Listing.hs+1−1 wai-app-static/WaiAppStatic/Storage/Embedded/TH.hs+1 wai-app-static/WaiAppStatic/Types.hs−2 wai-conduit/Network/Wai/Conduit.hs+6−5 wai-extra/ChangeLog.md−4 wai-extra/Network/Wai/Test.hs+14−22 wai-extra/example/Main.hs+2−2 wai-extra/test/Network/Wai/TestSpec.hs+11−41 wai-extra/wai-extra.cabal+1−1 wai-websockets/server.lhs−6 wai-websockets/wai-websockets.cabal−1 warp-tls/ChangeLog.md−4 warp-tls/Network/Wai/Handler/WarpTLS.hs+1−1 warp-tls/warp-tls.cabal+1−1 warp/ChangeLog.md−6 warp/Network/Wai/Handler/Warp.hs+1−1 warp/Network/Wai/Handler/Warp/File.hs+4−7 warp/Network/Wai/Handler/Warp/HTTP2/Response.hs+1−2 warp/Network/Wai/Handler/Warp/Header.hs−2 warp/Network/Wai/Handler/Warp/Recv.hs−2 warp/Network/Wai/Handler/Warp/Response.hs+16−19 warp/Network/Wai/Handler/Warp/Run.hs+1−5 warp/test/FileSpec.hs+1−1 warp/warp.cabal+1−1
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-14.22
1+resolver: lts-14.20
22packages:
33- ./auto-update
44- ./mime-types
wai-app-static/Network/Wai/Application/Static.hs+6−8
@@ -164,13 +164,11 @@ serveFile StaticSettings {..} req file
164164 -- Didn't match, but we have a hash value. Send the file contents
165165 -- with an ETag header.
166166 --
167− -- RFC7232 (HTTP 1.1):
168− -- > A recipient MUST ignore If-Modified-Since if the request contains an
169− -- > If-None-Match header field; the condition in If-None-Match is
170− -- > considered to be a more accurate replacement for the condition in
171− -- > If-Modified-Since, and the two are only combined for the sake of
172− -- > interoperating with older intermediaries that might not implement
173− -- > If-None-Match.
167+ -- Note: It would be arguably better to next check
168+ -- if-modified-since and return a 304 if that indicates a match as
169+ -- well. However, the circumstances under which such a situation
170+ -- could arise would be very anomalous, and should likely warrant a
171+ -- new file being sent anyway.
174172 (Just hash, _) -> respond [("ETag", hash)]
175173
176174 -- No hash value available, fall back to last modified support.
@@ -245,7 +243,7 @@ staticAppPieces ss rawPieces req sendResponse = liftIO $ do
245243 response :: StaticResponse -> IO W.ResponseReceived
246244 response (FileResponse file ch) = do
247245 mimetype <- ssGetMimeType ss file
248− -- let filesize = fileGetSize file
246+ let filesize = fileGetSize file
249247 let headers = ("Content-Type", mimetype)
250248 -- Let Warp provide the content-length, since it takes
251249 -- range requests into account
wai-app-static/WaiAppStatic/CmdLine.hs−1
@@ -39,7 +39,6 @@ data Args = Args
3939 }
4040
4141#if MIN_VERSION_optparse_applicative(0, 10, 0)
42−option' :: Mod OptionFields Int -> Parser Int
4342option' = option auto
4443#else
4544option' = option
wai-app-static/WaiAppStatic/Listing.hs+1−1
@@ -64,7 +64,7 @@ defaultListing pieces (Folder contents) = do
6464
6565 -- Add a link to the root of the tree
6666 showFolder' :: Bool -> Pieces -> H.Html
67− showFolder' hasTrailingSlash pieces' = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces')
67+ showFolder' hasTrailingSlash pieces = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces)
6868
6969 showFolder :: Bool -> Pieces -> H.Html
7070 showFolder _ [] = "/" -- won't happen
wai-app-static/WaiAppStatic/Storage/Embedded/TH.hs+1
@@ -7,6 +7,7 @@ module WaiAppStatic.Storage.Embedded.TH(
77
88import Data.ByteString.Builder.Extra (byteStringInsert)
99import Codec.Compression.GZip (compress)
10+import Control.Applicative
1011import Data.ByteString.Unsafe (unsafePackAddressLen)
1112import Data.Either (lefts, rights)
1213import GHC.Exts (Int(..))
wai-app-static/WaiAppStatic/Types.hs−2
@@ -59,8 +59,6 @@ toPieces :: [Text] -> Maybe Pieces
5959toPieces = mapM toPiece
6060
6161-- | Request coming from a user. Corresponds to @pathInfo@.
62−--
63−-- The root path is the empty list.
6462type Pieces = [Piece]
6563
6664-- | Values for the max-age component of the cache-control response header.
wai-conduit/Network/Wai/Conduit.hs+6−5
@@ -17,16 +17,17 @@ import qualified Data.ByteString as S
1717import Control.Monad (unless)
1818import Network.HTTP.Types
1919import Data.ByteString.Builder (Builder)
20+import Data.IORef
2021import qualified Data.Conduit.List as CL
2122
2223-- | Stream the request body.
2324--
2425-- Since 3.0.0
25−sourceRequestBody :: MonadIO m => Request -> ConduitT () ByteString m ()
26+sourceRequestBody :: MonadIO m => Request -> Source m ByteString
2627sourceRequestBody req =
2728 loop
2829 where
29− go = liftIO (getRequestBodyChunk req)
30+ go = liftIO (requestBody req)
3031
3132 loop = do
3233 bs <- go
@@ -37,9 +38,9 @@ sourceRequestBody req =
3738-- | Create an HTTP response out of a @Source@.
3839--
3940-- Since 3.0.0
40−responseSource :: Status -> ResponseHeaders -> ConduitT () (Flush Builder) IO () -> Response
41+responseSource :: Status -> ResponseHeaders -> Source IO (Flush Builder) -> Response
4142responseSource s hs src = responseStream s hs $ \send flush ->
42− runConduit $ src .| CL.mapM_ (\mbuilder ->
43+ src $$ CL.mapM_ (\mbuilder ->
4344 case mbuilder of
4445 Chunk b -> send b
4546 Flush -> flush)
@@ -49,7 +50,7 @@ responseSource s hs src = responseStream s hs $ \send flush ->
4950--
5051-- Since 3.0.0
5152responseRawSource :: (MonadIO m, MonadIO n)
52− => (ConduitT () ByteString m () -> ConduitT ByteString Void n () -> IO ())
53+ => (Source m ByteString -> Sink ByteString n () -> IO ())
5354 -> Response
5455 -> Response
5556responseRawSource app =
wai-extra/ChangeLog.md−4
@@ -1,9 +1,5 @@
11# Changelog for wai-extra
22
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−
73## 3.0.29
84
95* Export `Network.Wai.EventSource.eventStreamAppRaw` [#786](https://github.com/yesodweb/wai/pull/786)
wai-extra/Network/Wai/Test.hs+14−22
@@ -99,10 +99,6 @@ runSession session app = ST.evalStateT (runReaderT session app) initState
9999data SRequest = SRequest
100100 { simpleRequest :: Request
101101 , 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'.
106102 }
107103data SResponse = SResponse
108104 { simpleStatus :: H.Status
@@ -110,16 +106,8 @@ data SResponse = SResponse
110106 , simpleBody :: L.ByteString
111107 }
112108 deriving (Show, Eq)
113−
114109request :: Request -> Session SResponse
115−request req = do
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
110+request = srequest . flip SRequest L.empty
123111
124112-- | Set whole path (request path + query string).
125113setPath :: Request -> S8.ByteString -> Request
@@ -178,18 +166,22 @@ extractSetCookieFromSResponse response = do
178166 (Map.fromList [(Cookie.setCookieName c, c) | c <- newClientCookies ]))
179167 return response
180168
181−-- | Similar to 'request', but allows setting the request body as a plain
182−-- 'L.ByteString'.
183169srequest :: SRequest -> Session SResponse
184170srequest (SRequest req bod) = do
171+ app <- ask
185172 refChunks <- liftIO $ newIORef $ L.toChunks bod
186− request $
187− req
188− { requestBody = atomicModifyIORef refChunks $ \bss ->
189− case bss of
190− [] -> ([], S.empty)
191− x:y -> (y, x)
192− }
173+ let req' = req
174+ { requestBody = atomicModifyIORef refChunks $ \bss ->
175+ case bss of
176+ [] -> ([], S.empty)
177+ x:y -> (y, x)
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
193185
194186runResponse :: IORef SResponse -> Response -> IO ResponseReceived
195187runResponse ref res = do
wai-extra/example/Main.hs+2−2
@@ -42,10 +42,10 @@ eventRaw = handle 0
4242 where
4343 handle counter emit flush = do
4444 threadDelay 1000000
45− _ <- emit $ ServerEvent (Just $ string8 "raw")
45+ emit $ ServerEvent (Just $ string8 "raw")
4646 Nothing
4747 [string8 . show $ counter]
48− _ <- flush
48+ flush
4949 handle (counter + 1) emit flush
5050
5151main :: IO ()
wai-extra/test/Network/Wai/TestSpec.hs+11−41
@@ -3,8 +3,6 @@ module Network.Wai.TestSpec (main, spec) where
33
44import Control.Monad (void)
55
6−import qualified Data.IORef as IORef
7−
86import qualified Data.Text.Encoding as TE
97
108import Data.Time.Calendar (fromGregorian)
@@ -55,53 +53,25 @@ spec = do
5553 it "sets rawQueryString to empty string" $ do
5654 rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
5755
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−
7456 describe "request" $ do
7557
76− let echoApp req respond = do
77− reqBody <- L8.fromStrict <$> getRequestBodyChunk req
78− let reqHeaders = requestHeaders req
58+ let simpleApp _req respond =
7959 respond $
8060 responseLBS
8161 status200
82− reqHeaders
83− reqBody
62+ [("foo", "bar")]
63+ "simple"
8464
85− it "returns the status code of an echo app on default request" $ do
86− sresp <- runSession (request defaultRequest) echoApp
65+ it "returns the status code of a simple app on default request" $ do
66+ sresp <- runSession (request defaultRequest) simpleApp
8767 simpleStatus sresp `shouldBe` status200
8868
89− it "returns the response body of an echo app" $ do
90− bodyRef <- IORef.newIORef "request body"
91− let getBodyChunk = IORef.atomicModifyIORef bodyRef $ \leftover -> ("", leftover)
92− sresp <- flip runSession echoApp $
93− request $
94− defaultRequest
95− { requestBody = getBodyChunk
96− }
97− simpleBody sresp `shouldBe` "request body"
98−
99− it "returns the response headers of an echo app" $ do
100− sresp <- flip runSession echoApp $
101− request $
102− defaultRequest
103− { requestHeaders = [("foo", "bar")]
104− }
69+ it "returns the response body of a simple app on default request" $ do
70+ sresp <- runSession (request defaultRequest) simpleApp
71+ simpleBody sresp `shouldBe` "simple"
72+
73+ it "returns the response headers of a simple app on default request" $ do
74+ sresp <- runSession (request defaultRequest) simpleApp
10575 simpleHeaders sresp `shouldBe` [("foo", "bar")]
10676
10777 let cookieApp req respond =
wai-extra/wai-extra.cabal+1−1
@@ -1,5 +1,5 @@
11Name: wai-extra
2−Version: 3.0.29.1
2+Version: 3.0.29
33Synopsis: Provides some basic WAI handlers and middleware.
44description:
55 Provides basic WAI handler and middleware functionality:
wai-websockets/server.lhs−6
@@ -8,8 +8,6 @@ this example, keep the [reference](http://jaspervdj.be/websockets/reference)
88nearby to check out the functions we use.
99
1010> {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
11−> {-# LANGUAGE CPP #-}
12−> {-# OPTIONS_GHC -Wno-unused-top-binds #-} -- for numClients
1311> import Data.Char (isPunctuation, isSpace)
1412> import Data.Monoid (mappend)
1513> import Data.Text (Text)
@@ -101,11 +99,7 @@ stays alive on some browsers.
10199
102100> application state pending = do
103101> conn <- WS.acceptRequest pending
104−#if __GLASGOW_HASKELL__ >= 806
105−> WS.withPingThread conn 30 (return ()) $ do
106−#else
107102> WS.forkPingThread conn 30
108−#endif
109103
110104When a client is successfully connected, we read the first message. This should
111105be in the format of "Hi! I am Jasper", where Jasper is the requested username.
wai-websockets/wai-websockets.cabal−1
@@ -45,7 +45,6 @@ Executable wai-websockets-example
4545 , text
4646 , file-embed
4747 , http-types
48− other-modules: Network.Wai.Handler.WebSockets
4948 else
5049 buildable: False
5150
warp-tls/ChangeLog.md−4
@@ -1,7 +1,3 @@
1−## 3.2.11
2−
3−* Ignoring an exception from shutdown (gracefulClose).
4−
51## 3.2.10
62
73* Passing client certificate, if any, to Warp
warp-tls/Network/Wai/Handler/WarpTLS.hs+1−1
@@ -361,7 +361,7 @@ httpOverTls TLSSettings{..} _set s bs0 params = do
361361 backend recvN = TLS.Backend {
362362 TLS.backendFlush = return ()
363363#if MIN_VERSION_network(3,1,1)
364− , TLS.backendClose = gracefulClose s 5000 `E.catch` \(SomeException _) -> return ()
364+ , TLS.backendClose = gracefulClose s 5000
365365#else
366366 , TLS.backendClose = close s
367367#endif
warp-tls/warp-tls.cabal+1−1
@@ -1,5 +1,5 @@
11Name: warp-tls
2−Version: 3.2.11
2+Version: 3.2.10
33Synopsis: HTTP over TLS support for Warp via the TLS package
44License: MIT
55License-file: LICENSE
warp/ChangeLog.md−6
@@ -1,13 +1,7 @@
1−## 3.3.9
2−
3−* Don't insert Last-Modified: if exists.
4− [#791](https://github.com/yesodweb/wai/pull/791)
5−
61## 3.3.8
72
83* Maximum header size is configurable.
94 [#781](https://github.com/yesodweb/wai/pull/781)
10−* Ignoring an exception from shutdown (gracefulClose).
115
126## 3.3.7
137
warp/Network/Wai/Handler/Warp.hs+1−1
@@ -124,7 +124,7 @@ module Network.Wai.Handler.Warp (
124124 , defaultPushPromise
125125 ) where
126126
127−import Control.Exception (SomeException, throwIO)
127+import Control.Exception (SomeException, throwIO, throw)
128128import Data.Streaming.Network (HostPreference)
129129import qualified Data.Vault.Lazy as Vault
130130import Data.X509
warp/Network/Wai/Handler/Warp/File.hs+4−7
@@ -34,15 +34,12 @@ data RspFileInfo = WithoutBody H.Status
3434----------------------------------------------------------------
3535
3636conditionalRequest :: I.FileInfo
37− -> H.ResponseHeaders
38− -> IndexedHeader -- ^ Response
39− -> IndexedHeader -- ^ Request
37+ -> H.ResponseHeaders -> IndexedHeader
4038 -> RspFileInfo
41−conditionalRequest finfo hs0 rspidx reqidx = case condition of
39+conditionalRequest finfo hs0 reqidx = case condition of
4240 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
4643 in WithBody s hs off len
4744 where
4845 !mtime = I.fileInfoTime finfo
warp/Network/Wai/Handler/Warp/HTTP2/Response.hs+1−2
@@ -72,8 +72,7 @@ responseFile _ rsphdr isHead path Nothing ii reqhdr = do
7272 Left (_ex :: E.IOException) -> return $ response404 rsphdr
7373 Right finfo -> do
7474 let reqidx = indexRequestHeader reqhdr
75− rspidx = indexResponseHeader rsphdr
76− case conditionalRequest finfo rsphdr rspidx reqidx of
75+ case conditionalRequest finfo rsphdr reqidx of
7776 WithoutBody s -> return $ responseNoBody s rsphdr
7877 WithBody s rsphdr' off bytes -> do
7978 let !off' = fromIntegral off
warp/Network/Wai/Handler/Warp/Header.hs−2
@@ -69,7 +69,6 @@ indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex
6969data ResponseHeaderIndex = ResContentLength
7070 | ResServer
7171 | ResDate
72− | ResLastModified
7372 deriving (Enum,Bounded)
7473
7574-- | The size for 'IndexedHeader' for HTTP Response.
@@ -80,7 +79,6 @@ responseKeyIndex :: HeaderName -> Int
8079responseKeyIndex hn = case BS.length bs of
8180 4 -> if bs == "date" then fromEnum ResDate else -1
8281 6 -> if bs == "server" then fromEnum ResServer else -1
83− 13 -> if bs == "last-modified" then fromEnum ResLastModified else -1
8482 14 -> if bs == "content-length" then fromEnum ResContentLength else -1
8583 _ -> -1
8684 where
warp/Network/Wai/Handler/Warp/Recv.hs−2
@@ -153,8 +153,6 @@ receiveloop sock ptr size = do
153153 else
154154 return bytes
155155
156−#ifndef mingw32_HOST_OS
157156-- fixme: the type of the return value
158157foreign import ccall unsafe "recv"
159158 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
160−#endif
warp/Network/Wai/Handler/Warp/Response.hs+16−19
@@ -116,14 +116,14 @@ sendResponse settings conn ii th req reqidxhdr src response = do
116116 -- and status, the response to HEAD is processed here.
117117 --
118118 -- 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
120120 case ms of
121121 Nothing -> return ()
122122 Just realStatus -> logger req realStatus mlen
123123 T.tickle th
124124 return ret
125125 else do
126− _ <- sendRsp conn ii ver s hs rspidxhdr RspNoBody
126+ _ <- sendRsp conn ii ver s hs RspNoBody
127127 logger req s Nothing
128128 T.tickle th
129129 return isPersist
@@ -196,13 +196,12 @@ sendRsp :: Connection
196196 -> H.HttpVersion
197197 -> H.Status
198198 -> H.ResponseHeaders
199− -> IndexedHeader -- Response
200199 -> Rsp
201200 -> IO (Maybe H.Status, Maybe Integer)
202201
203202----------------------------------------------------------------
204203
205−sendRsp conn _ ver s hs _ RspNoBody = do
204+sendRsp conn _ ver s hs RspNoBody = do
206205 -- Not adding Content-Length.
207206 -- User agents treats it as Content-Length: 0.
208207 composeHeader ver s hs >>= connSendAll conn
@@ -210,7 +209,7 @@ sendRsp conn _ ver s hs _ RspNoBody = do
210209
211210----------------------------------------------------------------
212211
213−sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do
212+sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do
214213 header <- composeHeaderBuilder ver s hs needsChunked
215214 let hdrBdy
216215 | needsChunked = header <> chunkedTransferEncoding body
@@ -223,7 +222,7 @@ sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do
223222
224223----------------------------------------------------------------
225224
226−sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = do
225+sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do
227226 header <- composeHeaderBuilder ver s hs needsChunked
228227 (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy
229228 $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)
@@ -247,7 +246,7 @@ sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = do
247246
248247----------------------------------------------------------------
249248
250−sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do
249+sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do
251250 withApp recv send
252251 return (Nothing, Nothing)
253252 where
@@ -261,8 +260,8 @@ sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do
261260
262261-- Sophisticated WAI applications.
263262-- We respect s0. s0 MUST be a proper value.
264−sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =
265− sendRspFile2XX conn ii ver s0 hs rspidxhdr path beg len isHead hook
263+sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) =
264+ sendRspFile2XX conn ii ver s0 hs path beg len isHead hook
266265 where
267266 beg = filePartOffset part
268267 len = filePartByteCount part
@@ -272,17 +271,17 @@ sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =
272271
273272-- Simple WAI applications.
274273-- 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
276275 efinfo <- E.try $ getFileInfo ii path
277276 case efinfo of
278277 Left (_ex :: E.IOException) ->
279278#ifdef WARP_DEBUG
280279 print _ex >>
281280#endif
282− sendRspFile404 conn ii ver hs0 rspidxhdr
283− Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of
284− WithoutBody s -> sendRsp conn ii ver s hs0 rspidxhdr RspNoBody
285− WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook
281+ sendRspFile404 conn ii ver hs0
282+ Right finfo -> case conditionalRequest finfo hs0 idxhdr of
283+ WithoutBody s -> sendRsp conn ii ver s hs0 RspNoBody
284+ WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs path beg len isHead hook
286285
287286----------------------------------------------------------------
288287
@@ -291,15 +290,14 @@ sendRspFile2XX :: Connection
291290 -> H.HttpVersion
292291 -> H.Status
293292 -> H.ResponseHeaders
294− -> IndexedHeader
295293 -> FilePath
296294 -> Integer
297295 -> Integer
298296 -> Bool
299297 -> IO ()
300298 -> IO (Maybe H.Status, Maybe Integer)
301−sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook
302− | isHead = sendRsp conn ii ver s hs rspidxhdr RspNoBody
299+sendRspFile2XX conn ii ver s hs path beg len isHead hook
300+ | isHead = sendRsp conn ii ver s hs RspNoBody
303301 | otherwise = do
304302 lheader <- composeHeader ver s hs
305303 (mfd, fresher) <- getFd ii path
@@ -312,9 +310,8 @@ sendRspFile404 :: Connection
312310 -> InternalInfo
313311 -> H.HttpVersion
314312 -> H.ResponseHeaders
315− -> IndexedHeader
316313 -> 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)
318315 where
319316 s = H.notFound404
320317 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
warp/Network/Wai/Handler/Warp/Run.hs+1−5
@@ -59,11 +59,7 @@ import Network.Socket (fdSocket)
5959
6060-- | Creating 'Connection' for plain HTTP based on a given socket.
6161socketConnection :: Settings -> Socket -> IO Connection
62−#if MIN_VERSION_network(3,1,1)
6362socketConnection set s = do
64−#else
65−socketConnection _ s = do
66−#endif
6763 bufferPool <- newBufferPool
6864 writeBuf <- allocateBuffer bufferSize
6965 let sendall = Sock.sendAll s
@@ -80,7 +76,7 @@ socketConnection _ s = do
8076 if tm == 0 then
8177 close s
8278 else
83− gracefulClose s tm `E.catch` \(E.SomeException _) -> return ()
79+ gracefulClose s tm
8480#else
8581 , connClose = close s
8682#endif
warp/test/FileSpec.hs+1−1
@@ -21,7 +21,7 @@ testFileRange desc reqhs file ans = it desc $ do
2121 let WithBody s hs off len = ans
2222 hs' = ("Last-Modified",fileInfoDate finfo) : hs
2323 ans' = WithBody s hs' off len
24− conditionalRequest finfo [] (indexResponseHeader hs) (indexRequestHeader reqhs) `shouldBe` ans'
24+ conditionalRequest finfo [] (indexRequestHeader reqhs) `shouldBe` ans'
2525
2626spec :: Spec
2727spec = do
warp/warp.cabal+1−1
@@ -1,5 +1,5 @@
11Name: warp
2−Version: 3.3.9
2+Version: 3.3.7
33Synopsis: A fast, light-weight web server for WAI applications.
44License: MIT
55License-file: LICENSE