lpr: add system function printer

models/users.model

@@ -53,9 +53,9 @@ UserFunction -- Administratively assigned functions (lecturer, admin, evaluation
     deriving Generic
 UserSystemFunction
     user     UserId
-    function SystemFunction
-    manual   Bool
-    isOptOut Bool
+    function SystemFunction   -- Defined in Model.Types.User
+    manual   Bool             -- Inserted manually by Admin or automatic from LDAP
+    isOptOut Bool             -- User has currently deactivate the role for themselves
     UniqueUserSystemFunction user function
     deriving Generic
 UserExamOffice

routes

@@ -9,6 +9,8 @@
 --
 --  Admins always have access to entities within their assigned schools.
 --
+--  Access tags are defined in Model.Types.Security
+-- 
 --  Access Tags:
 --    !free           -- free for all
 --    !lecturer       -- lecturer    for this course (or for any school, if route is not connected to a course)

src/Foundation/Authorization.hs

@@ -555,6 +555,15 @@ tagAccessPredicate AuthSystemExamOffice = cacheAPSystemFunction SystemExamOffice
       isExamOffice <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemExamOffice, UserSystemFunctionIsOptOut ==. False]
       guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedSystemExamOffice
       return Authorized
+tagAccessPredicate AuthSystemPrinter = cacheAPSystemFunction SystemPrinter (Just $ Right diffHour) $ \mAuthId' _ _ printerList -> if
+  | maybe True (`Set.notMember` printerList) mAuthId' -> Right $ if
+      | is _Nothing mAuthId' -> return AuthenticationRequired
+      | otherwise -> unauthorizedI MsgUnauthorizedSystemPrinter
+  | otherwise -> Left $ APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
+      authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+      isPrinter <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemPrinter, UserSystemFunctionIsOptOut ==. False]
+      guardMExceptT isPrinter $ unauthorizedI MsgUnauthorizedSystemPrinter
+      return Authorized
 tagAccessPredicate AuthStudent = cacheAPSystemFunction SystemStudent (Just $ Right diffHour) $ \mAuthId' _ _ studentList -> if
   | maybe True (`Set.notMember` studentList) mAuthId' -> Right $ if
       | is _Nothing mAuthId' -> return AuthenticationRequired

src/Model/Types/User.hs

@@ -11,6 +11,7 @@ data SystemFunction
   = SystemExamOffice
   | SystemFaculty
   | SystemStudent
+  | SystemPrinter
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
   deriving anyclass (Universe, Finite, Hashable, NFData)