Typisiertes hierarchisches Zugriffskontrollsystem

Question

Wie kann ich ein einfaches hierarchisches Zugriffskontrollsystem in Haskell definieren?

Meine Rollen sind Public > Contributor > Owner, diese Rollen sind in einer Hierarchie. Alles, was durch Public getan werden kann, kann auch durch Contributor und Owner; und so weiter.

Ähnlich Operationen sind auch in einer Hierarchie: None > View > Edit. Wenn eine Rolle bearbeiten darf, sollte sie auch anzeigen können.

data Role = Public | Contributor | Owner 
data Operation = None | View | Edit 

newtype Policy = Policy (Role -> Operation) 

In diesem System I bearbeitbare Politik öffentlich zum Ausdruck bringen können, wie:

publicEditable :: Policy 
publicEditable = Policy $ const Edit 

Aber Typ-System mich nicht von der Definition dumme Politik verhindern so (die Public zu Edit erlaubt aber verweigert den Zugriff auf den Owner):

stupidPolicy :: Policy 
stupidPolicy = Policy check where 
    check Public  = Edit 
    check Contributor = View 
    check Owner  = None 

Wie kann ich die hierarchische Natur der Rolle und Funktion in der Art System auszudrücken ?

Answer 1

Jeder mit Zugriff auf Policy Konstruktoren kann ein Policy auseinander nehmen und es wieder zusammensetzen, möglicherweise in einer unsinnigen Art und Weise. Setzen Sie den Policy Konstruktor nicht außerhalb dieses Moduls ein. Stellen Sie stattdessen eine smart constructor bereit, um Richtlinien zu erstellen, die garantiert gut formatiert sind und eine Monoid-Schnittstelle bereitstellen, um sie zu erstellen, ohne Invarianten zu beschädigen. Wenn Sie den Typ Policy beibehalten, wird sichergestellt, dass der gesamte Code, der zu unsinnigen Richtlinien führen könnte, in diesem Modul verbleibt.

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

Im Folgenden werde ich GeneralizedNewtypeDeriving bin mit ein Paar Monoid Instanzen von base zu leihen: the monoid for functions, die eine andere Monoid durch die Funktion Pfeil punktweise und the Max newtype, die durch eine Ord Instanz in eine Monoid Instanz dreht hebt immer die größeren Argumente von mappend wählen.

So Policy ‚s Monoid Instanz wird automatisch die Reihenfolge der Level verwalten, wenn Politik Komponieren: wenn zwei Richtlinien mit widersprüchlichen Ebenen zu einer bestimmten Rolle zu komponieren wir immer mehr permissiven wählen. Dies macht <> eine additive Operation: Sie definieren Richtlinien durch Hinzufügen von Berechtigungen zu der "Standard" -Richtlinie, mempty, die derjenige ist, der keine Berechtigungen an niemanden gewährt.

newtype Policy = Policy (Role -> Max Level) deriving (Semigroup, Monoid) 

grant ist ein Smart Konstruktor, die Politik, die die Ordnungseigenschaften von Role und Level respektieren produziert. Beachten Sie, dass ich Rollen mit >= vergleiche, um sicherzustellen, dass das Gewähren einer Berechtigung für eine Rolle diese Berechtigung auch für mehr privilegierte Rollen gewährt.

grant :: Role -> Level -> Policy 
grant r l = Policy (Max . pol) 
    where pol r' 
      | r' >= r = l 
      | otherwise = None 

can ist eine Beobachtung, die Ihnen sagt, ob eine Politik einen bestimmten Zugriffsebene auf eine bestimmte Rolle gewährt.Noch einmal verwende ich >= um sicherzustellen, dass mehr-permissive Ebenen weniger permissive beinhalten.

can :: Role -> Level -> Policy -> Bool 
(r `can` l) (Policy f) = getMax (f r) >= l 

Ich war angenehm überrascht, wie wenig Code dieses Modul dauerte! Auf dem deriving Mechanismus, besonders GeneralizedNewtypeDeriving, ist eine wirklich nette Weise, die Typen verantwortlich für "langweiligen" Code zu setzen, damit Sie sich auf die wichtigen Sachen konzentrieren können.

---

Verwendung dieser Politik sieht wie folgt aus:

module Client where 

import Data.Monoid ((<>)) 
import Policy 

Sie die Monoid-Klasse verwenden, können komplexe Richtlinien aus einfachen Ideen zu bauen.

ownerEdit, contributorView, myPolicy :: Policy 

ownerEdit = grant Owner Edit 
contributorView = grant Contributor View 
myPolicy = ownerEdit <> contributorView 

Und Sie können die can Funktion zu testen Richtlinien verwenden.

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

Zum Beispiel:

ghci> canPublicView myPolicy 
False 

Answer 2

Benjamin Hodgson Lösung ist einfacher und eleganter, aber hier ist eine Art-Level-Programmierlösung, die Maschinerie des singletons Paket.

Die Idee ist, dass die Politik als Typ-Ebene Listen (Role, Operation) Tupel dargestellt werden, in den beiden Role s und die Operation s über die Liste werden nondecreasing müssen. Auf diese Weise können wir keine absurde [(Public,Edit),(Owner,View)] Erlaubnis haben.

Einige erforderlichen Erweiterungen und Importe:

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

Wir haben die Datentypen erklären und singletonize sie Template Haskell mit:

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]) 

Eine Klasse für Listen mit nicht abnehmenden Elementen:

class Monotone (xs :: [k]) 
instance Monotone '[] 
instance Monotone (x ': '[]) 
instance ((x :<= y) ~ True, Monotone (y ': xs)) => Monotone (x ': y ': xs) 

Geben Sie für eine Richtlinie, die als Liste auf Typenebene angegeben ist, die Richtlinienfunktion zurück:

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 

Testing es in 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*