Разрешение запросов перекрестного происхождения в Yesod

Мое приложение использует букмарклет, и мне нужно разрешить CORS для MyRouteR, поэтому мой код букмарклета может использовать этот маршрут для запросов AJAX.

В моем первом проекте config/routes я дал поддержку MyRouteR только для одного метода запроса PUT. Но оказалось (duh), что мне нужно будет также поддерживать метод OPTIONS, какие браузеры используют для предпродажных запросов CORS.

В конфигурации/маршрутах я получил следующее:

/myroute MyRouteR PUT OPTIONS

Я как бы надеялся, что в Template 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 ...

Это работает, но он чувствует себя немного не-йесодическим, потому что он так тщательно. Итак, два вопроса:

  • Есть ли у нас лучшее прилагательное, чем есодическое?
  • Есть ли другой, лучший способ разрешить маршрутизацию запросов кросс-происхождения?

Ответы

Ответ 1

UPDATE: Кто-то еще опубликовал какое-то общее промежуточное ПО для этого: http://hackage.haskell.org/package/wai-cors.

В настоящее время я работаю над одним и тем же и еще не реализовал решение, однако, я думаю, это можно сделать с помощью WAI Middleware, аналогичного образцу кода на странице wiki Разрешить доступ к шрифтам WOFF из других доменов (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", "*")