Type Safe Servant Auth Roles

Servant Auth Roles

SOLOMON'S BLOG

functional programming, permaculture, math

I wanted a nice way to create a roles system on top of servant-auth. This post walks through the design and implementation process. The end result is quite similar to OCharle's Who Authorized These Ghosts. You can see the final result here.

The immediate thing I wanted was auth roles/permission sets in my Servant API types such that I can define distinct handlers for each auth role. I also want to maintain compatibility with AuthProtect.

The idea

My first move was to sketch out an imaginary interface for the library. My hope is that starting from the interface that the code would reveal its implementation to me.

I wanted to define my roles as a sum type and then instantiate a typeclass to describe the role check conditions. This way I could design a variety of role systems (hierarchical, non-hierarchical, set based, etc).

data UserRole = Viewer | Editor | Admin deriving (Eq, Ord, Show)

instance CheckRole 'Viewer where checkRole role = role >= Viewer

instance CheckRole 'Editor where checkRole role = role >= Editor

instance CheckRole 'Admin where checkRole role = role >= Admin

CheckRole allows you to use arbitrary predicates. In this case I use Ord, because I want fall-through but we could just as easily use Eq, or even set membership if you want to model something more like "permissions" then "roles."

Then we would define our typical Servant auth type and AuthServerData instance:

data Authz = Authz { userRole :: UserRole, userName :: String } deriving (Show)

type instance AuthServerData (AuthProtect "test-auth") = Authz

And finally some magical Servant combinator RequireRole I can use in my API types to assign auth roles to routes. The combinator would introduce a role permission check before firing the handler. If the UserRole value from Authz doesn't satisfy the RoleChecK for a handler it fails and tries the next matching route.

type PanelAdminAPI = RequireRole "test-auth" 'Admin :> "panel" :> Get '[JSON] String

type PanelEditorAPI = RequireRole "test-auth" 'Editor :> "panel" :> Get '[JSON] String

type PanelViewerAPI = RequireRole "test-auth" 'Viewer :> "panel" :> Get '[JSON] String

type API = PanelAdminAPI : PanelEditorAPI : PanelViewerAPI

server :: Server API server = panelAdmin : panelEditor : panelViewer where panelAdmin :: Authz -> Handler String panelAdmin _ = pure "admin panel"

panelEditor :: Authz -> Handler String panelEditor _ = pure "editor panel"

panelViewer :: Authz -> Handler String panelViewer _ = pure "viewer panel"

This obviously doens't work as is, but I wanted a DX roughly like this.

Making the idea work

The key to this idea is going to be the RequireRole HasServer instance.

HasServer in a nutshell

But before that, allow me to briefly explain the HasServer class. This isn't a Servant tutorial so I'm going to skip a lot of details.

It has one associated type and two methods:

class HasServer api context where type ServerT api (m :: Type -> Type) :: Type

route :: Proxy api -> Context context -> Delayed env (Server api) -> Router env

hoistServerWithContext :: Proxy api -> Proxy context -> (forall x. m x -> n x) -> ServerT api m -> ServerT api n

type Server api = ServerT api Handler

api is our Servant Combinator. It describes a part of an API's structure. The HasServer instance is sort of a bridge between that API description and an actual route handler that serves it.

The associated type ServerT tells the compiler how to translate from the api type to a fragment of your handler's type signature.

For example the ServerT associated type for Verb is:

type ServerT (Verb method status ctypes a) m = m a

This means Verb 'GET 200 '[JSON] a maps to m a in your handler's signature.

route builds a dispatch tree called a Router that Servant then converts via serve into a WAI Application for processing requests.

Each API component has its own route definition and they recursively build up a Delayed computation used to produce the input to the handler function.

For example, Capture "id" Int says to grab the next URL path segment, try to parse it as an Int, then pass it to the handler. Chaining more API components builds out the Delayed computation whose result is passed to the handler function.

Lastly we have hoistServerWithContext. Servant applications are typically written in a custom monad m but ultimately they need to be run in Handler. We use a natural transformation to map from m to Handler. This function says how to propagate the natural transformation through this API component.

Our instance

Our datatype will contain a symbol representing the auth method to lookup in the Context and a role r that we will use to check against our authenticated user's role:

data RequireRole (tag :: Symbol) (r :: k)

Our hoistServerWithContext definition is boring and just passes the natural transformation through the next API component.

route is where we do all the work. We want to get...

Type Safe Servant Auth Roles

Related Articles

(no title)

Scientists reverse brain aging, with a nasal spray

AI has torched the market for junior programmers

Al Vigier: Canada's AI strategy shouldn't include secret Palantir bills

The Anatomy of an AI-Native Org