@@ -52,6 +52,7 @@ import Network.Mime (MimeType)
5252data StaticResponse =
5353 -- | Just the etag hash or Nothing for no etag hash
5454 Redirect Pieces (Maybe ByteString)
55+ | RawRedirect ByteString
5556 | NotFound
5657 | FileResponse File H.ResponseHeaders
5758 | NotModified
@@ -79,15 +80,15 @@ serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =
7980 let pieces' = setLast pieces index in
8081 case () of
8182 () | ssRedirectToIndex -> return $ Redirect pieces' Nothing
82− | noTrailingSlash pieces, Just trailing <- toPiece "" ->
83− return $ Redirect (pieces ++ [trailing]) Nothing
83+ | Just path <- addTrailingSlash req ->
84+ return $ RawRedirect path
8485 | otherwise ->
8586 -- start the checking process over, with a new set
8687 checkPieces ss pieces' req
8788 Nothing ->
8889 case ssListing of
89− Just _ | noTrailingSlash pieces, Just trailing <- toPiece "" ->
90− return $ Redirect (pieces ++ [trailing]) Nothing
90+ Just _ | Just path <- addTrailingSlash req ->
91+ return $ RawRedirect path
9192 Just listing -> do
9293 -- directory listings turned on, display it
9394 builder <- listing pieces folder
@@ -104,6 +105,15 @@ serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =
104105 | fromPiece t == "" = [x]
105106 setLast (a:b) x = a : setLast b x
106107
108+ addTrailingSlash :: W.Request -> Maybe ByteString
109+ addTrailingSlash req
110+ | S8.null rp = Just "/"
111+ | rp == "/" = Nothing
112+ | S8.last rp == '/' = Nothing
113+ | otherwise = Just $ S8.snoc rp '/'
114+ where
115+ rp = W.rawPathInfo req
116+
107117 noTrailingSlash :: Pieces -> Bool
108118 noTrailingSlash [] = False
109119 noTrailingSlash [x] = fromPiece x /= ""
@@ -250,6 +260,12 @@ staticAppPieces ss rawPieces req sendResponse = liftIO $ do
250260 , ("Location", S8.append loc $ H.renderQuery True qString)
251261 ] "Redirect"
252262
263+ response (RawRedirect path) =
264+ sendResponse $ W.responseLBS H.status301
265+ [ ("Content-Type", "text/plain")
266+ , ("Location", path)
267+ ] "Redirect"
268+
253269 response NotFound = sendResponse $ W.responseLBS H.status404
254270 [ ("Content-Type", "text/plain")
255271 ] "File not found"