haskell - 如何使用 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

问题从来不在于仆人。进一步检查后，由于 postman 处理 的方式而出现此问题。选项 HTTP 动词。 访问控制请求方法除非您启用 ，否则不会实际发送 postman 拦截器 .这对我来说是一个幼稚的问题，但把它留在这里以防其他人遇到这个问题。