@@ -52,6 +52,7 @@ import Network.Mime (MimeType)
52data StaticResponse =
52data StaticResponse =
53 -- | Just the etag hash or Nothing for no etag hash
53 -- | Just the etag hash or Nothing for no etag hash
54 Redirect Pieces (Maybe ByteString)
54 Redirect Pieces (Maybe ByteString)
55+ | RawRedirect ByteString
55 | NotFound
56 | NotFound
56 | FileResponse File H.ResponseHeaders
57 | FileResponse File H.ResponseHeaders
57 | NotModified
58 | NotModified
@@ -79,15 +80,15 @@ serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =
79 let pieces' = setLast pieces index in
80 let pieces' = setLast pieces index in
80 case () of
81 case () of
81 () | ssRedirectToIndex -> return $ Redirect pieces' Nothing
82 () | ssRedirectToIndex -> return $ Redirect pieces' Nothing
82− | noTrailingSlash pieces, Just trailing <- toPiece "" ->
83+ | Just path <- addTrailingSlash req ->
83− return $ Redirect (pieces ++ [trailing]) Nothing
84+ return $ RawRedirect path
84 | otherwise ->
85 | otherwise ->
85 -- start the checking process over, with a new set
86 -- start the checking process over, with a new set
86 checkPieces ss pieces' req
87 checkPieces ss pieces' req
87 Nothing ->
88 Nothing ->
88 case ssListing of
89 case ssListing of
89− Just _ | noTrailingSlash pieces, Just trailing <- toPiece "" ->
90+ Just _ | Just path <- addTrailingSlash req ->
90− return $ Redirect (pieces ++ [trailing]) Nothing
91+ return $ RawRedirect path
91 Just listing -> do
92 Just listing -> do
92 -- directory listings turned on, display it
93 -- directory listings turned on, display it
93 builder <- listing pieces folder
94 builder <- listing pieces folder
@@ -104,6 +105,15 @@ serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =
104 | fromPiece t == "" = [x]
105 | fromPiece t == "" = [x]
105 setLast (a:b) x = a : setLast b x
106 setLast (a:b) x = a : setLast b x
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 '/'
115+ rp = W.rawPathInfo req
107 noTrailingSlash :: Pieces -> Bool
117 noTrailingSlash :: Pieces -> Bool
108 noTrailingSlash [] = False
118 noTrailingSlash [] = False
109 noTrailingSlash [x] = fromPiece x /= ""
119 noTrailingSlash [x] = fromPiece x /= ""
@@ -250,6 +260,12 @@ staticAppPieces ss rawPieces req sendResponse = liftIO $ do
250 , ("Location", S8.append loc $ H.renderQuery True qString)
260 , ("Location", S8.append loc $ H.renderQuery True qString)
251 ] "Redirect"
261 ] "Redirect"
263+ response (RawRedirect path) =
264+ sendResponse $ W.responseLBS H.status301
265+ [ ("Content-Type", "text/plain")
266+ , ("Location", path)
253 response NotFound = sendResponse $ W.responseLBS H.status404
269 response NotFound = sendResponse $ W.responseLBS H.status404
254 [ ("Content-Type", "text/plain")
270 [ ("Content-Type", "text/plain")
255 ] "File not found"
271 ] "File not found"