chore(avs): wip refactor qualifications view
This commit is contained in:
Steffen Jost
parent
a90ae2653f
commit
61991aadc4
@ -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
|
||||
|
||||
30
routes
30
routes
@ -84,13 +84,17 @@
|
||||
|
||||
/external-apis ExternalApisR ServantApiExternalApis getServantApi
|
||||
|
||||
/user ProfileR GET POST !free
|
||||
/user/profile ProfileDataR GET !free
|
||||
/user/authpreds AuthPredsR GET POST !free
|
||||
/user/set-display-email SetDisplayEmailR GET POST !free
|
||||
/user/csv-options CsvOptionsR GET POST !free
|
||||
/user/lang LangR POST !free
|
||||
/user/storage-key StorageKeyR POST !free
|
||||
/user ProfileR GET POST !free
|
||||
/user/profile ProfileDataR GET !free
|
||||
/user/authpreds AuthPredsR GET POST !free
|
||||
/user/set-display-email SetDisplayEmailR GET POST !free
|
||||
/user/csv-options CsvOptionsR GET POST !free
|
||||
/user/lang LangR 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/#SchoolId QualificationSchoolR GET !free -- TODO
|
||||
/qualification/#SchoolId/#QualificationShorthand QualificationR GET -- TODO make !free again after repurpose
|
||||
/qualification QualificationAllR GET !free -- TODO repurpose
|
||||
/qualification/#SchoolId QualificationSchoolR GET !free -- TODO repurpose
|
||||
/qualification/#SchoolId/#QualificationShorthand QualificationR GET !free -- TODO repurpose
|
||||
-- OSIS CSV Export Demo
|
||||
/lms LmsAllR GET POST
|
||||
/lms/#SchoolId LmsSchoolR GET
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST
|
||||
/lms LmsAllR GET POST !free -- TODO verify that this is ok
|
||||
/lms/#SchoolId LmsSchoolR GET !free -- TODO verify that this is ok
|
||||
/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
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user