如何使用 Servant 验证/报告无效输入的错误?

How can I validate / report errors for invalid input with Servant?

我正在阅读这里的仆人教程:https://docs.servant.dev/en/stable/tutorial/Server.html#from-combinators-to-handler-arguments

大致有如下代码:

app1 :: Application
app1 = serve (Proxy :: Proxy API) server3

main' :: IO ()
main' = run 8081 app1
type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email

data Position = Position
  { xCoord :: Int
  , yCoord :: Int
  } deriving Generic

instance ToJSON Position

newtype HelloMessage = HelloMessage { msg :: String }
  deriving Generic

instance ToJSON HelloMessage

data ClientInfo = ClientInfo
  { clientName :: String
  , clientEmail :: String
  , clientAge :: Int
  , clientInterestedIn :: [String]
  } deriving Generic

instance FromJSON ClientInfo
instance ToJSON ClientInfo

data Email = Email
  { from :: String
  , to :: String
  , subject :: String
  , body :: String
  } deriving Generic

instance ToJSON Email

emailForClient :: ClientInfo -> Email
emailForClient c = Email from' to' subject' body'

  where from'    = "great@company.com"
        to'      = clientEmail c
        subject' = "Hey " ++ clientName c ++ ", we miss you!"
        body'    = "Hi " ++ clientName c ++ ",\n\n"
                ++ "Since you've recently turned " ++ show (clientAge c)
                ++ ", have you checked out our latest "
                ++ intercalate ", " (clientInterestedIn c)
                ++ " products? Give us a visit!"

server3 :: Server API
server3 = position
     :<|> hello
     :<|> marketing

  where position :: Int -> Int -> Handler Position
        position x y = return (Position x y)

        hello :: Maybe String -> Handler HelloMessage
        hello mname = return . HelloMessage $ case mname of
          Nothing -> "Hello, anonymous coward"
          Just n  -> "Hello, " ++ n

        marketing :: ClientInfo -> Handler Email
        marketing clientinfo = return (emailForClient clientinfo)

给定一个简单的输入效果很好:

curl http://localhost:8081/position/1/2        
{"yCoord":2,"xCoord":1}

给定一个简单的 无效 输入效果不是很好(用字符串 test:

替换 2
curl -v http://localhost:8081/position/1/test  
*   Trying ::1:8081...
* TCP_NODELAY set
* connect to ::1 port 8081 failed: Connection refused
*   Trying 127.0.0.1:8081...
* TCP_NODELAY set
* Connected to localhost (127.0.0.1) port 8081 (#0)
> GET /position/1/test HTTP/1.1
> Host: localhost:8081
> User-Agent: curl/7.65.3
> Accept: */*
> 
* Mark bundle as not supporting multiuse
< HTTP/1.1 400 Bad Request
< Transfer-Encoding: chunked
< Date: Mon, 16 Dec 2019 18:01:00 GMT
< Server: Warp/3.2.28
< 
* Connection #0 to host localhost left intact

如何在第二种情况下向响应添加错误处理/验证?所以理想情况下,它不只是一个空白的 HTTP 400,而是响应 "error expecting int, got string"。这与 ExceptT 功能有关吗?哪里有这方面的简单示例吗?

一般来说,我认为不值得这样做,因为一般,可能会有非常复杂的路由组合,产生非常不直观的错误消息。例如,考虑以下 API:

type API = 
         "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
    :<|> "position" :> "foo" :> "test" :> Get '[JSON] Position

此 API 承认 /position/1/2/position/foo/test,但拒绝 /position/1/test,并且您无法为最后一种情况生成合理的错误消息。它必须是类似“期望在最后一个 Int,或者在倒数第二个位置的 "foo",但在最后得到 "test" 和“ 1" 在倒数第二个 "。对消费者没有帮助。

但是如果您只想处理这个特定路径,您可以创建第二个 "catch-all" 路由,该路由将 return 适当格式化的消息:

type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
      :<|> "position" :> Capture "x" Text :> Capture "y" Text :> Get '[JSON] ()
      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email

...

server3 = position
     :<|> badPosition
     :<|> hello
     :<|> marketing

    where 
        ...

        badPosition x y =
            throwError $ err400 { errBody = "Expected ints, got '" <> x <> "' and '" <> y <> "'" }