ajax - 在 Yesod 中允许跨域请求

Question

我的应用程序使用书签，我需要允许 MyRouteR 的 CORS所以我的书签代码可以将此路由用于 AJAX 请求。

在我的配置/路由初稿中，我给出了 MyRouteR仅支持一种请求方法，PUT。但事实证明(duh)我还需要支持 OPTIONS 方法，浏览器将其用于 CORS 预检请求。

我最终在 config/routes 中得到了以下内容:

/myroute MyRouteR PUT OPTIONS

我有点希望在模板 Haskell 中有一些相关的机制来处理配置/路由，以便将 OPTIONS 添加到该路由的方法列表中会自动导致 CORS 支持，但没有骰子。不是世界末日，但这样会很有意义，感觉很优雅。

为了使 CORS 工作，我给路由一个 OPTIONS 处理程序:

optionsMyRouteR :: Handler RepPlain
optionsMyRouteR = do
    addHeader "Access-Control-Allow-Origin" "*"
    addHeader "Access-Control-Allow-Methods" "PUT, OPTIONS"
    return $ RepPlain $ toContent ("" :: Text)

putMyRouteR :: Handler RepJson
putMyRouteR = do
    addHeader "Access-Control-Allow-Origin" "*"
    -- more stuff ...

这行得通，但感觉有点不像Yesodic，因为它太样板了。所以，两个问题:

我们有比 Yesodic 更好的形容词吗？

还有另一种更好的方法来让路由支持跨域请求吗？

Answer 1

更新:
其他人为此发布了一些通用中间件:http://hackage.haskell.org/package/wai-cors .

我目前正在做同样的事情，还没有实现解决方案，但是我想它可以通过 WAI Middleware 来完成。类似于 wiki 页面上的示例代码 Allowing WOFF fonts to be accessed from other domains (CORS) .这应该允许您编写一次 CORS 代码而无需重复自己。

上面链接中的示例代码为 WOFF 字体添加跨域访问:

addCORStoWOFF :: W.Middleware
addCORStoWOFF app = fmap updateHeaders . app
  where
    updateHeaders (W.ResponseFile    status headers fp mpart) = W.ResponseFile    status (new headers) fp mpart
    updateHeaders (W.ResponseBuilder status headers builder)  = W.ResponseBuilder status (new headers) builder
    updateHeaders (W.ResponseSource  status headers src)      = W.ResponseSource  status (new headers) src
    new headers | woff      = cors : headers
                | otherwise =        headers
      where woff = lookup HT.hContentType headers == Just "application/font-woff"
            cors = ("Access-Control-Allow-Origin", "*")