AdminSchool no longer nullable; Profile page displays granted rights

models

@@ -7,7 +7,7 @@ User
     UniqueAuthentication plugin ident
 UserAdmin
     user   UserId
-    school SchoolId Maybe
+    school SchoolId
 UserLecturer
     user   UserId
     school SchoolId

src/Foundation.hs

@@ -202,11 +202,11 @@ submissionAccess cID = do
     True  -> Authorized
     False -> Unauthorized "No access to this submission"
 
-adminAccess :: Maybe (Maybe SchoolId) -- ^ If @Just@, matched exactly against 'userAdminSchool'
+adminAccess :: Maybe SchoolId -- ^ If @Just@, matched exactly against 'userAdminSchool'
             -> YesodDB UniWorX AuthResult
 adminAccess school = do    
   authId <- lift requireAuthId
-  rights <- selectList [UserAdminUser ==. authId, UserAdminSchool <-. catMaybes [school,Just Nothing]] []  
+  rights <- selectList ((UserAdminUser ==. authId) : maybe [] (\s -> [UserAdminSchool ==. s]) school) []  
   return $ if (not $ null rights) 
     then Authorized
     else Unauthorized "No admin access"

src/Handler/Profile.hs

@@ -7,9 +7,24 @@ module Handler.Profile where
 
 import Import
 
+import qualified Database.Esqueleto as E
+import           Database.Esqueleto      ((^.))
+
 getProfileR :: Handler Html
 getProfileR = do
-    (_, user) <- requireAuthPair
+    (uid, user) <- requireAuthPair
+    (admin_rights,lecturer_rights) <- runDB $ (,) <$>
+            (E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
+                E.where_ $ adright ^. UserAdminUser E.==. E.val uid
+                E.on $ adright ^. UserAdminSchool E.==. school ^. SchoolId
+                return (school ^. SchoolName)     
+            ) 
+            <*> 
+            (E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
+                E.where_ $ lecright ^. UserLecturerUser E.==. E.val uid
+                E.on $ lecright ^. UserLecturerSchool E.==. school ^. SchoolId
+                return (school ^. SchoolName)     
+            )        
     defaultLayout $ do
         setTitle . toHtml $ userIdent user <> "'s User page"
         $(widgetFile "profile")

templates/profile.hamlet

@@ -8,3 +8,16 @@
 
     <p>
       Your data is protected with us <strong><span class="username">#{userIdent user}</span></strong>!
+      
+    $if not $ null admin_rights
+      <h1>
+        Administrator für die Institute
+      <ul>
+        $forall institute <- admin_rights
+          <li>#{show institute}
+    $if not $ null lecturer_rights
+      <h1>
+        Lehrberechtigung für die Institute
+      <ul>
+        $forall institute <- lecturer_rights
+          <li>#{show institute}