Typed Hierarchical Access Control System

Question

How can I define a simple hierarchical access control system in Haskell?

My roles are Public > Contributor > Owner, these roles are in a hierarchy. Everything that can be done by Public can also be done by Contributor and Owner; and so on.

Similarly Operations are also in a hierarchy: None > View > Edit. If a Role is permitted to Edit, it should also be able to View.

data Role = Public | Contributor | Owner
data Operation = None | View | Edit

newtype Policy = Policy (Role -> Operation)

In this system I can express public editable policy as:

publicEditable :: Policy
publicEditable = Policy $ const Edit

But type system does not prevent me from defining stupid policies like this (that permits Public to Edit but denies any access to the Owner):

stupidPolicy :: Policy
stupidPolicy = Policy check where
  check Public      = Edit
  check Contributor = View
  check Owner       = None

How can I express the hierarchical nature of Role and Operation in the type system?

Answer 1

Anyone with access to Policy's constructors can take a Policy apart and put it back together, possibly in a nonsensical fashion. Don't expose the Policy constructor outside of this module. Instead, provide a smart constructor to create policies that are guaranteed to be well-formed and expose a Monoid interface to compose them without breaking invariants. Keeping the Policy type abstract ensures that all the code which could result in nonsensical policies is kept inside this module.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Policy (
    Role(..),
    Level(..),
    Policy,  -- keep Policy abstract by not exposing the constructor
    can
    ) where

import Data.Semigroup (Semigroup, Max(..))

data Role = Public | Contributor | Owner
    deriving (Eq, Ord, Bounded, Enum, Show, Read)
data Level = None | View | Edit
    deriving (Eq, Ord, Bounded, Enum, Show, Read)

Below I'm using GeneralizedNewtypeDeriving to borrow a pair of Monoid instances from base: the monoid for functions, which lifts another monoid through the function arrow point-wise, and the Max newtype, which turns an Ord instance into a Monoid instance by always choosing the larger of mappend's arguments.

So Policy's Monoid instance will automatically manage the ordering of Level when composing policies: when composing two policies with conflicting levels at a given role we'll always choose the more permissive one. This makes <> an additive operation: you define policies by adding permissions to the "default" policy, mempty, which is the one which grants no permissions to anyone.

newtype Policy = Policy (Role -> Max Level) deriving (Semigroup, Monoid)

grant is a smart constructor which produces policies which respect the ordering properties of Role and Level. Note that I'm comparing roles with >= to ensure that granting a permission to a role also grants that permission to more privileged roles.

grant :: Role -> Level -> Policy
grant r l = Policy (Max . pol)
    where pol r'
            | r' >= r   = l
            | otherwise = None

can is an observation which tells you whether a policy grants a given access level to a given role. Once more I'm using >= to ensure that more-permissive levels imply less-permissive ones.

can :: Role -> Level -> Policy -> Bool
(r `can` l) (Policy f) = getMax (f r) >= l

I was pleasantly surprised by how little code this module took! Leaning on the deriving mechanism, especially GeneralizedNewtypeDeriving, is a really nice way of putting the types in charge of "boring" code so you can focus on the important stuff.

---

Usage of these policies looks like this:

module Client where

import Data.Monoid ((<>))
import Policy

You can use the Monoid class to build complex policies out of simple ones.

ownerEdit, contributorView, myPolicy :: Policy

ownerEdit = grant Owner Edit
contributorView = grant Contributor View
myPolicy = ownerEdit <> contributorView

And you can use the can function to test policies.

canPublicView :: Policy -> Bool
canPublicView = Public `can` View

For example:

ghci> canPublicView myPolicy
False