如何在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)
Run Code Online (Sandbox Code Playgroud)
在这个系统中,我可以表达公共可编辑的政策:
publicEditable :: Policy
publicEditable = Policy $ const Edit
Run Code Online (Sandbox Code Playgroud)
但是,这类系统并不妨碍我从定义这样愚蠢的政策(即允许Public
到Edit
,但否认对任何访问Owner
):
stupidPolicy :: Policy
stupidPolicy = Policy check where
check Public = Edit
check Contributor = View
check Owner = None
Run Code Online (Sandbox Code Playgroud)
如何在类型系统中表达角色和操作的层次性?
任何能够访问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)
Run Code Online (Sandbox Code Playgroud)
下面我使用GeneralizedNewtypeDeriving
借用一对Monoid
从实例base
:在对独异功能,它通过功能箭头逐点升降机另一半群,和所述Max
NEWTYPE,果然一个Ord
实例为Monoid
通过总是选择的较大实例mappend
的参数.
因此Policy
,Monoid
实例将自动管理Level
编写策略时的顺序:当在给定角色中编写具有冲突级别的两个策略时,我们将始终选择更宽松的策略.这会产生<>
一个附加操作:您可以通过向"默认"策略添加权限来定义策略,该策略mempty
是不向任何人授予权限的策略.
newtype Policy = Policy (Role -> Max Level) deriving (Semigroup, Monoid)
Run Code Online (Sandbox Code Playgroud)
grant
是一个聪明的构造产生哪方面的订货性政策Role
和Level
.请注意,我正在比较角色,>=
以确保授予角色权限也授予更多特权角色的权限.
grant :: Role -> Level -> Policy
grant r l = Policy (Max . pol)
where pol r'
| r' >= r = l
| otherwise = None
Run Code Online (Sandbox Code Playgroud)
can
是一个观察,它告诉您策略是否授予给定角色给定的访问级别.我再次使用>=
以确保更宽松的级别意味着更不宽容的级别.
can :: Role -> Level -> Policy -> Bool
(r `can` l) (Policy f) = getMax (f r) >= l
Run Code Online (Sandbox Code Playgroud)
我很惊喜这个模块的代码很少!deriving
特别GeneralizedNewtypeDeriving
是倾向于使用这种机制是一种非常好的方式,可以让类型负责"无聊"的代码,这样你就可以专注于重要的事情.
这些策略的用法如下所示:
module Client where
import Data.Monoid ((<>))
import Policy
Run Code Online (Sandbox Code Playgroud)
您可以使用Monoid
该类从简单的策略构建复杂的策略.
ownerEdit, contributorView, myPolicy :: Policy
ownerEdit = grant Owner Edit
contributorView = grant Contributor View
myPolicy = ownerEdit <> contributorView
Run Code Online (Sandbox Code Playgroud)
您可以使用该can
功能来测试策略.
canPublicView :: Policy -> Bool
canPublicView = Public `can` View
Run Code Online (Sandbox Code Playgroud)
例如:
ghci> canPublicView myPolicy
False
Run Code Online (Sandbox Code Playgroud)