458c95c · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Warp checks for file existance (yesodweb/yesod#264)

458c95cMichael Snoyman15 years ago

wai-app-static/sample.hs+2−1

compare with master

unifiedsplit

@@ -1,8 +1,9 @@

1+{-# LANGUAGE OverloadedStrings #-}

1import Network.Wai.Application.Static

2import Network.Wai.Application.Static

2import Network.Wai.Handler.Warp (run)

3import Network.Wai.Handler.Warp (run)

4main :: IO ()

5main :: IO ()

5−main = run 3000 $ staticApp defaultStaticSettings

6+main = run 3000 $ staticApp defaultWebAppSettings

6 { ssFolder = fileSystemLookup "."

7 { ssFolder = fileSystemLookup "."

7 , ssMaxAge = MaxAgeForever

8 , ssMaxAge = MaxAgeForever

8 , ssIndices = []

9 , ssIndices = []

warp/Network/Wai/Handler/Warp.hs+24−21

@@ -19,11 +19,7 @@

19--

20---------------------------------------------------------

22−-- | A fast, light-weight HTTP server handler for WAI. Some random notes (a FAQ, if you will):

22+-- | A fast, light-weight HTTP server handler for WAI.

23−--

24−-- * When a 'ResponseFile' indicates a file which does not exist, an exception

25−-- is thrown. This will close the connection to the client as well. You should

26−-- handle file existance checks at the application level.

27module Network.Wai.Handler.Warp

23module Network.Wai.Handler.Warp

28 ( -- * Run a Warp server

24 ( -- * Run a Warp server

29 run

25 run

@@ -85,6 +81,7 @@ import Control.Exception

85 , fromException, AsyncException (ThreadKilled)

81 , fromException, AsyncException (ThreadKilled)

86 , bracketOnError

82 , bracketOnError

87 , IOException

83 , IOException

84+ , try

88 )

85 )

89import Control.Concurrent (forkIO)

86import Control.Concurrent (forkIO)

90import Data.Maybe (fromMaybe, isJust)

87import Data.Maybe (fromMaybe, isJust)

@@ -513,27 +510,33 @@ sendResponse th req conn r = sendResponse' r

513 sendHeader = connSendMany conn . L.toChunks . toLazyByteString

510 sendHeader = connSendMany conn . L.toChunks . toLazyByteString

514

511

515 sendResponse' :: Response -> ResourceT IO Bool

512 sendResponse' :: Response -> ResourceT IO Bool

516− sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do

513+ sendResponse' (ResponseFile s hs fp mpart) = do

517− (lengthyHeaders, cl) <-

514+ eres <-

518 case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of

515 case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of

519− (Just cl, _) -> return (hs, cl)

516+ (Just cl, _) -> return $ Right (hs, cl)

520− (Nothing, Nothing) -> do

517+ (Nothing, Nothing) -> liftIO $ try $ do

521 cl <- P.fileSize `fmap` P.getFileStatus fp

518 cl <- P.fileSize `fmap` P.getFileStatus fp

522 return $ addClToHeaders cl

519 return $ addClToHeaders cl

523 (Nothing, Just part) -> do

520 (Nothing, Just part) -> do

524 let cl = filePartByteCount part

521 let cl = filePartByteCount part

525− return $ addClToHeaders cl

522+ return $ Right $ addClToHeaders cl

523+ case eres of

524+ Left (e :: SomeException) -> sendResponse' $ responseLBS

525+ H.status404

526+ [("Content-Type", "text/plain")]

527+ "File not found"

528+ Right (lengthyHeaders, cl) -> liftIO $ do

526− let headers' = headers version s lengthyHeaders

529+ let headers' = headers version s lengthyHeaders

527− sendHeader $ headers' False

530+ sendHeader $ headers' False

528− T.tickle th

531+ T.tickle th

529− if hasBody s req then do

532+ if hasBody s req then do

530− case mpart of

533+ case mpart of

531− Nothing -> connSendFile conn fp 0 cl (T.tickle th)

534+ Nothing -> connSendFile conn fp 0 cl (T.tickle th)

532− Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)

535+ Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)

533− T.tickle th

536+ T.tickle th

534− return isPersist

537+ return isPersist

535− else

538+ else

536− return isPersist

539+ return isPersist

537 where

540 where

538 addClToHeaders cl = (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)

541 addClToHeaders cl = (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)

539

542

warp/pong.hs+1

@@ -17,6 +17,7 @@ app req = return $

17 "/file/nolen" -> fileNoLen

18 "/source/withlen" -> sourceWithLen

19 "/source/nolen" -> sourceNoLen

20+ "/notfound" -> ResponseFile status200 [] "notfound" Nothing

20 x -> index x

21 x -> index x

22builderWithLen = ResponseBuilder

23builderWithLen = ResponseBuilder