鍵入分層訪問控制系統

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*