Zezwalanie na żądania różnych źródeł w Yesod

Question

Moja aplikacja używa skryptozakładki i muszę zezwalać CORS na MyRouteR, aby mój kod bookmarkletu mógł korzystać z tej trasy dla żądań AJAX.

W moim pierwszym szkicu konfiguracji/tras dałem MyRouteR obsługę tylko jednej metody żądania, PUT. Ale okazało się (duh), że będę musiał obsługiwać również metodę OPTIONS, które przeglądarki używają dla żądań wstępnych CORS.

skończyło się z następujących w config/trasach:

/myroute MyRouteR PUT OPTIONS 

Miałam nadzieję, nie byłoby pewne istotne maszyny w szablonie Haskell, który przetwarza config/trasy tak, że dodanie opcji do tego Lista metod trasy może automagicznie skutkować obsługą CORS, ale bez kości. Nie koniec świata, ale miałoby to sens i byłoby eleganckie w ten sposób.

Aby uczynić pracę CORS, dałem ROUTE procedurę obsługi opcji:

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 ... 

To działa, ale czuje się lekko un-Yesodic bo to tak boilerplate. Tak więc, dwa pytania:

1. Czy mamy lepszy przymiotnik niż Yesodic?
2. Czy istnieje inny, lepszy sposób na umożliwienie routingu obsługi wniosków o krzyż?

Answer 1

UPDATE: Ktoś opublikował pewne ogólne middleware do tego: http://hackage.haskell.org/package/wai-cors.

---

Ja obecnie pracuje na tej samej rzeczy i jeszcze nie wdrożył rozwiązanie, jednak sobie wyobrazić, można to zrobić za pomocą WAI Middleware podobny do przykładowego kodu na stronie wiki Allowing WOFF fonts to be accessed from other domains (CORS). Powinno to pozwolić ci raz na napisanie kodu CORS bez powtarzania siebie.

Przykładowy kod z linku powyżej, aby dodać dostępu cross-origin czcionek 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", "*")