From b363c05c9579611204e63d49acb2358925e01b4f Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 29 Nov 2017 15:15:43 +0100
Subject: [PATCH] AdminSchool no longer nullable; Profile page displays granted
 rights

---
 models                   |  2 +-
 src/Foundation.hs        |  4 ++--
 src/Handler/Profile.hs   | 17 ++++++++++++++++-
 templates/profile.hamlet | 13 +++++++++++++
 4 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/models b/models
index 3fd72e33f..8ec481079 100644
--- a/models
+++ b/models
@@ -7,7 +7,7 @@ User
     UniqueAuthentication plugin ident
 UserAdmin
     user   UserId
-    school SchoolId Maybe
+    school SchoolId
 UserLecturer
     user   UserId
     school SchoolId
diff --git a/src/Foundation.hs b/src/Foundation.hs
index d6cf6ef55..14a30a7af 100644
--- a/src/Foundation.hs
+++ b/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"
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index f0b810216..5d962cbe9 100644
--- a/src/Handler/Profile.hs
+++ b/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")
diff --git a/templates/profile.hamlet b/templates/profile.hamlet
index 2420de6e0..0d8a020dd 100644
--- a/templates/profile.hamlet
+++ b/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}