DEV Community

Riccardo Odone
Riccardo Odone

Posted on • Updated on • Originally published at odone.io

Rewriting to Haskell–Errors

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", ... ],
      ...
  },
  ...
}
Enter fullscreen mode Exit fullscreen mode

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

{ "errors": { "text": [ "can't be blank" ] } }
Enter fullscreen mode Exit fullscreen mode

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

{ "post_id": 1 }
Enter fullscreen mode Exit fullscreen mode

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"
Enter fullscreen mode Exit fullscreen mode

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

Error in $: key "text" not found
Enter fullscreen mode Exit fullscreen mode

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" ] } }
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

We need to return:

{ "errors": { "text": [ "some error here" ] } }
Enter fullscreen mode Exit fullscreen mode

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)
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

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}
Enter fullscreen mode Exit fullscreen mode

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!

Latest comments (2)

Collapse
 
tfausak profile image
Taylor Fausak

Cool! Do you know if it's possible to work with Aeson's errors in a structured way? It feels kind of gross to parse the error messages 😬

Collapse
 
riccardoodone profile image
Riccardo Odone

That's a good question. I don't know but I'm sure there must be a better way!