fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): add more auto update indicators to profile page

Browse Source
This commit is contained in:
Steffen Jost 2024-06-13 14:51:05 +02:00
parent 76e0710c7b
commit 0eac40457b
7 changed files with 64 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/misc/de-de-formal.msg
View File

@ -15,7 +15,7 @@ WeekDay: Wochentag
LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"} Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"} Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"}
NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch aktualisiert. NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch durch as AVS aktualisiert.
ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv

2
messages/uniworx/misc/en-eu.msg
View File

@ -15,7 +15,7 @@ WeekDay: Day of the week
LdapIdentificationOrEmail: Fraport AG-Kennung / email address LdapIdentificationOrEmail: Fraport AG-Kennung / email address
Months num: #{num} #{pluralEN num "Month" "Months"} Months num: #{num} #{pluralEN num "Month" "Months"}
Days num: #{num} #{pluralEN num "Day" "Days"} Days num: #{num} #{pluralEN num "Day" "Days"}
NoAutomaticUpdateTip: This value receives no automatic updates, since it has been edited manually. NoAutomaticUpdateTip: This particular value receives no automatic AVS updates, since it has been edited manually.
ClusterVolatileQuickActionsEnabled: Quick actions enabled ClusterVolatileQuickActionsEnabled: Quick actions enabled

4
src/Handler/Profile.hs
View File

@ -588,9 +588,11 @@ getForProfileDataR cID = do
dataWidget dataWidget
makeProfileData :: Entity User -> DB Widget makeProfileData :: Entity User -> DB Widget
makeProfileData usrEnt@(Entity uid User{..}) = do makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid) avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
let usrAutomatic :: forall t . EntityField User t -> Widget
usrAutomatic upd = updateAutomatic $ maybe False (mayUpdate usrVal (avsId ^? _Just . _userAvsLastPersonInfo . _Just)) $ userPersonUpd upd
(actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt (actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt
functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] [] functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do

51
src/Handler/Utils/Avs.hs
View File

@ -31,6 +31,7 @@ module Handler.Utils.Avs
-- CR3 -- CR3
, SomeAvsQuery(..) , SomeAvsQuery(..)
, queryAvsCardNo, queryAvsCardNos , queryAvsCardNo, queryAvsCardNos
, userPersonUpd
) where ) where
import Import import Import
@ -323,6 +324,40 @@ updateAvsUserByIds' apids = do
catchAll (runDB updateAvsUserByADC') errHandler catchAll (runDB updateAvsUserByADC') errHandler
userPersonUpd :: EntityField User t -> Maybe (CheckUpdate User AvsPersonInfo)
userPersonUpd = flip Map.lookup dict . persistFieldDef
where
dict = Map.fromList -- EntityField has no Eq instance, but FieldDef does. Is is only unique within a single Table, but we need to fix the Table type anyway
[ (persistFieldDef UserFirstName , CheckUpdate UserFirstName _avsInfoFirstName)
, (persistFieldDef UserSurname , CheckUpdate UserSurname _avsInfoLastName)
, (persistFieldDef UserDisplayName , CheckUpdate UserDisplayName _avsInfoDisplayName)
, (persistFieldDef UserBirthday , CheckUpdate UserBirthday _avsInfoDateOfBirth)
, (persistFieldDef UserMobile , CheckUpdate UserMobile _avsInfoPersonMobilePhoneNo)
, (persistFieldDef UserMatrikelnummer , CheckUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just) -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, (persistFieldDef UserCompanyPersonalNumber , CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just) -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups above
, (persistFieldDef UserLdapPrimaryKey , CheckUpdate UserLdapPrimaryKey $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just)
, (persistFieldDef UserDisplayEmail , CheckUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI)
]
-- more general than userPersonUpd, starting at UserAvs instead of AvsPersonInfo
-- usrAvsUpd :: EntityField User t -> Maybe (CheckUpdate User UserAvs)
-- usrAvsUpd = flip Map.lookup dict . persistFieldDef
-- where
-- dict = Map.fromList
-- [ (persistFieldDef UserFirstName , CheckUpdate UserFirstName $ _userAvsLastPersonInfo . _Just . _avsInfoFirstName)
-- , (persistFieldDef UserSurname , CheckUpdate UserSurname $ _userAvsLastPersonInfo . _Just . _avsInfoLastName)
-- , (persistFieldDef UserDisplayName , CheckUpdate UserDisplayName $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName)
-- -- , (persistFieldDef UserBirthday , CheckUpdate UserBirthday $ _userAvsLastPersonInfo . _Just . _avsInfoDateOfBirth) -- no SemiGroup for Day
-- , (persistFieldDef UserMobile , CheckUpdate UserMobile $ _userAvsLastPersonInfo . _Just . _avsInfoPersonMobilePhoneNo)
-- , (persistFieldDef UserMatrikelnummer , CheckUpdate UserMatrikelnummer $ _userAvsLastPersonInfo . _Just . _avsInfoPersonNo . re _Just) -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
-- , (persistFieldDef UserCompanyPersonalNumber , CheckUpdate UserCompanyPersonalNumber $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just) -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups above
-- , (persistFieldDef UserLdapPrimaryKey , CheckUpdate UserLdapPrimaryKey $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just)
-- , (persistFieldDef UserDisplayEmail , CheckUpdate UserDisplayEmail $ _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI)
-- , (persistFieldDef UserPinPassword , CheckUpdate UserPinPassword $ _userAvsLastCardNo . _Just . to avsFullCardNo2pin . re _Just)
-- , (persistFieldDef UserPostAddress , CheckUpdate UserPostAddress $ _userAvsLastFirmInfo . _Just . _avsFirmPostAddress)
-- ]
updateAvsUserByADC :: AvsDataContact -> DB (Maybe (AvsPersonId, UserId)) updateAvsUserByADC :: AvsDataContact -> DB (Maybe (AvsPersonId, UserId))
updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMaybeT $ do updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMaybeT $ do
(Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid (Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
@ -355,14 +390,14 @@ updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMa
( CheckUpdate UserLdapPrimaryKey $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just) ( CheckUpdate UserLdapPrimaryKey $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just)
[ CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just [ CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
] ]
let per_ups = mapMaybe (mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo) let per_ups = mapMaybe (mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo) $ catMaybes
[ CheckUpdate UserFirstName _avsInfoFirstName [ userPersonUpd UserFirstName
, CheckUpdate UserSurname _avsInfoLastName , userPersonUpd UserSurname
, CheckUpdate UserDisplayName _avsInfoDisplayName , userPersonUpd UserDisplayName
, CheckUpdate UserBirthday _avsInfoDateOfBirth , userPersonUpd UserBirthday
, CheckUpdate UserMobile _avsInfoPersonMobilePhoneNo , userPersonUpd UserMobile
, CheckUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just` , userPersonUpd UserMatrikelnummer
-- , CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups above -- , userPersonUpd UserCompanyPersonalNumber -- needs special treatment, see ldap_ups above
] ]
apiEmail = _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI apiEmail = _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI
afiEmail = _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI afiEmail = _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI

8
src/Utils/Avs.hs
View File

@ -86,9 +86,9 @@ mkAvsQuery _ _ _ = AvsQuery
fakePerson :: AvsQueryPerson -> AvsResponsePerson fakePerson :: AvsQueryPerson -> AvsResponsePerson
fakePerson = fakePerson =
let let
sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) mempty sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) mempty
stephan = Set.singleton $ AvsDataPerson "Stephan" "Barth" Nothing 4 (AvsPersonId 4) mempty stephan = Set.singleton $ AvsDataPerson "Stephan" "Barth" Nothing 4 (AvsPersonId 4) mempty
steffen = Set.singleton $ AvsDataPerson "Steffen" "Jost" (Just $ mkAvsInternalPersonalNo "47138") 12345678 (AvsPersonId 12345678) mempty steffen = Set.singleton $ AvsDataPerson "Steffen" "Jost" (Just $ mkAvsInternalPersonalNo "47138") 12345678 (AvsPersonId 12345678) mempty
sumpfi1 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 12345678) mempty sumpfi1 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 12345678) mempty
sumpfi2 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty sumpfi2 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty
sumpfi3 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604591) mempty sumpfi3 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604591) mempty
@ -112,7 +112,7 @@ mkAvsQuery _ _ _ = AvsQuery
] ]
fakeStatus _ = AvsResponseStatus mempty fakeStatus _ = AvsResponseStatus mempty
fakeContact :: AvsQueryContact -> AvsResponseContact fakeContact :: AvsQueryContact -> AvsResponseContact
fakeContact (AvsQueryContact (Set.toList -> ((AvsObjPersonId api):_))) = AvsResponseContact $ Set.singleton $ AvsDataContact api (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Fraport AG" 7 "Fraport" Nothing Nothing Nothing Nothing Nothing Nothing Nothing) fakeContact (AvsQueryContact (Set.toList -> ((AvsObjPersonId api):_))) = AvsResponseContact $ Set.singleton $ AvsDataContact api (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing (Just "jost@tcs.ifi.lmu.de") Nothing) (AvsFirmInfo "Fraport AG" 7 "Fraport" Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
fakeContact _ = AvsResponseContact mempty fakeContact _ = AvsResponseContact mempty
#else #else
mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery

6
src/Utils/DB.hs
View File

@ -337,6 +337,12 @@ instance WithRunDB backend m (ReaderT backend m) where
-- A datatype for a specific heterogeneous list to compute DB updates, consisting of a persistent record field and a fitting lens -- A datatype for a specific heterogeneous list to compute DB updates, consisting of a persistent record field and a fitting lens
data CheckUpdate record iraw = forall typ. (Eq typ, PersistField typ) => CheckUpdate (EntityField record typ) (Getting typ iraw typ) -- A persistent record field and fitting getting data CheckUpdate record iraw = forall typ. (Eq typ, PersistField typ) => CheckUpdate (EntityField record typ) (Getting typ iraw typ) -- A persistent record field and fitting getting
mayUpdate :: PersistEntity record => record -> Maybe iraw -> CheckUpdate record iraw -> Bool
mayUpdate ent (Just old) (CheckUpdate up l)
| let oldval = old ^. l
, let entval = ent ^. fieldLensVal up
= oldval == entval
mayUpdate _ _ _ = False
-- | Compute necessary updates. Given a database record, the new and old raw data, and a pair consisting of a getter from raw data to a value and an EntityField of the same value, -- | Compute necessary updates. Given a database record, the new and old raw data, and a pair consisting of a getter from raw data to a value and an EntityField of the same value,
-- an update is returned, if the current value is identical to the old value, which changed in the new raw data -- an update is returned, if the current value is identical to the old value, which changed in the new raw data

10
templates/profileData.hamlet
View File

@ -30,12 +30,12 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<dd .deflist__dd> <dd .deflist__dd>
^{formatTimeW SelFormatDateTime (view _userAvsLastSynch avs)} ^{formatTimeW SelFormatDateTime (view _userAvsLastSynch avs)}
<dt .deflist__dt> <dt .deflist__dt>
_{MsgNameSet} _{MsgNameSet} ^{usrAutomatic UserDisplayName}
<dd .deflist__dd> <dd .deflist__dd>
^{nameWidget userDisplayName userSurname} ^{nameWidget userDisplayName userSurname}
$maybe matnr <- userMatrikelnummer $maybe matnr <- userMatrikelnummer
<dt .deflist__dt> <dt .deflist__dt>
_{MsgTableMatrikelNr} _{MsgTableMatrikelNr} ^{usrAutomatic UserMatrikelnummer}
<dd .deflist__dd> <dd .deflist__dd>
^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)} ^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)}
$maybe sex <- userSex $maybe sex <- userSex
@ -45,7 +45,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{sex} _{sex}
$maybe bday <- userBirthday $maybe bday <- userBirthday
<dt .deflist__dt> <dt .deflist__dt>
_{MsgTableBirthday} _{MsgTableBirthday} ^{usrAutomatic UserBirthday}
<dd .deflist__dd> <dd .deflist__dd>
^{formatTimeW SelFormatDate bday} ^{formatTimeW SelFormatDate bday}
<dt .deflist__dt> <dt .deflist__dt>
@ -96,7 +96,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{telephonenr} #{telephonenr}
$maybe mobilenr <- userMobile $maybe mobilenr <- userMobile
<dt .deflist__dt> <dt .deflist__dt>
_{MsgUserMobile} _{MsgUserMobile} ^{usrAutomatic UserMobile}
<dd .deflist__dd> <dd .deflist__dd>
#{mobilenr} #{mobilenr}
$maybe companyDepartment <- userCompanyDepartment $maybe companyDepartment <- userCompanyDepartment
@ -106,7 +106,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{companyDepartment} #{companyDepartment}
$maybe companyPersonalNumber <- userCompanyPersonalNumber $maybe companyPersonalNumber <- userCompanyPersonalNumber
<dt .deflist__dt> <dt .deflist__dt>
_{MsgCompanyPersonalNumber} _{MsgCompanyPersonalNumber} ^{usrAutomatic UserCompanyPersonalNumber}
<dd .deflist__dd> <dd .deflist__dd>
#{companyPersonalNumber} #{companyPersonalNumber}
$maybe compWgt <- companies $maybe compWgt <- companies