chore(supervisor): access tag implemented

messages/uniworx/categories/authorization/de-de-formal.msg

@@ -15,6 +15,7 @@ UnauthorizedTokenInvalidAuthorityGroup: Ihr Authorisierungs-Token basiert auf de
 UnauthorizedTokenInvalidAuthorityValue: Ihr Authorisierungs-Token basiert auf Rechten, deren Spezifikation nicht interpretiert werden konnte.
 UnauthorizedTokenInvalidImpersonation: Ihr Authorisierungs-Token enthält die Anweisung sich als ein Nutzer:in auszugeben, dies ist jedoch nicht allen Benutzer:innen, auf deren Rechten ihr Authorisierungs-Token basiert, erlaubt.
 UnauthorizedToken404: Authorisierungs-Tokens können nicht auf Fehlerseiten ausgewertet werden.
+UnauthorizedSupervisor: Sie sind kein Ansprechpartner:in für diesen Benuzter:in.
 UnauthorizedSiteAdmin: Sie sind nicht System-weiter Administrator:in.
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator:in für dieses Institut eingetragen.
 UnauthorizedAdminEscalation: Sie sind nicht Administrator:in für alle Institute, für die dieser Nutzer/diese Nutzerin Administrator:in oder Veranstalter:in ist.

messages/uniworx/categories/authorization/en-eu.msg

@@ -15,6 +15,7 @@ UnauthorizedTokenInvalidAuthorityGroup: Your authorisation-token is based in an
 UnauthorizedTokenInvalidAuthorityValue: The specification of the rights in which your authorisation-token is based, could not be interpreted.
 UnauthorizedTokenInvalidImpersonation: Your authorisation-token contains an instruction to impersonate an user. Not all users on whose rights your token is based however are permitted to do so.
 UnauthorizedToken404: Authorisation-tokens cannot be processed on error pages.
+UnauthorizedSupervisor: You are not a supervisor for the requested user.
 UnauthorizedSiteAdmin: You are no system-wide administrator.
 UnauthorizedSchoolAdmin: You are no administrator for this department.
 UnauthorizedAdminEscalation: You aren't an administrator for all departments for which this user is an administrator.

models/users.model

@@ -76,9 +76,13 @@ UserGroupMember
     group         UserGroupName
     user          UserId
     primary       Checkmark nullable
-
     UniquePrimaryUserGroupMember group primary !force
     UniqueUserGroupMember group user
-
     deriving Generic
-    
+UserSupervisor
+    supervisor            UserId -- multiple supervisor per trainee possible
+    user                  UserId
+    rerouteNotifications  Bool
+    UniqueUserSupervisor supervisor user
+    deriving Generic
+    

routes

@@ -34,6 +34,7 @@
 --    !read           -- only if it is read-only access (i.e. GET but not POST)
 --    !write          -- only if it is write access     (i.e. POST only, included for completeness)
 --
+--    !token          -- requires bearer token
 --    !no-escalation  --
 --    !deprecated     -- like free, but logs and gives a warning; entirely disabled in production
 --    !development    -- like free, but only for development builds
@@ -92,8 +93,8 @@
 /user/lang                 LangR                   POST         !free
 /user/storage-key          StorageKeyR             POST         !free
 
-/user/for/#CryptoUUIDUser         ForProfileR       GET POST    !supervisor
+/for/#CryptoUUIDUser/user         ForProfileR       GET POST    !supervisor
-/user/profile/for/#CryptoUUIDUser ForProfileDataR   GET         !supervisor
+/for/#CryptoUUIDUser/user/profile ForProfileDataR   GET         !supervisor
 
 
 /exam-office               ExamOfficeR                         !exam-office:
@@ -281,11 +282,11 @@
 /lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	      GET       --   development
 /lms/#SchoolId/#QualificationShorthand/userlist         LmsUserlistR	        GET POST
 /lms/#SchoolId/#QualificationShorthand/userlist/upload  LmsUserlistUploadR	  GET POST  --   development
-/lms/#SchoolId/#QualificationShorthand/userlist/direct  LmsUserlistDirectR	      POST  --   token
+/lms/#SchoolId/#QualificationShorthand/userlist/direct  LmsUserlistDirectR	      POST  !token
-/lms/#SchoolId/#QualificationShorthand/fake             LmsFakeR              GET POST  --   development -- TODO: delete this testing URL
+/lms/#SchoolId/#QualificationShorthand/fake             LmsFakeR              GET POST  !development -- TODO: delete this testing URL
 /lms/#SchoolId/#QualificationShorthand/result           LmsResultR            GET POST
 /lms/#SchoolId/#QualificationShorthand/result/upload    LmsResultUploadR      GET POST  --   development
-/lms/#SchoolId/#QualificationShorthand/result/direct    LmsResultDirectR          POST  --   token
+/lms/#SchoolId/#QualificationShorthand/result/direct    LmsResultDirectR          POST  !token
 
 /api           ApiDocsR              GET      !free
 /swagger       SwaggerR              GET      !free

src/Foundation/Authorization.hs

@@ -238,9 +238,9 @@ trueAR, falseAR :: MsgRendererS UniWorX -> AuthResult
 trueAR = const Authorized
 falseAR = Unauthorized . ($ MsgUnauthorized) . render
 
-trueAP, falseAP :: AccessPredicate
+trueAP, _falseAP :: AccessPredicate
 trueAP  = APPure . const . const . const $ trueAR <$> ask
-falseAP = APPure . const . const . const $ falseAR <$> ask -- included for completeness
+_falseAP = APPure . const . const . const $ falseAR <$> ask -- included for completeness
 
 
 data AuthContext = AuthContext
@@ -546,22 +546,18 @@ tagAccessPredicate AuthAdmin = cacheAPSchoolFunction SchoolAdmin (Just $ Right d
         adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] []
         guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
         return Authorized
-tagAccessPredicate AuthSupervisor = falseAP 
-  {-    cacheAPDB   -- TODO: use memcachedByInvalidate to invalidate Cache on change 
-  
-  I'm to dumb to figure this out. :(
 
-   cacheAPSystemFunction SystemPrinter (Just $ Right diffHour) $ \mAuthId' _ _ printerList -> if
+tagAccessPredicate AuthSupervisor = APDB $ \_ _ mAuthId route _ -> case route of 
-  | maybe True (`Set.notMember` printerList) mAuthId' -> Right $ if
+    ForProfileR     cID -> checkSupervisor (mAuthId, cID)
-      | is _Nothing mAuthId' -> return AuthenticationRequired
+    ForProfileDataR cID -> checkSupervisor (mAuthId, cID)
-      | otherwise -> unauthorizedI MsgUnauthorizedSystemPrinter
+    r -> $unsupportedAuthPredicate AuthSupervisor r    
-  | otherwise -> Left $ APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
+  where 
+    checkSupervisor sup@(mAuthId, cID) = $cachedHereBinary sup . exceptT return return $ do
       authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-      isPrinter <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemPrinter, UserSystemFunctionIsOptOut ==. False]
+      uid <- decrypt cID
-      guardMExceptT isPrinter $ unauthorizedI MsgUnauthorizedSystemPrinter
+      isSupervisor <- lift . existsBy $ UniqueUserSupervisor authId uid
-      return Authorized      
+      guardMExceptT isSupervisor (unauthorizedI MsgUnauthorizedSupervisor)
-    SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+      return Authorized
-      -}
 
 tagAccessPredicate AuthSystemExamOffice = cacheAPSystemFunction SystemExamOffice (Just $ Right diffHour) $ \mAuthId' _ _ examOfficeList -> if
   | maybe True (`Set.notMember` examOfficeList) mAuthId' -> Right $ if