Type Safe Servant Auth Roles

Summary

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] St...