Outlawing return types in Servant APIs

Intro

This post demonstrates how to outlaw specific return types from servant APIs. Perhaps we have types that are intended for backend use only, or maybe the types are legal in one API but illegal in another yet the backend code is a monolith. Whatever the reason, we can encode a type-level assertion over a servant API that produces a compile-time error if we ever accidentally add a sensitive type to the API.

A first approach

Our sensitive data type and a simple API referencing this type:

data VerySensitiveData = VerySensitiveData
  { secret1 :: Text
  , secret2 :: Text
  } deriving stock (Generic)
    deriving anyclass (FromJSON, ToJSON)

type MyAPI =
       "sensitive" :> Get '[JSON] VerySensitiveData
  :<|> "sensitive" :> ReqBody '[JSON] VerySensitiveData :> PostNoContent
  -- ...

myAPI :: Proxy MyAPI
myAPI = Proxy

The goal is to encode an assertion that outlaws at compile-time the Get '[JSON] VerySensitiveData endpoint. Assertions over servant APIs require “walking” the API type’s structure via recursive typeclass instances. A previous post has some examples of walking type-level lists, which may be useful as a refresher here. We’ll start with a wrapper constraint that delegates to a worker typeclass so that we’ll wind up with nicer error messages:

type NoOutlawedTypes :: Type -> Constraint
type NoOutlawedTypes a = NoOutlawedTypes' a a

The worker typeclass:

type NoOutlawedTypes' :: Type -> Type -> Constraint
class NoOutlawedTypes' a r

What may be curious here is that the typeclass has no methods. This is perfectly legal, and makes sense in our case considering we’re after a compile-time assertion.

Armed with this worker typeclass, we can start writing instances. Some of the simplest instances are the ones that walk the API’s shape:

instance (NoOutlawedTypes' a r, NoOutlawedTypes' b r) => NoOutlawedTypes' (a :<|> b) r
instance (NoOutlawedTypes' b r) => NoOutlawedTypes' (a :> b) r

These instances handle the recursion down into specific paths of the API (the (:<|>) type operator), and for each specific path, recursing down towards the end of the path (the (:>) type operator). It may seem like this r type we’re carrying around is useless, but we’ll see soon where it comes into play.

When we get to the end of the path, we expect to hit a Verb:

data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) (a :: *)

The a type parameter is the return type for the Verb, so that’s our target type:

instance
  ( NoOutlawedTypes' a (Verb method code contentTypes a)
  ) => NoOutlawedTypes' (Verb method code contentTypes a) r

The instance for Verb is the first (and will be the only) instance to override the r type. When recursing into the instance for a, we stuff the whole Verb into r’s place to improve the assertion’s error message.

Next up is to produce a type error if a is our outlawed type:

instance (CustomError VerySensitiveData r) => NoOutlawedTypes' VerySensitiveData r

type CustomError :: Type -> Type -> Constraint
type CustomError badTy containingTy =
  TypeError
    ( 'Text "This API forbids returning values of type:"
        ':$$: 'Text ""
        ':$$: 'Text "  " ':<>: 'ShowType badTy
        ':$$: 'Text ""
        ':$$: 'Text "API return type that contains the forbidden type:"
        ':$$: 'Text ""
        ':$$: 'Text "  " ':<>: 'ShowType containingTy
        ':$$: 'Text ""
    )

The last bit is to provide a catch-all instance for all other types:

instance {-# OVERLAPPABLE #-} NoOutlawedTypes' a r

In marking this instance as overlappable, all of our previous instances will still match appropriately as they are more specific than this instance.

Now that we have this machinery, let’s look at how we can use it. A first thought may be to stick the assertion on the Proxy value we have lying around for the API:

myAPI :: NoOutlawedTypes MyAPI => Proxy MyAPI
myAPI = Proxy

A slight wrinkle though is that this constraint won’t be solved until myAPI is used somewhere, e.g. when passing it to serve. We’d prefer to not expose this assertion. A convenient means of keeping it internal is to capture the constraint in a local Dict value (where Dict comes from the constraints package):

myAPI :: Proxy MyAPI
myAPI = Proxy
  where
  _dict :: Dict (NoOutlawedTypes MyAPI)
  _dict = Dict

Now we’ll get the type error right away:

    • This API forbids returning values of type:

        VerySensitiveData

      API return type that contains the forbidden type:

        Verb 'GET 200 '[JSON] VerySensitiveData

    • In the expression: Dict
      In an equation for ‘_dict’: _dict = Dict
      In an equation for ‘myAPI’:
          myAPI
            = Proxy
            where
                _dict :: Dict (NoOutlawedTypes MyAPI)
                _dict = Dict
   |
39 |   _dict = Dict
   |           ^^^^

It may appear our work is done, but astute readers may have noticed a glaring problem: the sensitive type could be embedded in another type, and we might write a new endpoint that accidentally returns the wrapping type:

type MyAPI =
  -- ...
  :<|> "underhanded" :> Get '[JSON] UnderhandedData

newtype UnderhandedData = UnderhandedData
  { stuff :: VerySensitiveData
  } deriving stock (Generic)
    deriving anyclass (FromJSON, ToJSON)

If this was our API, the NoOutlawedTypes machinery is completely subverted as UnderhandedData is handled by the catch-all instance. We need to extend our approach by deeply inspecting each of an API’s return types.

Going deeper

To deeply inspect the return types, we’ll turn to GHC.Generics and replace our catch-all instance with the following:

instance {-# OVERLAPPABLE #-}
  ( Generic a, GNoOutlawedTypes (Rep a) r
  ) => NoOutlawedTypes' a r

We’ve created an overlappable instance that will delegate to a GNoOutlawedTypes worker typeclass so long as a has a Generic instance. As before, in marking this instance as overlappable, all of our previous instances will still match appropriately as they are more specific than this instance. The worker typeclass and instances walk a type’s Generic representation:

type GNoOutlawedTypes :: forall {k}. (k -> Type) -> Type -> Constraint
class GNoOutlawedTypes f r
instance GNoOutlawedTypes V1 r
instance GNoOutlawedTypes U1 r
instance (GNoOutlawedTypes f r, GNoOutlawedTypes g r) => GNoOutlawedTypes (f :+: g) r
instance (GNoOutlawedTypes f r, GNoOutlawedTypes g r) => GNoOutlawedTypes (f :*: g) r
instance NoOutlawedTypes' ty r => GNoOutlawedTypes (K1 tag ty) r
instance GNoOutlawedTypes f r => GNoOutlawedTypes (M1 tag meta f) r

This post won’t be getting into the Generic weeds, so be sure to check the GHC.Generics docs for a good introduction. The most important instance to understand here is:

instance NoOutlawedTypes' ty r => GNoOutlawedTypes (K1 tag ty) r

This is the instance in play when we encounter a field of a constructor. The field is of type ty, so we recurse back into the NoOutlawedTypes' machinery over ty. This instance combined with the other Generic bits of dealing with sums/products is what gives us our deep inspection of return types.

It’s worth returning our attention back to the instance that drives most of the work:

instance {-# OVERLAPPABLE #-}
  ( Generic a, GNoOutlawedTypes (Rep a) r
  ) => NoOutlawedTypes' a r

This imposes a very strong requirement on our API’s return types: each return type must have an instance of Generic. In fact, this requirement is significantly stronger due to the implementation of GNoOutlawedTypes: all types referenced by a return type must each have a Generic instance, as must the types each of those reference, and so on recursively. For some codebases, this may be a non-starter. However, it is not uncommon for codebases to lean into anyclass-derived instances for serialization (e.g. FromJSON/ToJSON), and so these codebases already have Generic instances handy.

Many “primitive” types (e.g. Int, Text, etc.) do not have Generic instances, so we must define trivial instances for all of the primitive/lowest-level types the API uses. In practice, there is a relatively small handful of these types (most composite types in web APIs boil down to ints, strings, timestamps, etc.), so the maintenance burden here is fairly light compared to the safety gained in compile-time elimination of the risk of exposing sensitive data:

instance NoOutlawedTypes' Int r
instance NoOutlawedTypes' Double r
instance NoOutlawedTypes' Text r
instance NoOutlawedTypes' UTCTime r
instance NoOutlawedTypes' UUID r
instance (NoOutlawedTypes' a r) => NoOutlawedTypes' (Set a) r
-- ...

End

With the above in place, now there’s no way for us to accidentally smuggle out VerySensitiveData inside UnderhandedData:

    • This API forbids returning values of type:

        VerySensitiveData

      API return type that contains the forbidden type:

        Verb 'GET 200 '[JSON] UnderhandedData

A bonus too is that GHC does not stop at the first assertion failure in the API: it will provide all failures. This behavior can be useful if this technique or something along similar lines is employed on a large, existing API as opposed to the API being built from the ground up with assertions.

Note that the implementation so far is incomplete: we didn’t handle servant’s Headers or UVerb. Both of these types could be used in APIs that reference our sensitive type. Extending this post’s machinery to cover these additional types is left as an exercise.

Thanks for reading! The full code is available in a SourceHut repo.