@@ -99,7 +99,7 @@ import Data.Function (on)
9999import Data.Ord (comparing)
100100import qualified Data.ByteString.Base64 as B64
101101import Data.Either (rights)
102−import Data.Maybe (isJust, fromJust)
102+import Data.Maybe (isJust, fromJust, mapMaybe)
103103import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)
104104import Data.String (IsString (..))
105105
@@ -114,7 +114,7 @@ instance IsString FilePath where
114114-- | A list of all possible extensions, starting from the largest.
115115takeExtensions :: FilePath -> [FilePath]
116116takeExtensions (FilePath s) =
117− case T.break (== '.') s of
117+ case T.breakOn (".") s of
118118 (_, "") -> []
119119 (_, x) -> FilePath (T.drop 1 x) : takeExtensions (FilePath $ T.drop 1 x)
120120
@@ -192,37 +192,26 @@ defaultMimeTypes = Map.fromList [
192192 ( "xwd" , "image/x-xwindowdump" ),
193193 ( "zip" , "application/zip" )]
194194
195+-- similar to Safe package
196+headDef :: a -> [a] -> a
197+headDef _ (x:_) = x
198+headDef def [] = def
199+
200+-- similar to Safe package
201+initSafe :: [a] -> [a]
202+initSafe [] = []
203+initSafe xs = init xs
204+
195205mimeTypeByExt :: MimeMap
196206 -> MimeType -- ^ default mime type
197207 -> FilePath
198208 -> MimeType
199209mimeTypeByExt mm def =
200− go . takeExtensions
201− where
202− go [] = def
203− go (e:es) =
204− case Map.lookup e mm of
205− Nothing -> go es
206− Just mt -> mt
210+ headDef def . mapMaybe (flip Map.lookup mm) . takeExtensions
207211
208212defaultMimeTypeByExt :: FilePath -> MimeType
209213defaultMimeTypeByExt = mimeTypeByExt defaultMimeTypes defaultMimeType
210214
211−data CheckPieces =
212− -- | Just the etag hash or Nothing for no etag hash
213− Redirect Pieces (Maybe ByteString)
214− | Forbidden
215− | NotFound
216− | FileResponse File H.ResponseHeaders
217− | NotModified
218− | DirectoryResponse Folder
219− -- TODO: add file size
220− | SendContent MimeType L.ByteString
221−
222−safeInit :: [a] -> [a]
223−safeInit [] = []
224−safeInit xs = init xs
225−
226215filterButLast :: (a -> Bool) -> [a] -> [a]
227216filterButLast _ [] = []
228217filterButLast _ [x] = [x]
@@ -231,8 +220,8 @@ filterButLast f (x:xs)
231220 | otherwise = filterButLast f xs
232221
233222
234−unsafe :: FilePath -> Bool
235−unsafe (FilePath s)
223+unsafePiece :: FilePath -> Bool
224+unsafePiece (FilePath s)
236225 | T.null s = False
237226 | T.head s == '.' = True
238227 | otherwise = T.any (== '/') s
@@ -262,6 +251,17 @@ checkSpecialDirListing [".hidden", "haskell.png"] =
262251 Just $ SendContent "image/png" $ L.fromChunks [$(embedFile "images/haskell.png")]
263252checkSpecialDirListing _ = Nothing
264253
254+data CheckPieces =
255+ -- | Just the etag hash or Nothing for no etag hash
256+ Redirect Pieces (Maybe ByteString)
257+ | Forbidden
258+ | NotFound
259+ | FileResponse File H.ResponseHeaders
260+ | NotModified
261+ | DirectoryResponse Folder
262+ -- TODO: add file size
263+ | SendContent MimeType L.ByteString
264+
265265checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
266266 -> [FilePath] -- ^ List of default index files. Cannot contain slashes.
267267 -> Pieces -- ^ parsed request
@@ -271,16 +271,14 @@ checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
271271 -> Bool -- ^ Redirect to Index?
272272 -> IO CheckPieces
273273checkPieces fileLookup indices pieces req maxAge useHash redirectToIndex
274− | any unsafe pieces = return Forbidden
275− | any nullFilePath $ safeInit pieces =
274+ | any unsafePiece pieces = return Forbidden
275+ | any nullFilePath $ initSafe pieces =
276276 return $ Redirect (filterButLast (not . nullFilePath) pieces) Nothing
277277 | otherwise = do
278278 let (isFile, isFolder) =
279− case () of
280− ()
281− | null pieces -> (True, True)
282− | nullFilePath (last pieces) -> (False, True)
283− | otherwise -> (True, False)
279+ if null pieces then (True, True)
280+ else if nullFilePath (last pieces) then (False, True)
281+ else (True, False)
284282
285283 fl <- fileLookup pieces
286284 case (fl, isFile) of
@@ -621,7 +619,13 @@ staticAppPieces ss pieces req = liftIO $ do
621619 let indices = ssIndices ss
622620 case checkSpecialDirListing pieces of
623621 Just res -> response res
624− Nothing -> checkPieces (ssFolder ss) (map FilePath indices) pieces req (ssMaxAge ss) (ssUseHash ss) (ssRedirectToIndex ss) >>= response
622+ Nothing -> response =<< checkPieces (ssFolder ss)
623+ (map FilePath indices)
624+ pieces
625+ req
626+ (ssMaxAge ss)
627+ (ssUseHash ss)
628+ (ssRedirectToIndex ss)
625629 where
626630 response cp = case cp of
627631 FileResponse file ch -> do