将 Yesod 网站建立在具有非空路径的 url 上答案

【问题标题】：base a Yesod web on a url with a non empty path将 Yesod 网站建立在具有非空路径的 url 上
【发布时间】：2012-10-06 19:20:27
【问题描述】：

如果我将基本路径附加到 settings.yml 中的 approot 属性，例如

approot="http://localhost:3000/base"

在浏览器中调用此 URL 会显示“未找到”消息，而不是正确地提供主页。

我找不到任何解决方法。

...

我明白了，在提交到 yesod 任务之前，我必须重写没有基本前缀的 URL，并且 approot 仅用于添加到所有页面链接的前面。

是否有适当的方法来处理这些基于非空路径的 URL？

【问题讨论】：

标签： yesod

【解决方案1】：

有两种相对简单的方法：

创建一个中间件，该中间件将从 pathInfo 中去除前导“base”值。
覆盖 cleanPath（在 Yesod 类型类中）以执行相同的操作。

一般来说，如果有一些前端服务器正在调用您的 Yesod 应用程序（通过反向代理或 FastCGI），带有前导路径片段的 approot 最有用。

【讨论】：

【解决方案2】：

根据 M.Snoyman 的提示，这是一个解决问题的 cleanPath 版本，仅针对 ApprootMaster 构造函数的 approot 案例，由 yesod init 生成，作为生成模块 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

这些额外的包依赖项：

, url                           >= 2.1.2
, network
, http-types
, utf8-string

【讨论】：