@@ -87,14 +87,14 @@ serveFolder StaticSettings {..} pieces req folder@Folder {..} =
8787 Nothing -> return $ WaiResponse $ W.responseLBS H.status403
8888 [ ("Content-Type", "text/plain")
8989 ] "Directory listings disabled"
90+
91+addTrailingSlash :: W.Request -> Maybe ByteString
92+addTrailingSlash req
93+ | S8.null rp = Just "/"
94+ | S8.last rp == '/' = Nothing
95+ | otherwise = Just $ S8.snoc rp '/'
9096 where
91− addTrailingSlash :: W.Request -> Maybe ByteString
92− addTrailingSlash req
93− | S8.null rp = Just "/"
94− | S8.last rp == '/' = Nothing
95− | otherwise = Just $ S8.snoc rp '/'
96− where
97− rp = W.rawPathInfo req
97+ rp = W.rawPathInfo req
9898
9999checkPieces :: StaticSettings
100100 -> Pieces -- ^ parsed request
@@ -108,45 +108,49 @@ checkPieces _ pieces _ | any (T.null . fromPiece) $ safeInit pieces =
108108checkPieces ss@StaticSettings {..} pieces req = do
109109 res <- lookupResult
110110 case res of
111− Left location -> return $ RawRedirect $ TE.encodeUtf8 location
111+ Left location -> return $ RawRedirect location
112112 Right LRNotFound -> return NotFound
113113 Right (LRFile file) -> serveFile ss req file
114114 Right (LRFolder folder) -> serveFolder ss pieces req folder
115115 where
116− lookupResult :: IO (Either Text LookupResult)
116+ lookupResult :: IO (Either ByteString LookupResult)
117117 lookupResult = do
118118 nonIndexResult <- ssLookupFile pieces
119119 case nonIndexResult of
120120 LRFile{} -> return $ Right nonIndexResult
121121 _ -> do
122− indexResult <- lookupIndices (map (\ index -> dropLastIfNull pieces ++ [index]) ssIndices)
123− return $ case indexResult of
124− LRNotFound -> Right nonIndexResult
125− LRFile file | ssRedirectToIndex ->
126− let relPath =
127− case reverse pieces of
128− -- Served at root
129− [] -> fromPiece $ fileName file
130− lastSegment:_ ->
131− case fromPiece lastSegment of
132− -- Ends with a trailing slash
133− "" -> fromPiece $ fileName file
134− -- Lacks a trailing slash
135− lastSegment' -> T.concat
136− [ lastSegment'
137− , "/"
138− , fromPiece $ fileName file
139− ]
140− in Left relPath
141− _ -> Right indexResult
122+ eIndexResult <- lookupIndices (map (\ index -> dropLastIfNull pieces ++ [index]) ssIndices)
123+ return $ case eIndexResult of
124+ Left redirect -> Left redirect
125+ Right indexResult -> case indexResult of
126+ LRNotFound -> Right nonIndexResult
127+ LRFile file | ssRedirectToIndex ->
128+ let relPath =
129+ case reverse pieces of
130+ -- Served at root
131+ [] -> fromPiece $ fileName file
132+ lastSegment:_ ->
133+ case fromPiece lastSegment of
134+ -- Ends with a trailing slash
135+ "" -> fromPiece $ fileName file
136+ -- Lacks a trailing slash
137+ lastSegment' -> T.concat
138+ [ lastSegment'
139+ , "/"
140+ , fromPiece $ fileName file
141+ ]
142+ in Left $ TE.encodeUtf8 relPath
143+ _ -> Right indexResult
142144
143− lookupIndices :: [Pieces] -> IO LookupResult
145+ lookupIndices :: [Pieces] -> IO (Either ByteString LookupResult)
144146 lookupIndices (x : xs) = do
145147 res <- ssLookupFile x
146148 case res of
147149 LRNotFound -> lookupIndices xs
148− _ -> return res
149− lookupIndices [] = return LRNotFound
150+ _ -> return $ case (ssAddTrailingSlash, addTrailingSlash req) of
151+ (True, Just redirect) -> Left redirect
152+ _ -> Right res
153+ lookupIndices [] = return $ Right LRNotFound
150154
151155serveFile :: StaticSettings -> W.Request -> File -> IO StaticResponse
152156serveFile StaticSettings {..} req file