Question

如何在Haskell中定义一个简单的分层访问控制系统？

我的角色是var channelCreator = require("<path>/channelCreator.js"); //this is where you can access the channel object: if(channelCreator.channel){ channelCreator.channel.sendToQueue('QueueName', new Buffer('This is Some Message.')); console.log(" [x] Sent 'Message'"); }，这些角色位于层次结构中。 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

如何在类型系统中表达角色和操作的层次性？

Answer 1

任何有权访问Policy的构造函数的人都可以将Policy分开并将其重新组合在一起，可能是以荒谬的方式。不要在此模块之外公开Policy构造函数。相反，提供smart constructor来创建保证格式正确的策略并公开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从Monoid the monoid for functions借用了一对base个实例，通过功能箭头逐点提升另一个幺半群和the Max newtype，通过始终选择较大的Ord参数，将Monoid实例转换为mappend实例。

因此，Policy Monoid实例会在撰写政策时自动管理Level的排序：在给定角色中组合两个具有冲突级别的政策时，我们会在我总是会选择更宽松的。这使得<>成为添加操作：您可以通过向＆＃34;默认＆＃34;添加权限来定义策略。策略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，是一种非常好的方式，可以让这些类型的人负责＃34;无聊＆＃34;代码，这样你就可以专注于重要的事情。

这些政策的使用如下：

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

Answer 2

Benjamin Hodgson的解决方案更简单，更优雅，但这是一个类型级编程解决方案，使用t包的机制。

这个想法是策略表示为singletons元组的类型级列表，其中(Role, Operation)和Role都必须在列表中不减少。这样，我们就不能拥有荒谬的Operation权限。

一些必需的扩展和导入：

[(Public,Edit),(Owner,View)]

我们使用Template Haskell声明数据类型并对它们进行单例化：

{-# 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)

具有非减少元素的列表的类：

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)

在ghci中测试：

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

类型化的分层访问控制系统

2 个答案: