-- from http://stackoverflow.com/questions/41522159/typed-hierarchical-access-control-system
import Policy
import Data.Monoid ((<>))
ownersCanEdit, contributorsCanView, myPolicy :: Policy
ownersCanEdit = mkPolicy Owner Edit
contributorsCanView = mkPolicy Contributor View
ownersCantEdit = mkPolicy Owner None
myPolicy = ownersCantEdit <> ownersCanEdit <> contributorsCanView
publicPolicy :: Policy
publicPolicy = mkPolicy Public Edit
canPublicView :: Policy -> Bool
canPublicView = Public `can` View
main = do
print $ canPublicView myPolicy
print $ (Owner `can` Edit) myPolicy
print $ (Owner `can` Edit) publicPolicy
print $ (Contributor `can` View) ownersCanEdit
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Policy (
Role(..),
Level(..),
Policy,
mkPolicy,
can
) where
import Data.Semigroup (Max(..))
data Role = Public | Contributor | Owner
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data Level = None | View | Edit
deriving (Eq, Ord, Show, Read, Enum, Bounded)
newtype Policy = Policy (Role -> Max Level) deriving (Monoid)
mkPolicy :: Role -> Level -> Policy
mkPolicy r l = Policy (Max . pol) where
pol :: Role -> Level
pol r'
| r' >= r = l
| otherwise = minBound
can :: Role -> Level -> Policy -> Bool
(r `can` l) (Policy f) = getMax (f r) >= l
