如何在 Haskell 中定义一个简单的分层访问控制系统?
我的角色是Public > Contributor > Owner
,这些角色在一个层次结构中。Public
能做的一切,也可以由Contributor
和Owner
做;等等。
同样,操作也在层次结构中:None > View > Edit
。如果允许角色编辑,则它也应该能够查看。
data Role = Public | Contributor | Owner
data Operation = None | View | Edit
newtype Policy = Policy (Role -> Operation)
在这个系统中,我可以将公共可编辑策略表示为:
publicEditable :: Policy
publicEditable = Policy $ const Edit
但是类型系统并不能阻止我定义这样的愚蠢策略(允许Public
Edit
但拒绝对Owner
的任何访问):
stupidPolicy :: Policy
stupidPolicy = Policy check where
check Public = Edit
check Contributor = View
check Owner = None
如何在类型系统中表达角色和操作的层次结构性质?
任何能够访问Policy
构造函数的人都可以将Policy
拆开并重新组合在一起,可能是以一种荒谬的方式。不要在此模块外部公开Policy
构造函数。相反,请提供一个智能构造函数来创建保证格式正确的策略,并公开一个Monoid
接口来组合它们,而不会破坏不变量。保持Policy
类型抽象可确保所有可能导致无意义策略的代码都保留在此模块中。
{-# 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)
下面我用GeneralizedNewtypeDeriving
从base
借用一对Monoid
实例:函数的幺半群,它通过函数箭头逐点提升另一个幺半群,以及Max
newtype,它通过始终选择mappend
参数中较大的一个,将Ord
实例转换为Monoid
实例。
因此,Policy
的Monoid
实例将在编写策略时自动管理Level
的顺序:在给定角色上编写两个具有冲突级别的策略时,我们将始终选择更宽松的策略。这使得<>
成为一种累加操作:您可以通过向"默认"策略mempty
添加权限来定义策略,该策略不向任何人授予任何权限。
newtype Policy = Policy (Role -> Max Level) deriving (Semigroup, Monoid)
grant
是一个智能构造函数,它生成尊重Role
和Level
排序属性的策略。请注意,我正在将角色与>=
进行比较,以确保向角色授予权限时也会将该权限授予更多特权角色。
grant :: Role -> Level -> Policy
grant r l = Policy (Max . pol)
where pol r'
| r' >= r = l
| otherwise = None
can
是一个观察,告诉您策略是否向给定角色授予给定的访问权限级别。我再次使用>=
来确保更宽松的水平意味着更宽松的水平。
can :: Role -> Level -> Policy -> Bool
(r `can` l) (Policy f) = getMax (f r) >= l
我对这个模块占用的代码如此之少感到惊喜!依靠deriving
机制,尤其是GeneralizedNewtypeDeriving
,是让类型负责"无聊"代码的一种非常好的方法,这样您就可以专注于重要的事情。
这些策略的用法如下所示:
module Client where
import Data.Monoid ((<>))
import Policy
您可以使用Monoid
类从简单的策略构建复杂的策略。
ownerEdit, contributorView, myPolicy :: Policy
ownerEdit = grant Owner Edit
contributorView = grant Contributor View
myPolicy = ownerEdit <> contributorView
您可以使用can
函数来测试策略。
canPublicView :: Policy -> Bool
canPublicView = Public `can` View
例如:
ghci> canPublicView myPolicy
False
Benjamin Hodgson的解决方案更简单,更优雅,但这里有一个类型级编程解决方案,使用singletons
包的机制。
这个想法是,策略表示为(Role, Operation)
元组的类型级别列表,其中Role
和Operation
在列表中都必须不递减。这样,我们就不能获得荒谬的[(Public,Edit),(Owner,View)]
许可。
一些必需的扩展和导入:
{-# language PolyKinds #-}
{-# language DataKinds #-}
{-# language TypeFamilies #-}
{-# language GADTs #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
{-# language FlexibleInstances #-}
{-# language ScopedTypeVariables #-}
{-# language TemplateHaskell #-}
import Data.Singletons
import Data.Singletons.TH
import Data.Promotion.Prelude (Unzip)
我们声明数据类型并使用模板 Haskell 单调化它们:
data Role = Public | Contributor | Owner deriving (Show,Eq,Ord)
data Operation = None | View | Edit deriving (Show,Eq,Ord)
$(genSingletons [''Role,''Operation])
$(promoteEqInstances [''Role,''Operation])
$(promoteOrdInstances [''Role,''Operation])
具有非递减元素的列表的类:
class Monotone (xs :: [k])
instance Monotone '[]
instance Monotone (x ': '[])
instance ((x :<= y) ~ True, Monotone (y ': xs)) => Monotone (x ': y ': xs)
给定指定为类型级列表的策略,返回策略函数:
policy :: forall (xs :: [(Role, Operation)]) rs os.
(Unzip xs ~ '(rs,os), Monotone rs, Monotone os)
=> Sing xs
-> Role
-> Operation
policy singleton role =
let decreasing = reverse (fromSing singleton)
allowed = dropWhile ((role',_) -> role' > role) decreasing
in case allowed of
[] -> None
(_,perm) : _ -> perm
在GHCI中进行测试:
ghci> :set -XDataKinds -XPolyKinds -XTypeApplications
ghci> policy (sing::Sing '[ '(Public,View),'(Owner,Edit) ]) Owner
Edit
ghci> policy (sing::Sing '[ '(Public,Edit),'(Owner,View) ]) Owner
*unhelpful type error*