chore(avs): wip refactor qualifications view

models/avs.model

@@ -1,14 +1,25 @@
 -- Tables to save data received AVS
--- Purpose is to detect external changes in qualifications and postal addresses
+
+-- When creating an AvsUser the following cases are possible:
+-- 1. User does not exist, hence a new UserId ought to be created.
+-- 2. User does exists and can be matched by UserCompanyPersonalNumber
+-- 3. User does exists but cannot be matched now :(
+--      How can the matching be performed later?
+--      Do we need to merge users?
+-- > Handler.Utils.UsersassimilateUser 
+
+
 UserAvs
   personId        AvsPersonId -- unique identifier for user throughout avs
-  user            UserId  
+  user            UserId
   UniqueUserAvsUser user
-  UniqueUserAvsId personId
+  UniqueUserAvsId   personId
   deriving Generic
 
+-- Multiple UserAvsCards per UserAvs is possible and not too uncommon.
+-- Purpose of saving cards is to detect external changes in qualifications and postal addresses
 UserAvsCard 
-  personId        AvsPersonId  
+  personId        AvsPersonId    
   cardNo          AvsCardNo
   card            AvsDataPersonCard
   lastSynch       UTCTime

routes

@@ -84,13 +84,17 @@
 
 /external-apis ExternalApisR ServantApiExternalApis getServantApi
 
-/user                      ProfileR            GET POST        !free
+/user                      ProfileR            GET POST         !free
-/user/profile              ProfileDataR        GET             !free
+/user/profile              ProfileDataR        GET              !free
-/user/authpreds            AuthPredsR          GET POST        !free
+/user/authpreds            AuthPredsR          GET POST         !free
-/user/set-display-email    SetDisplayEmailR    GET POST        !free
+/user/set-display-email    SetDisplayEmailR    GET POST         !free
-/user/csv-options          CsvOptionsR         GET POST        !free
+/user/csv-options          CsvOptionsR         GET POST         !free
-/user/lang                 LangR                   POST        !free
+/user/lang                 LangR                   POST         !free
-/user/storage-key          StorageKeyR             POST        !free
+/user/storage-key          StorageKeyR             POST         !free
+
+-- /user/for/#CryptoUUIDUser         ForProfileR       GET POST    !supervisor
+-- /user/profile/for/#CryptoUUIDUser ForProfuleDataR   GET         !supervisor
+
 
 /exam-office               ExamOfficeR                         !exam-office:
   /                        EOExamsR            GET POST        !system-exam-office
@@ -265,13 +269,13 @@
 -- !/*{CI FilePath} CryptoFileNameDispatchR GET                  !free -- Disabled until preliminary check for valid cID exists
 
 -- for users
-/qualification                                          QualificationAllR     GET       !free
+/qualification                                          QualificationAllR     GET       !free -- TODO repurpose
-/qualification/#SchoolId                                QualificationSchoolR  GET       !free -- TODO
+/qualification/#SchoolId                                QualificationSchoolR  GET       !free -- TODO repurpose
-/qualification/#SchoolId/#QualificationShorthand        QualificationR        GET       -- TODO make !free again after repurpose
+/qualification/#SchoolId/#QualificationShorthand        QualificationR        GET       !free -- TODO repurpose
 -- OSIS CSV Export Demo
-/lms                                                    LmsAllR               GET POST
+/lms                                                    LmsAllR               GET POST  !free -- TODO verify that this is ok
-/lms/#SchoolId                                          LmsSchoolR            GET
+/lms/#SchoolId                                          LmsSchoolR            GET       !free -- TODO verify that this is ok
-/lms/#SchoolId/#QualificationShorthand                  LmsR  				        GET POST
+/lms/#SchoolId/#QualificationShorthand                  LmsR  				        GET POST  !free -- TODO verify that this is ok
 /lms/#SchoolId/#QualificationShorthand/edit             LmsEditR			        GET POST
 /lms/#SchoolId/#QualificationShorthand/users            LmsUsersR	            GET
 /lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	      GET

src/Auth/LDAP.hs

@@ -59,8 +59,10 @@ findUser conf@LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM
       [ ldapUserEmail'        Ldap.:= Text.encodeUtf8 ident'
       | ident' <- [ident, [st|#{ident}@lmu.de|], [st|#{ident}@fraport.de|]]
       , ldapUserEmail' <- toList ldapUserEmail
+      -- ] ++
+      -- [ ldapUserDisplayName   Ldap.:= Text.encodeUtf8 ident  -- for Fraport, userDisplayName has the pattern "Surname, Firstnames"
       ] ++
-      [ ldapUserDisplayName   Ldap.:= Text.encodeUtf8 ident
+      [ ldapUserFraportPersonalnummer Ldap.:= Text.encodeUtf8 ident
       ]
 
 findUserMatr :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry]

src/Handler/LMS.hs

@@ -324,6 +324,14 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.Left
     return (qualUser, user, lmsUser, printJob)
 
 
+newtype LmsTableFilterProj = LmsTableFilterProj { ltProjFilterMayAccess  :: Maybe Bool }
+
+instance Default LmsTableFilterProj where
+  def = LmsTableFilterProj
+    { ltProjFilterMayAccess  = Nothing }
+
+makeLenses_ ''LmsTableFilterProj
+
 mkLmsTable :: forall h p cols act act'.
               ( Functor h, ToSortable h
               , Ord act, PathPiece act, RenderMessage UniWorX act
@@ -347,7 +355,17 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
     dbtIdent = "qualification"    
     dbtSQLQuery q = lmsTableQuery qid q <* E.where_ (restrict q)
     dbtRowKey = queryUser >>> (E.^. UserId)
-    dbtProj = dbtProjFilteredPostId
+    --dbtProj = dbtProjFilteredPostId
+    dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
+      qusr <-    view $ _dbtProjRow . resultQualUser
+      user <-    view $ _dbtProjRow . resultUser
+      lusr <- preview $ _dbtProjRow . resultLmsUser
+      pjob <- preview $ _dbtProjRow . resultPrintJob
+      forMM_ (view $ _dbtProjFilter . _ltProjFilterMayAccess) $ \b -> do 
+        euid <- encrypt $ user ^. _entityKey
+        guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ AdminUserR euid -- TODO create a page with proper rights; this is only for admins!        
+      return (qusr,user,lusr,pjob)
+
     dbtColonnade = cols
     dbtSorting = mconcat
       [ single $ sortUserNameLink queryUser
@@ -367,7 +385,8 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
       , single ("lms-ended"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserEnded))
       ]
     dbtFilter = mconcat
-      [ single $ fltrUserNameEmail   queryUser
+      [ single ("may-access"  , FilterProjected $ (_ltProjFilterMayAccess  ?~) . getAny)
+      , single $ fltrUserNameEmail   queryUser
       , single ("lms-ident"   , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent))
       -- , single ("lms-status"  , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
       , single ("validity"    , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))

src/Utils/Avs.hs

@@ -128,6 +128,7 @@ bestAddress :: AvsDataPersonCard -> AvsDataPersonCard -> Ordering
       compareBy f = compare `on` f a b
 -}
 
+-- Merges several answers by AvsPersonId, preserving all AvsPersonCards
 mergeByPersonId :: Set AvsDataPerson -> Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson
 mergeByPersonId = flip $ Set.foldr aux
   where