New Servant Auth Role Library

Announcements
1

Hi folks. I put together a new library that adds a an Auth Role combinator to servant:

It allows you to gate access to routes by custom auth role rules and propagates GDP style proofs into the handlers to gate subroutine calls.

I’m not using in production yet but would love to get feedback from the community. I’ll probably start using it for my radio station web site (www.kpbj.fm) soon as a test case.

Here is an example, taken from the readme, of what it looks like:

-- default-language: GHC2021
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Main where

import Servant.Auth.Roles.TH
import Control.Monad.Except (throwError)
import Network.Wai (Request, requestHeaders)
import Network.Wai.Handler.Warp (run)
import Servant.API (Get, JSON, type (:<|>) (..), type (:>))
import Servant.API.Experimental.Auth (AuthProtect)
import Servant.Server (Context (..), Handler, Server, err401, serveWithContext)
import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData, mkAuthHandler)

-- 1. A plain role enum. No deriving clause needed.
data UserRole = Viewer | Editor | Admin

-- 2. One splice. Constructor order defines the hierarchy: Admin > Editor > Viewer.
$(deriveOrdRole ''UserRole)

-- 3. Your auth type, indexed by the role.
newtype RoleAuth (r :: UserRole) = RoleAuth {rName :: String}

-- 4. Declare your @AuthServerData@ intance with the provided @SomeRole@ existential wrapper.
type instance AuthServerData (AuthProtect "role-auth") = SomeRole RoleAuth


-- 5. Define a standard @AuthHandler@, using @someUserRole@ to construct your @SomeRole@ value.
authHandler :: AuthHandler Request (SomeRole RoleAuth)
authHandler = mkAuthHandler $ \req ->
  case lookup "X-Role" (requestHeaders req) of
    Just "viewer" -> pure (someUserRole Viewer (RoleAuth "Reed"))
    Just "editor" -> pure (someUserRole Editor (RoleAuth "Lyxia"))
    Just "admin" -> pure (someUserRole Admin (RoleAuth "Sandy"))
    _ -> throwError err401

-- 6. Gate the routes.
type API =
       RequireRole "role-auth" 'Viewer :> "viewer" :> Get '[JSON] String
  :<|> RequireRole "role-auth" 'Admin  :> "admin"  :> Get '[JSON] String

-- A statically admin-gated subroutine. `IsAtleastAdmin` is generated by the
-- splice.
banUser :: (IsAtleastAdmin r) => RoleAuth r -> String
banUser auth = "banned by " <> rName auth

server :: Server API
server = viewerH :<|> adminH
  where
    viewerH :: Satisfies 'Viewer RoleAuth -> Handler String
    viewerH (Satisfies _ auth) = pure ("viewer: " <> rName auth)

    -- Matching on the proof constructor brings the `'Admin <= r` evidence into
    -- scope, which is what lets `banUser` be called here and nowhere else.
    adminH :: Satisfies 'Admin RoleAuth -> Handler String
    adminH (Satisfies UserRoleProof auth) = pure (banUser auth)

main :: IO ()
main = run 3000 $ serveWithContext (Proxy @API) (authHandler :. EmptyContext) server
9 Likes
2

Fun. Thanks for sharing. I loooove GoDP! Some thoughts:

  • Apps tend to evolve, roles change or get decomposed and overlap. The usual answer is to define everything in terms of capabilities aka permissions — and then roles are just a bag of permissions. E.g Admin is [CanBan, …]. That way, consumers (endpoints or function trees that the endpoints use) don’t have to change in response to evolving role structures. Saves doing a big, expensive project to refactor the role system down the line. (As they say, ask me how I know. :joy:) If I squint I could imagine yours supporting that.
    • EDIT: I discovered on the README this already supported — apologies!
  • I’ve discussed with colleagues but not explored deeply using GoDP for permissions, a bit similar to what you’re exploring nicely with servant here!
  • Not sure whether you had envisioned this, but you could imagine e.g. an endpoint like “assign user to this task”, so you’d want the obvious proof that the caller can assign people, but also then you’d want a list of users who have permission to be assigned to a task (not all may be able) with the proof, and in that case you’d want the permission system for servant to be compatible and ergonomic with the one used by the model layer.

That last bullet point is a bit of a rabbit hole, but a fun one.

3 Likes
3

I spoke too soon (just went by the discourse post, sorry!), I just saw you also support permission sets: GitHub - solomon-b/servant-auth-roles · GitHub Interesting! :thinking:

3 Likes
4

Thanks yes I have permission sets support! The ux is a bit less nice for them then Eq/Ord based roles. Like verthing in this library, it has had zero production use. :slight_smile:

3 Likes