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

【问题标题】：How to handle pre flight OPTIONS request with Servant如何使用 Servant 处理飞行前 OPTIONS 请求
【发布时间】：2023-03-13 17:55:02
【问题描述】：

我有一个仆人应用程序，并针对我的问题查看了以下问题，我收到了 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)
   |

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

【问题讨论】：

标签： haskell servant

【解决方案1】：

问题从来不在于仆人。进一步检查后，由于邮递员处理 OPTIONS HTTP 动词的方式而出现此问题。 Access-Control-Request-Method 永远不会真正发送，除非您启用 postman 拦截器。这对我来说是一个幼稚的问题，但把它放在这里以防其他人遇到这个问题。

【讨论】：