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

Question

我正在这里阅读仆人教程: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}

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

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，而是以“错误期望 int，得到字符串”作为响应。这与 ExceptT有关吗？功能？任何地方都有这样的简单例子吗？

Answer 1

总的来说，我认为，这是不值得做的，因为一般来说，可能会有非常复杂的路由组合，产生非常不直观的错误信息。例如，考虑以下 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”路由，它会返回一个适当格式的消息:

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 <> "'" }