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

Merge branch 'fradrive/cr3'

Browse Source
This commit is contained in:
Steffen Jost 2024-06-10 18:42:46 +02:00
commit ab2e81f34d
24 changed files with 240 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,8 +4,8 @@
#messages or constructors that are used all over the code
Logo !ident-ok: Uni2work
EmailInvitationWarning: Diese Adresse konnte keinem Uni2work-Benutzer/keiner Uni2work-Benutzerin zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
Logo !ident-ok: FRADrive
EmailInvitationWarning: Diese Adresse konnte keinem FRADrive-Benutzer/-Benutzerin zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
BoolIrrelevant !ident-ok: —
FieldPrimary: Hauptfach
FieldSecondary: Nebenfach
@ -15,6 +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.
ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv

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

@ -4,8 +4,8 @@
#messages or constructors that are used all over the Code
Logo: Uni2work
EmailInvitationWarning: This address could not be matched to any Uni2work user. An invitation will be sent via email.
Logo: FRADrive
EmailInvitationWarning: This address could not be matched to any FRADrive user. An invitation will be sent via email.
BoolIrrelevant: —
FieldPrimary: Major
FieldSecondary: Minor
@ -15,6 +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.
ClusterVolatileQuickActionsEnabled: Quick actions enabled

13
models/company.model
View File

@ -11,15 +11,8 @@ Company
prefersPostal Bool default=false -- new company users prefers letters by post instead of email
postAddress StoredMarkup Maybe -- default company postal address, including company name
email UserEmail Maybe -- Case-insensitive generic company eMail address
UniqueCompanyName name
-- UniqueCompanyName name -- Should be Unique in AVS, but we do not yet need to enforce it
-- UniqueCompanyShorthand shorthand -- unnecessary, since it is the primary key already
UniqueCompanyAvsId avsId
Primary shorthand -- newtype Key Company = CompanyKey { unCompanyKey :: CompanyShorthand }
UniqueCompanyAvsId avsId -- Should be the key, is not for historical reasons and for convenience in URLs and columns
Primary shorthand -- newtype Key Company = CompanyKey { unCompanyKey :: CompanyShorthand }
deriving Ord Eq Show Generic Binary
-- -- TODO: a way to populate this table (manually)
-- CompanySynonym
-- synonym CompanyName
-- canonical CompanyShorthand OnDeleteCascade OnUpdateCascade -- DEPRECATED: should be CompanyId
-- UniqueCompanySynonym synonym
-- deriving Ord Eq Show Generic

49
src/Handler/Admin/Avs.hs
View File

@ -93,7 +93,7 @@ validateAvsQueryPerson = do
is _Just avsPersonQueryInternalPersonalNo ||
is _Just avsPersonQueryVersionNo
makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
makeAvsStatusForm :: Maybe AvsPersonId -> Form AvsQueryStatus
makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html ->
flip (renderAForm FormStandard) html $
parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl)
@ -103,15 +103,15 @@ makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateA
where
nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt
ids = mapMaybe readMay nonemptys
unparseAvsIds :: AvsQueryStatus -> Text
unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
unparseAvsIds :: AvsPersonId -> Text
unparseAvsIds = tshow . avsPersonId
validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler ()
validateAvsQueryStatus = do
AvsQueryStatus ids <- State.get
guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids)
makeAvsContactForm :: Maybe AvsQueryContact -> Form AvsQueryContact
makeAvsContactForm :: Maybe AvsPersonId -> Form AvsQueryContact
makeAvsContactForm tmpl = identifyForm FIDAvsQueryContact . validateForm validateAvsQueryContact $ \html ->
flip (renderAForm FormStandard) html $
parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) -- consider using cfAnySeparatedSet here
@ -121,8 +121,9 @@ makeAvsContactForm tmpl = identifyForm FIDAvsQueryContact . validateForm validat
where
nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt
ids = mapMaybe (fmap AvsObjPersonId . readMay) nonemptys
unparseAvsIds :: AvsQueryContact -> Text
unparseAvsIds (AvsQueryContact ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
unparseAvsIds :: AvsPersonId -> Text
unparseAvsIds = tshow . avsPersonId
--unparseAvsIds (AvsQueryContact ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
validateAvsQueryContact :: FormValidator AvsQueryContact Handler ()
validateAvsQueryContact = do
@ -161,19 +162,26 @@ postAdminAvsR = do
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
let procFormPerson fr = do
let procFormPerson :: AvsQueryPerson -> Handler (Maybe (Maybe Widget, Maybe AvsPersonId))
procFormPerson fr = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
tryShow $ do
AvsResponsePerson pns <- avsQuery fr
return [whamlet|
<ul>
$forall p <- pns
<li>^{jsonWidget p}
|] -- <li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
mbPerson <- formResultMaybe presult (Just <<$>> procFormPerson)
((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
let procFormStatus fr = do
try (avsQuery fr) >>= \case
Left err -> return $ Just (Just $ exceptionWgt err, Nothing)
Right (AvsResponsePerson pns) -> do
let mapid = case Set.toList pns of
[AvsDataPerson{avsPersonPersonID=apid}] -> Just apid
_ -> Nothing
wgt = [whamlet|
<ul>
$forall p <- pns
<li>^{jsonWidget p}
|] -- <li>#{decodeUtf8 (Pretty.encodePretty (toJSON p))}
return $ Just (toMaybe (notNull pns) wgt, mapid)
(mbPerson,mapid) <- fromMaybe (Nothing,Nothing) <$> formResultMaybe presult procFormPerson
((sresult', swidget), senctype) <- runFormPost $ makeAvsStatusForm mapid
let sresult = sresult' <|> maybe FormMissing (FormSuccess . AvsQueryStatus . Set.singleton) mapid -- use unique AvsId from PersonSearch for convenience, if form was empty
procFormStatus fr = do
addMessage Info $ text2Html $ "Status Query: " <> tshow (toJSON fr)
tryShow $ do
AvsResponseStatus pns <- avsQuery fr
@ -184,8 +192,9 @@ postAdminAvsR = do
|]
mbStatus <- formResultMaybe sresult (Just <<$>> procFormStatus)
((cresult, cwidget), cenctype) <- runFormPost $ makeAvsContactForm Nothing
let procFormContact fr = do
((cresult', cwidget), cenctype) <- runFormPost $ makeAvsContactForm mapid
let cresult = cresult' <|> maybe FormMissing (FormSuccess . AvsQueryContact . Set.singleton . AvsObjPersonId) mapid -- use unique AvsId from PersonSearch for convenience, if form was empty
procFormContact fr = do
addMessage Info $ text2Html $ "Contact Query: " <> tshow (toJSON fr)
tryShow $ do
AvsResponseContact pns <- avsQuery fr

4
src/Handler/LMS.hs
View File

@ -440,7 +440,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
dbtSQLQuery = lmsTableQuery now qid
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjSimple $ \(qualUsr, usr, lmsUsr, qUsrBlock, printAcks, validQ) -> do
cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Asc UserCompanyCompany]
cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Desc UserCompanyPriority, Asc UserCompanyCompany, LimitTo 1]
return (qualUsr, usr, lmsUsr, qUsrBlock, printAcks, cmpUsr, validQ)
dbtColonnade = cols cmpMap
dbtSorting = mconcat
@ -619,7 +619,7 @@ postLmsR sid qsh = do
[ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
, colUserNameModalHdrAdmin MsgLmsUser AdminUserR
, colUserEmail
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) ->
let cs = [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap

17
src/Handler/Profile.hs
View File

@ -21,6 +21,7 @@ import Import
import Handler.Utils
import Handler.Utils.Profile
import Handler.Utils.Users
import Handler.Utils.Company
import Utils.Print (validCmdArgument)
@ -587,9 +588,7 @@ makeProfileData :: Entity User -> DB Widget
makeProfileData usrEnt@(Entity uid User{..}) = do
now <- liftIO getCurrentTime
avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
(actualPrefersPostal, actualPostAddress, actualDisplayEmail) <- getPostalPreferenceAndAddress' usrEnt
let postalAutomatic = isJust actualPostAddress && isNothing userPostAddress -- address is either from company or department
emailAutomatic = isJust actualDisplayEmail && not (validEmail' userDisplayEmail)
(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
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
@ -601,14 +600,7 @@ makeProfileData usrEnt@(Entity uid User{..}) = do
E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
return (studyfeat, studydegree, studyterms)
companies' <- E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)] -- E.desc (usrComp E.^. UserCompanySupervisor),
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
let companies = intersperse (text2markup ", ") $
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
icnSuper = text2markup " " <> icon IconSupervisor
companies <- wgtCompanies uid
supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
@ -644,8 +636,7 @@ makeProfileData usrEnt@(Entity uid User{..}) = do
mCRoute <- getCurrentRoute
showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)
tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId
tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress
tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress
let profileRemarks = $(i18nWidgetFile "profile-remarks")
return $(widgetFile "profileData")

4
src/Handler/Qualification.hs
View File

@ -378,7 +378,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
-- E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val (entityKey usr)
-- E.orderBy [E.asc (comp E.^. CompanyName)]
-- return (comp E.^. CompanyName, comp E.^. CompanyAvsId, usrComp E.^. UserCompanySupervisor)
cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Asc UserCompanyCompany]
cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Desc UserCompanyPriority, Asc UserCompanyCompany, LimitTo 1]
return (qualUsr, usr, lmsUsr, qUsrBlock, cmpUsr)
dbtColonnade = cols cmpMap
dbtSorting = mconcat
@ -578,7 +578,7 @@ postQualificationR sid qsh = do
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
, colUserNameModalHdr MsgLmsUser linkUserName
, colUserEmail
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) ->
let cs = [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap

19
src/Handler/Users.hs
View File

@ -17,6 +17,7 @@ import Handler.Utils
import Handler.Utils.Users
import Handler.Utils.Invitations
import Handler.Utils.Avs
import Handler.Utils.Company
import qualified Auth.LDAP as Auth
@ -107,19 +108,11 @@ postUsersR = do
(AdminUserR <$> encrypt uid)
(nameWidget userDisplayName userSurname)
, sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = entUsr } -> cellHasMatrikelnummerLinkedAdmin entUsr
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
let icnSuper = toWidget $ text2markup " " <> icon IconSupervisor
companies =
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmUsersR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
pure $ intercalate (text2widget "; ") companies
-- , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
-- (AdminUserR <$> encrypt uid)
-- (toWgt userCompanyPersonalNumber)
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
maybeMonoid <$> wgtCompanies uid
, sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
(AdminUserR <$> encrypt uid)
(toWgt userCompanyPersonalNumber)
, sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyPersonalNumber
, sortable (Just "company-department") (i18nCell MsgCompanyDepartment) $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyDepartment
-- , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM

10
src/Handler/Utils.hs
View File

@ -190,4 +190,12 @@ msgAdminProblem AdminProblemSupervisorLeftCompany{adminProblemCompany=comp, admi
msgAdminProblem AdminProblemNewlyUnsupervised{adminProblemCompanyOld=comp, adminProblemCompanyNew=newComp} = return $
SomeMessages [SomeMessage MsgAdminProblemNewlyUnsupervised, text2message ": ", maybe (text2message "???") company2msg comp, text2message " -> ", company2msg newComp]
msgAdminProblem AdminProblemUnknown{adminProblemText=err} = return $
someMessages ["Problem: ", err]
someMessages ["Problem: ", err]
updateAutomatic :: Bool -> Widget
-- updateAutomatic = iconTooltip [whamlet|_{MsgNoAutomaticUpdateTip}|] (Just IconLocked)
updateAutomatic True = mempty
updateAutomatic False = do
msg <- messageIconI Warning IconLocked MsgNoAutomaticUpdateTip
messageTooltip msg

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

@ -340,17 +340,25 @@ updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMa
, 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
]
em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo $
CheckUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe im AvsInfo, aber nicht im User
em_f_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
CheckUpdate UserDisplayEmail $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
eml_up = em_p_up <|> em_f_up -- ensure that only one email update is produced; there is no Eq instance for the Update type
frm_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
CheckUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
pin_up = mkUpdate' usr newAvsCardNo oldAvsCardNo $ -- Maybe update PDF pin to latest card
, 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
]
apiEmail = _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI
afiEmail = _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
em_p_up = mkUpdate' usr newAvsPersonInfo oldAvsPersonInfo $ CheckUpdate UserDisplayEmail apiEmail -- Maybe im AvsInfo, aber nicht im User
em_f_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ CheckUpdate UserDisplayEmail afiEmail -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
eml_up -- Ensure that only one email update is produced; there is no Eq instance for the Update type
| isJust em_f_up, mempty == newAvsFirmInfo ^. afiEmail -- Was some FirmEmail, but this is no longer the case; update to PersonalEmail, if possible
= mkUpdate' usr newAvsPersonInfo Nothing $ CheckUpdate UserDisplayEmail apiEmail
| isJust em_f_up -- Update FirmEmail
= em_f_up
| isJust em_p_up, mempty == newAvsPersonInfo ^. apiEmail -- Was PersonalEmai, but this is no longer the case; update to FirmEmail, if possible
= mkUpdate' usr newAvsFirmInfo Nothing $ CheckUpdate UserDisplayEmail afiEmail
| otherwise -- Maybe update PersonalEmail
= em_p_up
frm_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
CheckUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
pin_up = mkUpdate' usr newAvsCardNo oldAvsCardNo $ -- Maybe update PDF pin to latest card
CheckUpdate UserPinPassword $ to $ fmap avsFullCardNo2pin -- _Just . to avsFullCardNo2pin . re _Just
usr_up1 = eml_up `mcons` (frm_up `mcons` (pin_up `mcons` per_ups))
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
@ -557,16 +565,18 @@ repsertSuperiorSupervisor cid afi uid =
-- | Query DB from given AvsFirmInfo. Guarantees that all Uniqueness-Constraints are checked. Highly unlikely that Nothing is returned, since all AvsResponseContact always contains an AvsFirmInfo
getAvsCompany :: AvsFirmInfo -> DB (Maybe (Entity Company))
getAvsCompany afi =
let compName :: CompanyName
let compName :: CompanyName
compName = afi ^. _avsFirmFirm . from _CI
compShorthand :: CompanyShorthand
compShorthand = afi ^. _avsFirmAbbreviation . from _CI
compAvsId = afi ^. _avsFirmFirmNo
in firstJustM $
bcons (compAvsId > 0)
( getBy $ UniqueCompanyAvsId compAvsId )
[ getBy $ UniqueCompanyName compName
, getEntity $ CompanyKey compShorthand
in firstJustM $ -- legacy treatment, only use UniqueCompnayAvsId in the future
guardMonoid (compAvsId > 0)
[ getBy $ UniqueCompanyAvsId compAvsId
, getEntity $ CompanyKey $ compShorthand <> "-" <> ciShow compAvsId
] <>
[ getByFilter [CompanyName ==. compName]
, getEntity $ CompanyKey compShorthand
]
-- | insert a company from AVS firm info or update an existing one based on previous values
@ -575,17 +585,20 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
mbFirmEnt <- getAvsCompany newAvsFirmInfo -- primarily by AvsId, then Shorthand, then name
$logInfoS "AVS" [st|upsertAvsCompany: old #{tshow mbFirmEnt} new #{tshow newAvsFirmInfo}|]
case (mbFirmEnt, mbOldAvsFirmInfo) of
(Nothing, _) -> do -- insert new company, neither AvsId, Shorthand or Name are known to exist
let upd = flip updateRecord newAvsFirmInfo
(Nothing, _) -> do -- insert new company, neither AvsId nor Shorthand exist in DB
afn <- if 0 < newAvsFirmInfo ^. _avsFirmFirmNo
then return $ newAvsFirmInfo ^. _avsFirmFirmNo
else maybe (-1) (pred . companyAvsId . entityVal) <$> selectMaybe [CompanyAvsId <. 0] [Asc CompanyAvsId]
let upd = flip updateRecord newAvsFirmInfo
dmy = Company -- mostly dummy, values are actually prodcued through firmInfo2company below for consistency
{ companyName = newAvsFirmInfo ^. _avsFirmFirm . from _CI
, companyShorthand = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI
, companyAvsId = newAvsFirmInfo ^. _avsFirmFirmNo
, companyAvsId = afn
, companyPrefersPostal = True
, companyPostAddress = newAvsFirmInfo ^. _avsFirmPostAddress
, companyEmail = newAvsFirmInfo ^? _avsFirmPrimaryEmail . _Just . from _CI
}
cmp = foldl' upd dmy $ firmInfo2key : firmInfo2companyUniques <> firmInfo2company
cmp = foldl' upd dmy $ firmInfo2key : firmInfo2companyNo : firmInfo2company
$logInfoS "AVS" $ "Insert new company: " <> tshow cmp
newCmp <- insertEntity cmp
reportAdminProblem $ AdminProblemNewCompany $ entityKey newCmp
@ -595,30 +608,33 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
(Just Entity{entityKey=firmid, entityVal=firm}, oldAvsFirmInfo) -> do -- possibly update existing company, if isJust oldAvsFirmInfo and changed occurred
let cmp_ups = mapMaybe (mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2company
key_ups = mkUpdate' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2key
uniq_ups <- maybeMapM (mkUpdateCheckUnique' firm newAvsFirmInfo oldAvsFirmInfo) firmInfo2companyUniques
$logInfoS "AVS" [st|Update company #{companyShorthand firm}: #{tshow (length cmp_ups)}, #{tshow (length key_ups)}, #{tshow (length uniq_ups)} for #{tshow newAvsFirmInfo}|]
res_cmp <- updateGetEntity firmid $ cmp_ups <> uniq_ups
case key_ups of
Nothing -> do
$logInfoS "AVS" "Update new company completed."
return res_cmp
Just key_up -> do
let compId = res_cmp ^. _entityVal . _companyAvsId
uniq_cmp = if compId > 0 then UniqueCompanyAvsId compId
else UniqueCompanyName $ res_cmp ^. _entityVal . _companyName
updateBy uniq_cmp [key_up] -- this is ok, since we have OnUpdateCascade on all CompanyId entries
$logInfoS "AVS" "Update new company completed."
maybeM (return res_cmp) return $ getBy uniq_cmp
uniq_ups <- mkUpdateCheckUnique' firm newAvsFirmInfo oldAvsFirmInfo firmInfo2companyNo
$logInfoS "AVS" [st|Update company #{companyShorthand firm}: #{tshow (length cmp_ups)}, #{tshow (length key_ups)}, #{tshow (length uniq_ups)} for #{tshow oldAvsFirmInfo}|]
res_cmp <- updateGetEntity firmid $ mcons uniq_ups cmp_ups
let cmp_id = res_cmp ^. _entityVal . _companyAvsId
res_cmp2 <- case key_ups of
Just key_up | cmp_id > 0 -> do
$logInfoS "AVS" $ "Updating CompanyShorthand from " <> ciOriginal (companyShorthand firm) <> " to " <> avsFirmAbbreviation newAvsFirmInfo <> " for AvsNo " <> tshow cmp_id
let uniq_cmp = UniqueCompanyAvsId cmp_id
cmp_key = newAvsFirmInfo ^. _avsFirmAbbreviation . from _CI
alt_key = cmp_key <> "-" <> ciShow cmp_id
key_ok <- notExists [CompanyShorthand ==. cmp_key]
alt_ok <- notExists [CompanyShorthand ==. alt_key]
if | key_ok -> updateBy uniq_cmp [key_up] -- this is ok, since we have OnUpdateCascade on all CompanyId entries
| alt_ok -> updateBy uniq_cmp [CompanyShorthand =. alt_key]
| otherwise -> $logInfoS "AVS" $ "Update company shorthand failed for " <> ciOriginal cmp_key <> " and " <> ciOriginal alt_key
maybeM (return res_cmp) return $ getBy uniq_cmp
_otherwise -> return res_cmp
$logInfoS "AVS" "Update company completed."
return res_cmp2
where
firmInfo2key =
CheckUpdate CompanyShorthand $ _avsFirmAbbreviation . from _CI -- Updating primary key works in principle thanks to OnUpdateCascade, but fails due to update get
firmInfo2companyUniques =
[ CheckUpdate CompanyName $ _avsFirmFirm . from _CI -- Updating unique turned out to be problematic, who would have thought!
, CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating unique turned out to be problematic, who would have thought!
]
firmInfo2companyNo =
CheckUpdate CompanyAvsId _avsFirmFirmNo -- Updating a unique needs special considerations; AVS does not update FirmNo, but for legacy reasons we might have companies without a number
firmInfo2company =
[ CheckUpdate CompanyPostAddress _avsFirmPostAddress
[ CheckUpdate CompanyName $ _avsFirmFirm . from _CI
, CheckUpdate CompanyPostAddress _avsFirmPostAddress
, CheckUpdate CompanyEmail $ _avsFirmPrimaryEmail . _Just . from _CI . re _Just
-- , CheckUpdate CompanyPrefersPostal _avsFirmPrefersPostal -- Guessing here is not useful, since postal preference is ignored anyway when there is only one option available
]

30
src/Handler/Utils/Company.hs
View File

@ -13,17 +13,43 @@ import Import
-- import qualified Data.Text as Text
import Database.Persist.Postgresql
-- import Database.Esqueleto.Experimental ((:&)(..))
import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.PostgreSQL as E
import Handler.Utils.Users
import Handler.Utils.Widgets
company2msg :: CompanyId -> SomeMessage UniWorX
company2msg = text2message . ciOriginal . unCompanyKey
wgtCompanies :: UserId -> DB (Maybe Widget)
wgtCompanies = \uid -> do
companies <- E.select $ do
(usrComp :& comp) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @Company
`E.on` (\(usrComp :& comp) -> usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId)
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor, usrComp E.^. UserCompanyPriority)
let (mPri, topCmp, otherCmp) = procCmp mPri companies
resWgt =
[whamlet|
$forall c <- topCmp
<p>
^{c}
$forall c <- otherCmp
<p>
#{c}
|]
return $ toMaybe (notNull topCmp) resWgt
where
procCmp _ [] = (0, [],[])
procCmp maxPri ((E.Value cmpSh, E.Value cmpName, E.Value cmpSpr, E.Value cmpPrio) : cs) =
let cmpWgt = companyWidget (cmpSh, cmpName, cmpSpr)
isTop = cmpPrio >= maxPri
(accPri,accTop,accRem) = procCmp maxPri cs
in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpName : accRem) accRem isTop) -- lazy evaluation after repmin example
-- TODO: use this function in company view Handler.Firm #157
-- | add all company supervisors for a given users

5
src/Handler/Utils/Table/Cells.hs
View File

@ -356,10 +356,11 @@ courseCell Course{..} = anchorCell link name `mappend` desc
^{modal "Beschreibung" (Right $ toWidget descr)}
|]
-- also see Handler.Utils.Widgets.companyWidget
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
companyCell csh cname isSupervisor = anchorCell link name
companyCell csh cname isSupervisor = anchorCell curl name
where
link = FirmUsersR csh
curl = FirmUsersR csh
corg = ciOriginal cname
name
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor

43
src/Handler/Utils/Users.hs
View File

@ -18,6 +18,7 @@ module Handler.Utils.Users
, getUserPrimaryCompany, getUserPrimaryCompanyAddress
, getUserEmail
, getEmailAddress, getJustEmailAddress
, getUserEmailAutomatic
, getEmailAddressFor, getJustEmailAddressFor
, getPostalAddress, getPostalAddress'
, getPostalPreferenceAndAddress, getPostalPreferenceAndAddress'
@ -102,13 +103,13 @@ getPostalPreferenceAndAddress usr = do
-- | result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
-- primed variant returns storedMarkup without prefixed userDisplayName
getPostalPreferenceAndAddress' :: Entity User -> DB (Bool, Maybe StoredMarkup, Maybe UserEmail)
getPostalPreferenceAndAddress' :: Entity User -> DB (Bool, (Maybe StoredMarkup, Bool), (Maybe UserEmail, Bool))
getPostalPreferenceAndAddress' usr = do
pa <- getPostalAddress' usr
em <- getUserEmail usr
pa <- getPostalAddress' usr
em <- getUserEmailAutomatic usr
let usrPrefPost = usr ^. _entityVal . _userPrefersPostal
finalPref = (usrPrefPost && isJust pa) || isNothing em
-- finalPref = isJust pa && (usrPrefPost || isNothing em)
finalPref = (usrPrefPost && isJust (fst pa)) || isNothing (fst em)
-- finalPref = isJust (fst pa) && (usrPrefPost || isNothing (fst em))
return (finalPref, pa, em)
getEmailAddressFor :: UserId -> DB (Maybe Address)
@ -133,6 +134,21 @@ getUserEmail Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail}}
compEmailMb <- getUserPrimaryCompanyAddress uid companyEmail
return $ pickValidEmail' $ mcons compEmailMb [userEmail]
-- like `getUserEmail`, but also checks whether the Email will be update automatically
getUserEmailAutomatic :: Entity User -> DB (Maybe UserEmail, Bool)
getUserEmailAutomatic Entity{entityKey=uid, entityVal=User{userDisplayEmail, userEmail}}
| validEmail' userDisplayEmail
= do
muavs <- getBy $ UniqueUserAvsUser uid
let auto = userDisplayEmail == muavs ^. _Just . _userAvsLastFirmInfo . _Just . _avsFirmPrimaryEmail . _Just . from _CI -- Recall: _Just on Nothing yields mempty here
|| userDisplayEmail == muavs ^. _Just . _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail . _Just . from _CI
return (Just userDisplayEmail, auto)
| otherwise
= getUserPrimaryCompanyAddress uid companyEmail >>= \case
Just compEmail | validEmail' compEmail -> return (Just compEmail, True )
Nothing | validEmail' userEmail -> return (Just userEmail, False)
_ -> return (Nothing , False)
-- address is prefixed with userDisplayName
getPostalAddress :: Entity User -> DB (Maybe [Text])
getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
@ -151,22 +167,25 @@ getPostalAddress Entity{entityKey=uid, entityVal=User{..}}
where
prefixMarkupName = return . Just . (userDisplayName :) . html2textlines
-- primed variant returns storedMarkup without prefixed userDisplayName
getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup)
-- primed variant returns storedMarkup without prefixed userDisplayName and whether updates are automatic
getPostalAddress' :: Entity User -> DB (Maybe StoredMarkup, Bool)
getPostalAddress' Entity{entityKey=uid, entityVal=User{..}}
| res@(Just _) <- userPostAddress
= return res
| res@(Just upo) <- userPostAddress
= do
muavs <- getBy $ UniqueUserAvsUser uid
let auto = upo == muavs ^. _Just . _userAvsLastFirmInfo . _Just . _avsFirmPostAddress . _Just -- Recall: _Just on Nothing yields mempty here
return (res, auto)
| otherwise
= do
getUserPrimaryCompanyAddress uid companyPostAddress >>= \case
res@(Just _)
-> return res
-> return (res, True)
Nothing
| Just abt <- userCompanyDepartment
-> return $ Just $ plaintextToStoredMarkup $ textUnlines $
-> return $ (,True) $ Just $ plaintextToStoredMarkup $ textUnlines $
if | "BVD" `isPrefixOf` abt -> [userDisplayName, abt, "Bodenverkehrsdienste"]
| otherwise -> [userDisplayName, abt, "Hausbriefkasten" ]
| otherwise -> return Nothing
| otherwise -> return (Nothing, True)
-- | Consider using Handler.Utils.Avs.updateReceivers instead
-- Return Entity User and all Supervisors with rerouteNotifications as well as

15
src/Handler/Utils/Widgets.hs
View File

@ -14,6 +14,7 @@ import Handler.Utils.DateTime
import qualified Data.Char as Char
import qualified Data.HashMap.Strict as Aeson -- ON UPDATE replace with: import qualified Data.Aeson.KeyMap as Aeson
import Data.Scientific
---------
-- Simple utilities for consistent display
@ -131,6 +132,16 @@ modalAccess wdgtNo wdgtYes writeAccess route = do
then modal wdgtYes (Left $ SomeRoute route)
else wdgtNo
-- also see Handler.Utils.Table.Cells.companyCell
companyWidget :: (CompanyShorthand, CompanyName, Bool) -> Widget
companyWidget (csh, cname, isSupervisor) = simpleLink (toWgt name) curl
where
curl = FirmUsersR csh
corg = ciOriginal cname
name
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
| otherwise = text2markup corg
----------
-- HEAT --
----------
@ -253,7 +264,9 @@ jsonWidget x = jsonWidgetAux $ toJSON x
jsonWidgetAux Null = [whamlet|Null|]
jsonWidgetAux (Bool b) = toWidget $ boolSymbol b
jsonWidgetAux (String s) = [whamlet|#{s}|]
jsonWidgetAux (Number n) = [whamlet|#{show n}|]
jsonWidgetAux (Number n)
| isInteger n = [whamlet|#{formatScientific Fixed (Just 0) n}|]
| otherwise = [whamlet|#{formatScientific Generic Nothing n}|]
jsonWidgetAux (Array l)
| 1 >= length l = foldMap jsonWidgetAux l -- empty arrays don't show
| otherwise =

4
src/Utils.hs
View File

@ -710,6 +710,10 @@ bcons :: Bool -> a -> [a] -> [a]
bcons False _ = id
bcons True x = (x:)
bsnoc :: Bool -> a -> [a] -> [a]
bsnoc False _ xs = xs
bsnoc True x xs = xs ++ [x]
-- | Merge/Add any attribute-value pair to an existing list of such pairs.
-- If the attribute exists, the new valu will be prepended, separated by a single empty space
insertAttr :: Text -> Text -> [(Text,Text)] -> [(Text,Text)]

2
src/Utils/Avs.hs
View File

@ -102,7 +102,7 @@ mkAvsQuery _ _ _ = AvsQuery
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00006666"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00007777"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00008888"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
_ -> AvsResponsePerson mempty
_ -> AvsResponsePerson steffen
fakeStatus :: AvsQueryStatus -> AvsResponseStatus
fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList

5
src/Utils/DB.hs
View File

@ -82,6 +82,9 @@ getEntity404 :: (PersistStoreRead backend, PersistRecordBackend record backend,
=> Key record -> ReaderT backend m (Entity record)
getEntity404 k = Entity k <$> get404 k
notExists :: (PersistRecordBackend record backend, PersistQueryRead backend, MonadIO m) => [Filter record] -> ReaderT backend m Bool
notExists = fmap not . exists
existsBy :: (PersistRecordBackend record backend, PersistUniqueRead backend, MonadIO m)
=> Unique record -> ReaderT backend m Bool
existsBy = fmap (is _Just) . getKeyBy
@ -108,6 +111,7 @@ existsKey404 :: (PersistRecordBackend record backend, PersistQueryRead backend,
existsKey404 = bool notFound (return ()) <=< existsKey
-- | given filter criteria like `selectList` this function returns Just if and only if there is precisely one result
-- getByPeseudoUnique
getByFilter :: (PersistRecordBackend record backend, PersistQueryRead backend, MonadIO m)
=> [Filter record] -> ReaderT backend m (Maybe (Entity record))
getByFilter crit =
@ -368,7 +372,6 @@ updateRecord ent new (CheckUpdate up l) =
-- | like mkUpdate' but only returns the update if the new value would be unique
-- mkUpdateCheckUnique' :: PersistEntity record => record -> iraw -> Maybe iraw -> CheckUpdate record iraw -> DB (Maybe (Update record))
mkUpdateCheckUnique' :: (MonadIO m, PersistQueryRead backend, PersistEntity record, PersistEntityBackend record ~ BaseBackend backend)
=> record -> a -> Maybe a -> CheckUpdate record a -> ReaderT backend m (Maybe (Update record))

13
src/Utils/Icon.hs
View File

@ -118,7 +118,7 @@ data Icon
| IconCompany
| IconEdit
| IconUserEdit
| IconMagic -- indicates automatic updates
-- | IconMagic -- indicates automatic updates
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
deriving anyclass (Universe, Finite, NFData)
@ -215,7 +215,7 @@ iconText = \case
IconCompany -> "building"
IconEdit -> "edit"
IconUserEdit -> "user-edit"
IconMagic -> "wand-magic"
-- IconMagic -> "wand-magic"
nullaryPathPiece ''Icon $ camelToPathPiece' 1
deriveLift ''Icon
@ -298,10 +298,11 @@ isNew :: Bool -> Markup
isNew True = icon IconNew
isNew False = mempty
-- ^ Maybe display an icon that denotes that something™ is automagically updated or derived
isAutomatic :: Bool -> Markup
isAutomatic True = icon IconMagic
isAutomatic False = mempty
-- DEPRECATED by Handler.Utils.updateAutomatic, which includes a helpful tooltip
-- Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited
-- isAutomatic :: Bool -> Markup
-- isAutomatic True = mempty -- icon IconMagic
-- isAutomatic False = icon IconLocked -- IconEdit
boolSymbol :: Bool -> Markup
boolSymbol True = icon IconOK

4
templates/avs.hamlet
View File

@ -44,6 +44,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<p>
Unverarbeitete Antwort: #
^{answer}
$maybe apid <- mapid
<p>
Einzelne erhaltene AVS PersonId #{show apid} wurde auch gleich
in die Status und Contact Abfragen eingesetzt.
<section>
<p>

16
templates/i18n/profile-remarks/de-de-formal.hamlet
View File

@ -7,21 +7,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>Hinweise
<ul>
<li>
Sichern Sie bitte Ihre Daten! Die Uni2work Datenbank wird täglich gesichert;
dennoch können wir Probleme noch nicht gänzlich ausschließen.
<li>
Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc.
<li>
<p>
Sie können die
<a href=@{HelpR}>
Löschung Ihre Daten über eine Supportanfrage beantragen
. Ihre Daten werden dann nach Ablauf einer Frist gelöscht.
Daten, welche keiner gesetzlichen Aufbewahrungsfrist unterliegen
(z.B. Klausurnoten) verbleiben im System bis zur Ablauf der Aufbewahrungsfrist.
Löschung Ihrer Daten über eine Supportanfrage beantragen
. Ihre Daten werden dann nach Ablauf einer Frist gelöscht.
Daten, welche keiner gesetzlichen Aufbewahrungsfrist unterliegen
verbleiben im System bis zur Ablauf der Aufbewahrungsfrist.
<p>
Benutzerdaten bleiben prinzipiell so lange gespeichert,
bis ein Bereichsadministrator über die Exmatrikulation informiert wurde.
Dann wird der Account mit einer angemessenen zeitverzögerung gelöscht.
Benutzerdaten bleiben prinzipiell so lange gespeichert,
bis der Account nach einer angemessenen Zeitverzögerung nach Ablauf aller Qualifikation automatisch gelöscht wurde.
Anonymisierte Prüfungsnoten verbleiben aus statistischen Gründen dauerhaft im System.

16
templates/i18n/profile-remarks/en-eu.hamlet
View File

@ -7,9 +7,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>Remarks
<ul>
<li>
Back up your data! Uni2work's database is backed up daily but we can
nontheless not guarantee that there will be no problems.
<li>
Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here.
<li>
@ -18,12 +15,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<a href=@{HelpR}>
a support request
.
Your data will then be deleted after a suitable time period has passed.
Data that falls under legal retention periods (e.g. exam results) remian
Your data will then be deleted after a suitable time period has passed.
Data that falls under legal retention periods remain
in the system until their retention period has passed.
<p>
User data remains in the system (in principle) until a department
administrator has been informed of exmatriculation.
After a suitable time period has passed the account is deleted.
Anonymised exam results remain in the system indefinitely for
statistical purposes.
User data remains in the system until
a suitable time period has passed after the expiry all qualifications and the account is automatically deleted.
Anonymised online exam results remain in the system indefinitely for
statistical purposes.

4
templates/letter/din5008with_pin_new.latex
View File

@ -162,7 +162,7 @@ $endif$
\opening{$en-opening$}
$endif$
\begin{textblock}{65}(84,232)%hpos,vpos
\begin{textblock}{65}(92,236)%hpos,vpos Werte in mm
\textcolor{black!39}{
\begin{labeling}{Password:}%Achtung! Die Position des Logins muss sprachunabhängig immer an der gleichen Position sein, sonst kannn die Rückmeldung der Druckerei den Ident nicht mehr identifizieren!
$if(is-de)$
@ -192,7 +192,7 @@ $endif$
$endif$
$if(notice)$
\begin{textblock}{170}(20,258)%hpos,vpos
\begin{textblock}{170}(20,262)%hpos,vpos Werte in mm
\scriptsize
\textbf{Hinweise für den Schulungsteilnehmer:}
\newline

4
templates/letter/fraport_renewal_new.md
View File

@ -13,10 +13,10 @@ de-opening: Liebe Fahrberechtigungsinhaber,
en-opening: Dear driver,
de-closing: |
Mit freundlichen Grüßen,
Ihre Fraport Fahrerausbildung
Ihre Fahrerausbildung
en-closing: |
With kind regards,
Your Fraport Driver Training
Your Driver Training
encludes:
hyperrefoptions: hidelinks

20
templates/profileData.hamlet
View File

@ -37,7 +37,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<dt .deflist__dt>
_{MsgTableMatrikelNr}
<dd .deflist__dd>
#{matnr}
^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)}
$maybe sex <- userSex
<dt .deflist__dt>
_{MsgTableSex}
@ -56,9 +56,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
#{iconLetterOrEmail userPrefersPostal}
$maybe addr <- actualPostAddress
<dt .deflist__dt>
_{MsgAdminUserPostAddress}
<dd .deflist__dd>
#{isAutomatic postalAutomatic} #
_{MsgAdminUserPostAddress} #
^{updateAutomatic postalAutomatic}
<dd .deflist__dd>
#{addr}
$if (not postalAutomatic)
$maybe postUpdate <- userPostLastUpdate
@ -67,11 +67,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<dd .deflist__dd>
^{formatTimeW SelFormatDateTime postUpdate}
<dt .deflist__dt>
_{MsgUserDisplayEmail}
_{MsgUserDisplayEmail} #
^{updateAutomatic emailAutomatic}
<dd .deflist__dd .email>
$maybe primaryEmail <- actualDisplayEmail
#{isAutomatic emailAutomatic} #
#{mailtoHtml primaryEmail}
$maybe primaryEmail <- actualDisplayEmail
#{mailtoHtml primaryEmail}
$nothing
^{messageTooltip tooltipInvalidEmail} #
#{mailtoHtml userDisplayEmail}
@ -109,11 +109,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgCompanyPersonalNumber}
<dd .deflist__dd>
#{companyPersonalNumber}
$if not $ null companies
$maybe compWgt <- companies
<dt .deflist__dt>
_{MsgCompany}
<dd .deflist__dd>
^{toWgt (mconcat companies)}
^{compWgt}
$if numSupervisors > 0
<dt .deflist__dt>_{MsgProfileSupervisor}
$if numSupervisors > 3