base a Yesod web on a url with a non empty path - yesod

Question

If I append a base path to the approot property in settings.yml like
approot="http://localhost:3000/base"
calling this URL in the browser shows "Not Found" as message, instead of giving properly the Home page.
I could not find any way to solve it.
...
I see, I have to Rewrite the URL without the base prefix before submitting it to the yesod task, and the approot is only used to be prepended to all page links.
Is there a proper way to handle theese non-empty path based URL's ?

Answer 1

There are two relatively simple approaches to this:
Create a middleware which will strip the leading "base" value from the pathInfo.
Override cleanPath (in the Yesod typeclass) to do the same.
In general, an approot with a leading path piece is most useful where there's some front server which is calling out to your Yesod app (either via reverse proxy or FastCGI).

Answer 2

Following M.Snoyman hints, here is a cleanPath version that solves the question, just for the approot case of the ApprootMaster constructor, as generated by yesod init , as an addition to the generated module Foundation.hs:
{-# LANGUAGE PackageImports #-}
import qualified Data.Text as Txt
import qualified "url" Network.URL as Url
import qualified Network.HTTP.Types as H
import qualified Data.Text.Encoding as TE
import qualified Data.List as L
import qualified "utf8-string" Data.ByteString.UTF8 as UTF8BS
-- instance Yesod App where
-- cleanPath - A function used to clean up path segments.
-- It returns Right with a clean path or Left with a new set of pieces the user should be redirected to
-- cleanPath :: Yesod a => a -> [Text] -> Either [Text] [Text]
cleanPath master s =
if corrected == s'
then Right $ cutoffBasePrefix s'
else Left $ cutoffBasePrefix corrected -- to be redirected
where
-- avoid redirection on slash ended urls by junking the last piece if it's null
s' = if not (L.null s) && Txt.null (last s) then init s else s
corrected = filter (not . Txt.null) s'
-- strToUtf8BS = TE.encodeUtf8 . Txt.pack -- packs to UTF16 then encodes to UTF8
strToUtf8BS = UTF8BS.fromString
-- cut off "base prefix" or leave as it is
cutoffBasePrefix segmts =
case approot of
ApprootMaster f ->
case Url.importURL $ Txt.unpack $ f master of
Nothing -> segmts -- not expected, incorrect url in settings.yml approot
Just url -> let basePrefixSegmts = H.decodePathSegments $ strToUtf8BS $ Url.url_path url in
case basePrefixSegmts of
[] -> segmts
_ -> if basePrefixSegmts `L.isPrefixOf` segmts
then drop (length basePrefixSegmts) segmts
else segmts
_ -> segmts
with theese additional package dependencies:
, url >= 2.1.2
, network
, http-types
, utf8-string