@@ -40,6 +40,7 @@ import Data.FileEmbed (embedFile)
4040
4141import Data.Text (Text)
4242import qualified Data.Text as T
43+import qualified Data.Text.Encoding as TE
4344
4445import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)
4546
@@ -107,20 +108,37 @@ checkPieces _ pieces _ | any (T.null . fromPiece) $ safeInit pieces =
107108checkPieces ss@StaticSettings {..} pieces req = do
108109 res <- lookupResult
109110 case res of
110− LRNotFound -> return NotFound
111− LRFile file -> serveFile ss req file
112− LRFolder folder -> serveFolder ss pieces req folder
111+ Left location -> return $ RawRedirect $ TE.encodeUtf8 location
112+ Right LRNotFound -> return NotFound
113+ Right (LRFile file) -> serveFile ss req file
114+ Right (LRFolder folder) -> serveFolder ss pieces req folder
113115 where
114− lookupResult :: IO LookupResult
116+ lookupResult :: IO (Either Text LookupResult)
115117 lookupResult = do
116118 nonIndexResult <- ssLookupFile pieces
117119 case nonIndexResult of
118− LRFile{} -> return nonIndexResult
120+ LRFile{} -> return $ Right nonIndexResult
119121 _ -> do
120122 indexResult <- lookupIndices (map (\ index -> pieces ++ [index]) ssIndices)
121123 return $ case indexResult of
122− LRNotFound -> nonIndexResult
123− _ -> indexResult
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
124142
125143 lookupIndices :: [Pieces] -> IO LookupResult
126144 lookupIndices (x : xs) = do