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

I'm going through the servant tutorial here: https://docs.servant.dev/en/stable/tutorial/Server.html#from-combinators-to-handler-arguments

Which roughly has code like below:

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'    = "[email protected]"
        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)

Given a simple input works great:

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

Given an simple invalid input works not so great (replacing 2 with a string 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

How can I add error handling / validation to the response in the second case? So ideally rather than just a blank HTTP 400, it responds with "error expecting int, got string". Would this be to do with the ExceptT functionality? Is there a simple example of this anywhere?

Solution

In general, I think, this is not worth doing, because in general, there may be very complicated combinations of routes, yielding very unintuitive error messages. For example, consider the following API:

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

This API admits /position/1/2 and /position/foo/test, but rejects /position/1/test, and there is no sane error message you can generate for this last case. It would have to be something like "expecting either an Int at the very end, or a "foo" in the second-from-end position, but got "test" at the end and "1" at second-from-end". Not helpful for the consumer.

But if you just want to handle this one particular path, you can just create a second "catch-all" route that would return an appropriately formatted message:

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