@@ -9,6 +9,9 @@ import Data.Text (unpack)
9import Data.Text.Encoding (decodeUtf8With)
9import Data.Text.Encoding (decodeUtf8With)
10import Data.Text.Encoding.Error (lenientDecode)
10import Data.Text.Encoding.Error (lenientDecode)
11import Control.Monad.IO.Class (liftIO)
11import Control.Monad.IO.Class (liftIO)
12+import Network.Wai.Handler.Warp.Util (mimeTypes, getFileSize)
13+import qualified Data.Map as Map
14+import qualified Data.ByteString.Char8 as S8
13main :: IO ()
16main :: IO ()
@@ -30,9 +33,13 @@ app prefix Request { requestMethod = m, pathInfo = p }
30 let ext = reverse $ takeWhile (/= '.') $ reverse file
33 let ext = reverse $ takeWhile (/= '.') $ reverse file
31 let ct = getCT ext
34 let ct = getCT ext
32 e <- liftIO $ doesFileExist file
35 e <- liftIO $ doesFileExist file
33− -- FIXME check file size
38+ size <- liftIO $ getFileSize file
35− then return $ ResponseFile status200 [("Content-Type", ct)] file
39+ return $ ResponseFile status200
40+ [ ("Content-Type", ct)
41+ , ("Content-Length", S8.pack $ show size)
36 else return $ responseLBS status404 [("Content-Type", "text/plain")] "File not found"
43 else return $ responseLBS status404 [("Content-Type", "text/plain")] "File not found"
37 | otherwise =
44 | otherwise =
38 return $ responseLBS status405 [("Content-Type", "text/plain")] "Bad method"
45 return $ responseLBS status405 [("Content-Type", "text/plain")] "Bad method"
@@ -58,14 +65,7 @@ join [x] = x
58join (x:xs) = x ++ '/' : join xs
65join (x:xs) = x ++ '/' : join xs
60getCT :: String -> ByteString
67getCT :: String -> ByteString
61−getCT "jpg" = "image/jpeg"
68+getCT s =
62−getCT "jpeg" = "image/jpeg"
69+ case Map.lookup (S8.pack s) mimeTypes of
63−getCT "js" = "text/javascript"
70+ Just ct -> ct
64−getCT "css" = "text/css"
65−getCT "html" = "text/html"
66−getCT "png" = "image/png"
67−getCT "gif" = "image/gif"
68−getCT "txt" = "text/plain"
69−getCT "flv" = "video/x-flv"
70−getCT "ogv" = "video/ogg"
71−getCT _ = "application/octet-stream"
71+ Nothing -> "application/octet-stream"