a simple ABAC (Attribute Based Access Control) system implementation in Haskell

SimpleABAC.hs

--  | This is a module to explain the Attribute based access control system
--  , [ABAC](https://en.wikipedia.org/wiki/Attribute-based_access_control)
--  , [XACML](https://en.wikipedia.org/wiki/XACML)
module SimpleABAC where

import Data.Foldable

type AccessorAttr = String
type ResourceAttr = String
type OperationAttr = String
type SessionAttr = String
type Attributes = (AccessorAttr, ResourceAttr, OperationAttr, SessionAttr)

type DenyReason = String

-- | you must provide a Description when constructing Tactic
-- , it will latter be used when constructing a DenyReason
type Description = String

-- | a decision, isomorphism to 'Maybe Bool' if ignore DenyReason
data Decision
    = Permit
    | Deny DenyReason
    | Undecided

-- | Decision is Monoid similar to Alternative instance of Maybe
instance Monoid Decision where
    mempty = Undecided
    mappend Undecided dec = dec
    mappend dec _ = dec

-- | wrap a Decision with extra information on DenyReason in case of Deny
wrapD :: Description -> Decision -> Decision
wrapD desc dec = case dec of
    Deny dr -> Deny (desc ++ "\n" ++ dr)
    _ -> dec

type DecisionMaker = (Attributes -> Decision)

-- | a Tactic is either a simple Rule or a sequence of Tactics executed one by one
-- , you can also extend this definition by adding more combination constructors
data Tactic
    = Rule Description (DecisionMaker -> DecisionMaker) -- ^ a rule definition can recursively call the global 'DecisionMaker'
    | Seq Description [Tactic] -- ^ if the first Tactic made a decision then use it, else use the second one.

-- | run a Tactic as the global total Tactic
runTactic :: Tactic -> DecisionMaker
runTactic gtac = rec gtac where
    rec tac attr = case tac of
        Rule desc f -> wrapD desc (f (rec gtac) attr)
        Seq desc tacs -> wrapD desc (fold [rec tac attr | tac <- tacs])