Question

我制作了一个自定义组合器：MultipartUpload，但是当我使用它时，它最终不仅应用我使用它的路线，而且还应用所有后续路线：

例如，在以下API中，MultipartUpload在第2和第3条路线上运行。因此，如果我调用第3个，它将返回错误File upload required。我只希望它适用于第二个。怎么样？

type ModelAPI =
  "models" :>
    (    ProjectKey :> Get '[JSON] [Model]
    :<|> ProjectKey :> MultipartUpload :> Post '[JSON] Model
    :<|> ProjectKey :> Capture "modelId" ID :> Get '[JSON] Model
    )

以下是MultipartUpload的定义方式。

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Servant.Multipart
  ( MultipartUpload
  , FileInfo(..)
  ) where

import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as Lazy
import Network.HTTP.Types (status400)
import Network.Wai.Parse
import Network.Wai (responseLBS)
import Servant
import Servant.Server.Internal


data MultipartUpload

instance (HasServer sublayout) => HasServer (MultipartUpload :> sublayout) where
  type ServerT (MultipartUpload :> sublayout) m =
    FileInfo ByteString -> ServerT sublayout m

  route Proxy subserver req respond = do
    dat <- parseRequestBody lbsBackEnd req
    let files = snd dat
    case files of
      [(_, f)] ->
        if Lazy.null $ fileContent f
          then respond . succeedWith $ responseLBS status400 [] "Empty file"
          else route (Proxy :: Proxy sublayout) (subserver f) req respond
      [] ->
        respond . succeedWith $ responseLBS status400 [] "File upload required"

      _ ->
        respond . succeedWith $ responseLBS status400 [] "At most one file allowed"

Answer 1

免责声明：我从未使用过Servant，但我理解它的方法。

您的MultiPartUpload :> sublayout处理程序太急切了。如果你始终respond succeedWith，那么Servant无法知道它不匹配，因此它应继续尝试下一个替代方案。

如果您想要进入下一个替代方案，则需要使用failWith。

通过查看HasServer的{{1}}个实例，您可以看到这种情况：

:<|>

除非第一个反应不匹配，否则从未考虑过第二种选择。

Answer 2

我之前创建了一个与http方法匹配的组合子，因此它可以正确选择路径，并允许MultipartUpload组合器需要上传，而不是简单地不匹配。

我还提出了一个问题要求澄清：https://github.com/haskell-servant/servant/issues/410

-- combinator that returns a mismatch if the method doesn't match
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Servant.Method where

import qualified Network.HTTP.Types as HTTP
import Network.Wai (requestMethod)
import Servant
import Servant.Server.Internal

data GET
data POST
data DELETE
data PUT

data Method a

class ToMethod method where
    toMethod :: Proxy method -> HTTP.Method

instance ToMethod GET where
    toMethod _ = HTTP.methodGet

instance ToMethod POST where
    toMethod _ = HTTP.methodPost

instance ToMethod DELETE where
    toMethod _ = HTTP.methodDelete

instance ToMethod PUT where
    toMethod _ = HTTP.methodPut

instance (ToMethod method, HasServer api) => HasServer (Method method :> api) where
  type ServerT (Method method :> api) m =
    ServerT api m

  route Proxy api req respond = do
    if requestMethod req == toMethod (Proxy :: Proxy method)
      then route (Proxy :: Proxy api) api req respond
      else respond . failWith $ WrongMethod

如果我这样使用它可以解决问题：

type ModelAPI =
  "models" :>
    (    ProjectKey :> Get '[JSON] [Model]
    :<|> ProjectKey :> Method POST :> MultipartUpload :> Post '[JSON] Model
    :<|> ProjectKey :> Capture "modelId" ID :> Get '[JSON] Model
    )

仆人组合子不会落入后续的替代方案中

2 个答案: