@@ -84,7 +84,7 @@ import Control.Exception
8484 )
8585import Control.Concurrent (forkIO)
8686import qualified Data.Char as C
87−import Data.Maybe (fromMaybe)
87+import Data.Maybe (fromMaybe, isJust)
8888
8989import Data.Typeable (Typeable)
9090
@@ -176,7 +176,7 @@ bindPort p s = do
176176 addr = if null addrs' then head addrs else head addrs'
177177 bracketOnError
178178 (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
179− (sClose)
179+ sClose
180180 (\sock -> do
181181 setSocketOption sock ReuseAddr 1
182182 bindSocket sock (addrAddress addr)
@@ -207,7 +207,7 @@ runSettings set =
207207 bracket
208208 (bindPort (settingsPort set) (settingsHost set))
209209 sClose .
210− (flip (runSettingsSocket set))
210+ flip (runSettingsSocket set)
211211#endif
212212
213213type Port = Int
@@ -219,7 +219,7 @@ type Port = Int
219219-- Note that the 'settingsPort' will still be passed to 'Application's via the
220220-- 'serverPort' record.
221221runSettingsSocket :: Settings -> Socket -> Application -> IO ()
222−runSettingsSocket set socket app = do
222+runSettingsSocket set socket app =
223223 runSettingsConnection set getter app
224224 where
225225 getter = do
@@ -244,7 +244,7 @@ serveConnection :: Settings
244244 -> T.Handle
245245 -> (SomeException -> IO ())
246246 -> Port -> Application -> Connection -> SockAddr -> IO ()
247−serveConnection settings th onException port app conn remoteHost' = do
247+serveConnection settings th onException port app conn remoteHost' =
248248 catch
249249 (finally
250250 (runResourceT serveConnection')
@@ -269,7 +269,7 @@ serveConnection settings th onException port app conn remoteHost' = do
269269
270270 liftIO $ T.resume th
271271 keepAlive <- sendResponse th env conn res
272− if keepAlive then serveConnection'' fromClient else return ()
272+ when keepAlive $ serveConnection'' fromClient
273273 Just intercept -> do
274274 liftIO $ T.pause th
275275 intercept fromClient conn
@@ -304,12 +304,10 @@ parseRequest' :: Port
304304parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []
305305parseRequest' port (firstLine:otherLines) remoteHost' src = do
306306 (method, rpath', gets, httpversion) <- parseFirst firstLine
307− let (host',rpath) =
308− if S.null rpath'
309− then ("","/")
310− else if "http://" `S.isPrefixOf` rpath'
311− then S.breakByte 47 $ S.drop 7 rpath' -- '/'
312− else ("", rpath')
307+ let (host',rpath)
308+ | S.null rpath' = ("", "/")
309+ | "http://" `S.isPrefixOf` rpath' = S.breakByte 47 $ S.drop 7 rpath'
310+ | otherwise = ("", rpath')
313311 let heads = map parseHeaderNoAttr otherLines
314312 let host = fromMaybe host' $ lookup "host" heads
315313 let len =
@@ -349,7 +347,7 @@ takeUntil c bs =
349347
350348parseFirst :: ByteString
351349 -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)
352−parseFirst s =
350+parseFirst s =
353351 case S.split 32 s of -- ' '
354352 [method, query, http'] -> do
355353 let (hfirst, hsecond) = B.splitAt 5 http'
@@ -375,8 +373,8 @@ colonSpaceBuilder = copyByteString ": "
375373headers :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> Builder
376374headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-}
377375 let !start = httpBuilder
378− `mappend` (copyByteString $
379− case httpversion of
376+ `mappend` copyByteString
377+ (case httpversion of
380378 H.HttpVersion 1 1 -> "1.1"
381379 _ -> "1.0")
382380 `mappend` spaceBuilder
@@ -415,7 +413,7 @@ isChunked :: H.HttpVersion -> Bool
415413isChunked = (==) H.http11
416414
417415hasBody :: H.Status -> Request -> Bool
418−hasBody s req = s /= (H.Status 204 "") && s /= H.status304 &&
416+hasBody s req = s /= H.Status 204 "" && s /= H.status304 &&
419417 H.statusCode s >= 200 && requestMethod req /= "HEAD"
420418
421419sendResponse :: T.Handle
@@ -427,7 +425,7 @@ sendResponse th req conn r = sendResponse' r
427425 isChunked' = isChunked version
428426 needsChunked hs = isChunked' && not (hasLength hs)
429427 isKeepAlive hs = isPersist && (isChunked' || hasLength hs)
430− hasLength hs = lookup "content-length" hs /= Nothing
428+ hasLength hs = isJust $ lookup "content-length" hs
431429
432430 sendResponse' :: Response -> ResourceT IO Bool
433431 sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do
@@ -471,10 +469,10 @@ sendResponse th req conn r = sendResponse' r
471469 headers' = headers version s hs
472470 needsChunked' = needsChunked hs
473471 body = if needsChunked'
474− then (headers' needsChunked')
472+ then headers' needsChunked'
475473 `mappend` chunkedTransferEncoding b
476474 `mappend` chunkedTransferTerminator
477− else (headers' False) `mappend` b
475+ else headers' False `mappend` b
478476
479477 sendResponse' (ResponseSource s hs body) =
480478 response
@@ -497,7 +495,7 @@ sendResponse th req conn r = sendResponse' r
497495 return $ isKeepAlive hs
498496 needsChunked' = needsChunked hs
499497 chunk :: C.Conduit Builder IO Builder
500− chunk = C.Conduit $ return $ C.PreparedConduit
498+ chunk = C.Conduit $ return C.PreparedConduit
501499 { C.conduitPush = push
502500 , C.conduitClose = close
503501 }
@@ -529,17 +527,18 @@ connSource Connection { connRecv = recv } th = C.PreparedSource
529527
530528-- | Use 'connSendAll' to send this data while respecting timeout rules.
531529connSink :: Connection -> T.Handle -> C.Sink B.ByteString IO ()
532−connSink Connection { connSendAll = send } th = C.Sink $ return $ C.SinkData
530+connSink Connection { connSendAll = send } th = C.Sink $ return C.SinkData
533531 { C.sinkPush = push
534532 , C.sinkClose = close
535533 }
536534 where
537535 close = liftIO (T.resume th)
538536 push x = do
539− liftIO $ T.resume th
540− liftIO $ send x
541− liftIO $ T.pause th
542− return $ C.Processing
537+ liftIO $ do
538+ T.resume th
539+ send x
540+ T.pause th
541+ return C.Processing
543542 -- We pause timeouts before passing control back to user code. This ensures
544543 -- that a timeout will only ever be executed when Warp is in control. We
545544 -- also make sure to resume the timeout after the completion of user code
@@ -573,9 +572,8 @@ defaultSettings = Settings
573572 case fromException e of
574573 Just x -> go x
575574 Nothing ->
576− if go' $ fromException e
577− then hPutStrLn stderr $ show e
578− else return ()
575+ when (go' $ fromException e) $
576+ hPutStrLn stderr $ show e
579577 , settingsTimeout = 30
580578 , settingsIntercept = const Nothing
581579 , settingsManager = Nothing