fraport/fradrive
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
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
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

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

@ -15,7 +15,7 @@ WeekDay: Day of the week
LdapIdentificationOrEmail: Fraport AG-Kennung / email address
Months num: #{num} #{pluralEN num "Month" "Months"}
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

6
src/Handler/Profile.hs
View File

@ -588,9 +588,11 @@ getForProfileDataR cID = do
dataWidget
makeProfileData :: Entity User -> DB Widget
makeProfileData usrEnt@(Entity uid User{..}) = do
now <- liftIO getCurrentTime
makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
now <- liftIO getCurrentTime
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
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

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

@ -31,6 +31,7 @@ module Handler.Utils.Avs
-- CR3
, SomeAvsQuery(..)
, queryAvsCardNo, queryAvsCardNos
, userPersonUpd
) where
import Import
@ -323,6 +324,40 @@ updateAvsUserByIds' apids = do
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 apid newAvsPersonInfo newAvsFirmInfo) = runMaybeT $ do
(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 UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
]
let per_ups = mapMaybe (mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo)
[ CheckUpdate UserFirstName _avsInfoFirstName
, CheckUpdate UserSurname _avsInfoLastName
, CheckUpdate UserDisplayName _avsInfoDisplayName
, CheckUpdate UserBirthday _avsInfoDateOfBirth
, CheckUpdate UserMobile _avsInfoPersonMobilePhoneNo
, CheckUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
-- , CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups above
let per_ups = mapMaybe (mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo) $ catMaybes
[ userPersonUpd UserFirstName
, userPersonUpd UserSurname
, userPersonUpd UserDisplayName
, userPersonUpd UserBirthday
, userPersonUpd UserMobile
, userPersonUpd UserMatrikelnummer
-- , userPersonUpd UserCompanyPersonalNumber -- needs special treatment, see ldap_ups above
]
apiEmail = _avsInfoPersonEMail . 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 =
let
sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) 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
sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) 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
sumpfi1 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 12345678) mempty
sumpfi2 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty
sumpfi3 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604591) mempty
@ -112,7 +112,7 @@ mkAvsQuery _ _ _ = AvsQuery
]
fakeStatus _ = AvsResponseStatus mempty
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
#else
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
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,
-- 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>
^{formatTimeW SelFormatDateTime (view _userAvsLastSynch avs)}
<dt .deflist__dt>
_{MsgNameSet}
_{MsgNameSet} ^{usrAutomatic UserDisplayName}
<dd .deflist__dd>
^{nameWidget userDisplayName userSurname}
$maybe matnr <- userMatrikelnummer
<dt .deflist__dt>
_{MsgTableMatrikelNr}
_{MsgTableMatrikelNr} ^{usrAutomatic UserMatrikelnummer}
<dd .deflist__dd>
^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)}
$maybe sex <- userSex
@ -45,7 +45,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{sex}
$maybe bday <- userBirthday
<dt .deflist__dt>
_{MsgTableBirthday}
_{MsgTableBirthday} ^{usrAutomatic UserBirthday}
<dd .deflist__dd>
^{formatTimeW SelFormatDate bday}
<dt .deflist__dt>
@ -96,7 +96,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{telephonenr}
$maybe mobilenr <- userMobile
<dt .deflist__dt>
_{MsgUserMobile}
_{MsgUserMobile} ^{usrAutomatic UserMobile}
<dd .deflist__dd>
#{mobilenr}
$maybe companyDepartment <- userCompanyDepartment
@ -106,7 +106,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{companyDepartment}
$maybe companyPersonalNumber <- userCompanyPersonalNumber
<dt .deflist__dt>
_{MsgCompanyPersonalNumber}
_{MsgCompanyPersonalNumber} ^{usrAutomatic UserCompanyPersonalNumber}
<dd .deflist__dd>
#{companyPersonalNumber}
$maybe compWgt <- companies