如何使用Servant处理飞行前OPTIONS请求

Question

我有一个仆人应用程序，并针对我的问题查看了以下问题，我得到了 400 的预检请求与 OPTIONS 动词：

https://github.com/haskell-servant/servant/issues/154

https://github.com/haskell-servant/servant-swagger/issues/45

https://github.com/haskell-servant/servant/issues/278

以及为它创建的包 https://hackage.haskell.org/package/servant-options

发出以下请求时，我无法解决预检请求问题：

curl -X OPTIONS \
  http://localhost:8081/todos \
  -H 'authorization: JWT xxx' \
  -H 'cache-control: no-cache' \
  -H 'postman-token: 744dff43-a6ad-337d-8b67-5a6f70af8864'

我仍然得到：

Access-Control-Request-Method header is missing in CORS preflight request

尽管按照建议使用了以下中间件：

{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE FlexibleContexts      #-}

module Adapter.Servant.Main (main) where

import ClassyPrelude hiding (Handler)
import           Domain.Types.AppEnv
import           Network.Wai.Handler.Warp
import           Network.Wai
import           Network.Wai.Middleware.RequestLogger
-- import qualified Adapter.Servant.TodoAPI as TodoAPI
import qualified Adapter.Servant.TODO.API as TodoAPI
import qualified Adapter.Servant.Swagger as Swagger
import qualified Adapter.Servant.Auth as Auth
import           Network.Wai.Middleware.Cors
import           Servant
import           Servant.Server
import           Network.Wai.Middleware.Servant.Options
import           Network.Wai.Middleware.AddHeaders

allowCsrf :: Middleware
allowCsrf = addHeaders [("Access-Control-Allow-Headers", "x-csrf-token,authorization")]

middleware :: Application -> Application
middleware =  logStdoutDev . allowCsrf . corsMiddleware
--middleware = logStdoutDev . myCors

corsMiddleware :: Application -> Application
corsMiddleware = cors (const $ Just appCorsResourcePolicy)

myCors :: Middleware
myCors = cors (const $ Just policy)
    where
      policy = simpleCorsResourcePolicy
        { corsRequestHeaders = ["Content-Type"]
        , corsMethods = "PUT" : simpleMethods }

appCorsResourcePolicy :: CorsResourcePolicy
appCorsResourcePolicy =
    simpleCorsResourcePolicy
        { corsMethods = ["OPTIONS", "GET", "PUT", "POST"]
        , corsRequestHeaders = ["Authorization", "Content-Type"]
        }
{-
main :: AppEnv -> IO ()
main env = do
  Swagger.writeSwaggerJSON
  run 8081 $ middleware (TodoAPI.todoApp env)
-}
type AppAPI = TodoAPI.TodoAPI :<|> "docs" :> Raw

appApi :: Proxy AppAPI
appApi = Proxy

main :: AppEnv -> IO ()
main env = do
  Swagger.writeSwaggerJSON
  run 8081 $ corsMiddleware $ logStdoutDev $ (appServer env)
  -- run 8081 $ middleware (TodoAPI.todoApp env)
  -- run 8081 $ middleware $ (appServer env)


appServer :: AppEnv -> Application
appServer env = serveWithContext appApi (Auth.genAuthServerContext env) ((TodoAPI.todoServer env) :<|> Swagger.docServer)

servant-options 包也不适用于我的 API，因为我收到以下错误：

    • No instance for (servant-foreign-0.15:Servant.Foreign.Internal.GenerateList
                         NoContent
                         (servant-foreign-0.15:Servant.Foreign.Internal.Foreign
                            NoContent
                            (AuthProtect "JWT"
                             :> (ReqBody '[JSON] Domain.Types.TODO.NewTodo
                                 :> Post '[JSON] Int64))))
        arising from a use of ‘provideOptions’
    • In the expression: provideOptions appApi
      In the expression:
        provideOptions appApi
          $ serveWithContext
              appApi
              (Auth.genAuthServerContext env)
              ((TodoAPI.todoServer env) :<|> Swagger.docServer)
      In an equation for ‘appServer’:
          appServer env
            = provideOptions appApi
                $ serveWithContext
                    appApi
                    (Auth.genAuthServerContext env)
                    ((TodoAPI.todoServer env) :<|> Swagger.docServer)
   |

我确信这已经解决了，但线程中显示的示例不起作用，如果您提供上下文，则提供的包似乎不起作用

Answer 1

问题从来不在于仆人。经过进一步检查，出现此问题的原因是邮递员处理OPTIONS HTTP 动词的方式。除非您启用邮递员拦截器，否则永远不会实际发送Access -Control-Request-Method。这对我来说是一个天真的问题，但把它留在这里以防其他人遇到这个问题。