键入分层访问控制系统

Question

如何在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 

我怎样才能表达作用和运作的分级性质的类型系统？

Answer 1

任何有权访问Policy的构造函数的人都可以将Policy分开，并将其重新组合在一起，可能以无意义的方式组合在一起。不要将Policy构造函数暴露在此模块之外。相反，请提供smart constructor来创建保证格式良好的策略，并公开接口以在不破坏不变量的情况下对其进行组合。保持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实例：the monoid for functions，它通过功能箭头升降机另一个独异逐点，和the Max newtype，其通过转动一个Ord实例成Monoid实例总是选择较大的mappend的论点。

所以撰写政策时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类构建复杂的策略进行简单的人的。可以使用can函数来测试策略。

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

例如：

ghci> canPublicView myPolicy 
False 

Answer 2

本杰明·霍奇森的解决方案更简单，更优雅，但这里有一个类型级编程解决方案，使用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) 

我们宣布的数据类型和使用singletonize这些模板哈斯克尔：

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*