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

时间:2019-12-16 18:33:29

标签: haskell 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}

给出一个简单的 invalid 输入的效果不是很好(用字符串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功能有关吗?到处都有一个简单的例子吗?

1 个答案:

答案 0 :(得分:2)

总的来说,我认为这是不值得的,因为总的来说,可能会有非常复杂的路由组合,从而产生非常不直观的错误消息。例如,考虑以下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” -end ”。对消费者没有帮助。

但是,如果您只想处理这一特定路径,则可以只创建第二条“包罗万象”路线,该路线将返回格式正确的消息:

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