Warning: Under Construction. I am using this site as my playground as I buildĀ gatsby-mdx and gatsby themes. During this time I will also repost new contentĀ to Medium

Servant Custom Content Types

Recently when implementing a Docker Registry I came across the need to hash the incoming request body in a way that matches the clients hash. Since the Docker engine is an existing client that speaks a couple of different Content-Types (such as application/vnd.docker.distribution.manifest.v2+json, we cannot use Servant's alternate content types to get a ByteString to hash. This leads us to one possible implementation, which is to create a new content type that uses application/vnd.docker.distribution.manifest.v2+json as the Accept header, but also hashes the content body with SHA256. Our content type will behave very similarly to application/json.

We will use cryptonite for hashing and Aeson for JSON decoding. The full code follows.

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module SR.HashedJSONContentType where
import Crypto.Hash (Digest, SHA256)
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BSC
import Network.HTTP.Media hiding (Accept)
import Servant.API.ContentTypes
import Utils (mkDigest)
data HashedJSON = HashedJSON String
instance Accept HashedJSON where
contentType _ = "application" // "vnd.docker.distribution.manifest.v2+json"
-- | We don't need MimeRender for this since we are only using
-- the content-type for receiving data.
-- instance Show a => MimeRender HashedJSON a where
-- mimeRender _ val = pack ("This is MINE! " ++ show val)
instance FromJSON a => MimeUnrender HashedJSON (Digest SHA256, a) where
mimeUnrender _ bs = case eitherDecodeLenient bs of
Left err -> Left err
Right val -> Right (mkDigest $ BSC.toStrict bs, val)

The most interesting part is the MimeUnrender instance for our custom content type HashedJSON. Servant provides a more lenient version of Aeson's decode called eitherDecodeLenient. We use this for compatibility with the normal 'JSON content type in Servant.

The instance uses a tuple (Digest SHA256, a) so any route types we write in the future will look similar to the following code which uses a fake type OurType.

ReqBody '[HashedJSON] (Digest SHA256, OurType)

An example handler using the above ReqBody declaration follows.

putManifest :: (CH.Digest CH.SHA256, Manifest) -> App NoContent)
putManifest (digest, manifest) = do
-- do stuff with digests and manifests
return NoContent

One can envision how changing the type of the hash in the type might allow us to specify which algorithm we want to use in the same way that we specify Manifest.