MAC.hs

{-# OPTIONS_GHC -Wall -Werror #-}

{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe                         #-}

--------------------------------------------------------------------------------

-- |
-- Copyright  : (c) 2026 SPISE MISU ApS
-- License    : SSPL-1.0 OR AGPL-3.0-only
-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>
-- Stability  : experimental
--
-- Mandatory Access Control (MAC)
--
-- https://en.wikipedia.org/wiki/Mandatory_access_control
--
-- In computer security, mandatory access control (MAC) refers to a type of
-- access control by which the operating system or database constrains the
-- ability of a subject or initiator to access or generally perform some sort of
-- operation on an object or target.[1] In the case of operating systems, a
-- subject is usually a process or thread; objects are constructs such as files,
-- directories, TCP/UDP ports, shared memory segments, IO devices, etc. Subjects
-- and objects each have a set of security attributes. Whenever a subject
-- attempts to access an object, an authorization rule enforced by the operating
-- system kernel examines these security attributes and decides whether the
-- access can take place. Any operation by any subject on any object is tested
-- against the set of authorization rules (aka policy) to determine if the
-- operation is allowed. A database management system, in its access control
-- mechanism, can also apply mandatory access control; in this case, the objects
-- are tables, views, procedures, etc.
--
-- With mandatory access control, this security policy is centrally controlled
-- by a security policy administrator; users do not have the ability to override
-- the policy and, for example, grant access to files that would otherwise be
-- restricted. By contrast, discretionary access control (DAC), which also
-- governs the ability of subjects to access objects, allows users the ability
-- to make policy decisions and/or assign security attributes. (The traditional
-- Unix system of users, groups, and read-write-execute permissions is an
-- example of DAC.) MAC-enabled systems allow policy administrators to implement
-- organization-wide security policies. Under MAC (and unlike DAC), users cannot
-- override or modify this policy, either accidentally or intentionally. This
-- allows security administrators to define a central policy that is guaranteed
-- (in principle) to be enforced for all users.
--
-- [1] Belim, S. V.; Belim, S. Yu. (December 2018). "Implementation of Mandatory
-- Access Control in Distributed Systems". Automatic Control and Computer
-- Sciences. 52 (8): 1124–1126. doi:10.3103/S0146411618080357. ISSN 0146-4116.

--------------------------------------------------------------------------------

module Agent.Control.MAC
  ( MAC (MAC, run)
  , UID (UID, uid)
  , RES (RES, res)
  , join
  , label
  , unlabel
  , value
  )
where

--------------------------------------------------------------------------------

import           Control.Monad     ( ap, liftM )

import           Control.Exception ( Exception, SomeException )
import qualified Control.Exception as Ex

import           Agent.Control.IFC ( Flow )

--------------------------------------------------------------------------------

newtype MAC p a = MAC { run :: IO a }

instance Monad (MAC p) where
  (>>=) m f = MAC $ run m >>= run . f

instance Applicative (MAC p) where
  pure  = MAC . pure
  (<*>) = ap

instance Functor (MAC p) where
  fmap = liftM

--------------------------------------------------------------------------------

-- UID: Unique identifier
-- RES: Resource
-- LAB: Label

newtype UID   a = UID   { uid :: a }
newtype RES p a = RES   { res :: a }
type    LAB p a = RES p ( UID    a )

--------------------------------------------------------------------------------

value
  :: LAB l a
  -> a
value =
  uid . res

label
  :: Flow l h
  => a
  -> MAC l (LAB h a)
label =
  aux . pure . UID
  where
    aux io = RES <$> MAC io

unlabel
  :: Flow l h
  => LAB l a
  -> MAC h a
unlabel =
  aux $ pure . uid
  where
    aux io = MAC . io . res

join
  :: Flow l h
  => MAC h        a
  -> MAC l (LAB h a)
join m =
  (MAC . run) (aux m) >>= label
  where
    aux x = catch x throw

--------------------------------------------------------------------------------

-- HELPERS

throw
  :: SomeException
  -> MAC l a
throw =
  MAC . Ex.throw

catch
  :: Exception e
  =>       MAC l a
  -> (e -> MAC l a)
  ->       MAC l a
catch (MAC io) f =
  MAC $ Ex.catch io $ run . f