Riccardo Odone

Posted on May 11, 2020 • Edited on Jun 27, 2020 • Originally published at odone.io

Rewriting to Haskell–Errors

#functional #haskell #servant

You can keep reading here or jump to my blog to get the full experience, including the wonderful pink, blue and white palette.

This is part of a series:

The frontend code for Stream expects errors to have the following shape:

{
  "errors": {
      "text": [ "first error", "second error", ... ],
      ...
  },
  ...
}

For example when the text for a comment is empty the response should report that:

{ "errors": { "text": [ "can't be blank" ] } }

That happens for example when the request body to create a new comment is something like:

{ "post_id": 1 }

In fact, as shown below, Servant tries to parse the request body into a value of type CommentRequest but fails because text is missing:

type CommentsAPI = ReqBody '[JSON] CommentRequest :> Servant.Post '[JSON] Response

data CommentRequest =
  CommentRequest
    { commentRequestPostId :: Int
    , commentRequestText :: Text
    } deriving stock (Eq, Show)

instance FromJSON CommentRequest where
  parseJSON = withObject "CommentRequest" $ \v ->
    CommentRequest
      <$> v .: "post_id"
      <*> v .: "text"

Servant, when a parsing error happens, returns a 400 without a Content-Type and a simple string:

Error in $: key "text" not found

That is not what we want! The really cool thing is that, since Elm is using all the decoders magic, stuff still works! In particular, "An error occurred while submitting the comment" is shown at the top of the page and the application does not crash. I'm pretty sure I would have screwed it up in a language where error handling is optional.

However, had the proper error been returned, Elm would know what attribute was bad. For example, with

{ "errors": { "text": [ "can't be blank" ] } }

The frontend would add an error below the field in the form:

Therefore, we need to make sure that if in a body of a POST some key/value pair is missing, we return the correct json response. In other words, instead of the following:

Error in $: key "text" not found

We need to return:

{ "errors": { "text": [ "some error here" ] } }

with a Content-Type: application/json header.

Luckily, servant-errors has our back! The readme and associated blog post explain it pretty well.

In Stream we needed a couple of changes:

 app :: Configuration -> Connection -> Application
-app configuration connection = serve api $ server configuration connection
+app configuration connection = errorMwJson (serve api $ server configuration connection)

With errorMwJson defined as follows:

errorMwJson :: Application -> Application
errorMwJson = errorMw @(Ctyp JSON) @'[]

data Ctyp a deriving (Accept) via JSON

instance HasErrorBody (Ctyp JSON) '[] where
  encodeError = encodeAsJsonError

encodeAsJsonError :: StatusCode -> ErrorMsg -> ByteString
encodeAsJsonError _ content =
  encode . HashMap.fromList $ [("errors" :: Text, formatErrors . unErrorMsg $ content)]

formatErrors :: Text -> Value
formatErrors error_ = case parse aesonNotFoundKey "" error_ of
  Right field -> toJSON . HashMap.fromList $ [(field, ["missing in request body" :: Text])]
  Left _ -> toJSON error_

-- Parses things like `Error in $: key \"text\" not found`
aesonNotFoundKey :: Stream s m Char => ParsecT s u m Text
aesonNotFoundKey = do
  _ <- string "Error in $"
  _ <- manyTill anyChar $ char ':'
  _ <- string " key \""
  field <- T.pack <$> many1 letter
  _ <- string "\" "
  _ <- string "not found"
  pure field

Here's the test:

it "with missing text in the request body it returns a json response with errors.test" $ do
  currentUser <- liftIO $ createUser connection
  slackToken <- liftIO randomText
  let url = "/servant/comments?slack_token=" <> encodeUtf8 slackToken <> "&user_id=" <> (BS.pack . show . userId $ currentUser)
  let postAttributes = defaultPostAttributes {postAttributesUserId = userId currentUser}
  post_ <- liftIO $ createPost connection postAttributes
  let body = [json| { post_id: #{postId post_} } |]
  post url body `shouldRespondWith` [json| { errors: { text: ["missing in request body"]} } |] {matchStatus = 400}

Had we been using some Servant mechanism to derive Elm functions to query the endpoint, this would have been taken care of automatically. In fact, it would be impossible to send a wrong request (i.e. Elm would not compile). However, it was surprising to discover this default behaviour. Servant still rocks hard though! 🤘

Thanks Allan for authoring servant-errors! Wow, that saved me so many headaches!!

Get the latest content via email from me personally. Reply with your thoughts. Let's learn from each other. Subscribe to my PinkLetter!