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

chore(avs): set qu-renewal flag; tutorial add space separated

Browse Source
This commit is contained in:
Steffen Jost 2023-02-01 18:00:53 +01:00
parent 086e49e2ae
commit e9eeaca229
14 changed files with 48 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/avs/de-de-formal.msg
View File

@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer
AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
LicenceTableChangeAvs: Im AVS ändern
LicenceTableGrantFDrive: In FRADrive erteilen
LicenceTableRevokeFDrive: In FRADrive entziehen
LicenceTableRevokeFDrive: In FRADrive zum Vortag entziehen

2
messages/uniworx/categories/avs/en-eu.msg
View File

@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could
AvsCommunicationError: AVS interface returned an unexpected error.
LicenceTableChangeAvs: Change in AVS
LicenceTableGrantFDrive: Grant in FRADrive
LicenceTableRevokeFDrive: Revoke in FRADrive
LicenceTableRevokeFDrive: Revoke yesterday in FRADrive

2
messages/uniworx/categories/courses/courses/de-de-formal.msg
View File

@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Kursteilnehmer:innen hinzufügen
CourseParticipantsRegisterActionAddParticipants: Personen zum Kurs anmelden
CourseParticipantsRegisterActionAddTutorialMembers: Personen zu Kurs und Übungsgruppe anmelden
CourseParticipantsRegisterUsersField: Zum Kurs anzumeldende Personen
CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma getrennt angeben.
CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma oder Leerzeichen trennen.
CourseParticipantsRegisterTutorialOption: Kursteilnehmer:innen zu Übungsgruppe anmelden?
CourseParticipantsRegisterTutorialField: Übungsgruppe
CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Übungsgruppe mit diesem Namen vorhanden, wird eine neue erstellt. Ist bereits eine Übungsgruppe mit diesem Namen vorhanden, werden die Kursteilnehmenden dieser hinzugefügt.

2
messages/uniworx/categories/courses/courses/en-eu.msg
View File

@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Add course participants
CourseParticipantsRegisterActionAddParticipants: Add course participants
CourseParticipantsRegisterActionAddTutorialMembers: Add course and tutorial participants
CourseParticipantsRegisterUsersField: Persons to register for course
CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with commas.
CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with comma or space.
CourseParticipantsRegisterTutorialOption: Register course participants for tutorial?
CourseParticipantsRegisterTutorialField: Tutorial
CourseParticipantsRegisterTutorialFieldTip: If there is no tutorial with this name, a new one will be created. If there is a tutorial with this name, the course participants will be registered for it.

3
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -23,7 +23,8 @@ TableQualificationFirstHeld: Erstmalig
TableQualificationBlockedDue: Suspendiert
TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
TableQualificationNoRenewal: Storniert
TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versand, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
LmsUser: Inhaber
TableLmsEmail: E-Mail
TableLmsIdent: LMS Identifikation

1
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -24,6 +24,7 @@ TableQualificationBlockedDue: Suspended
TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
TableQualificationNoRenewal: Canceled
TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
QualificationUserNoRenewal: Expires without further notification
LmsUser: Licensee
TableLmsEmail: Email
TableLmsIdent: LMS Identifier

9
src/Audit/Types.hs
View File

@ -199,10 +199,11 @@ data Transaction
}
| TransactionQualificationUserEdit
{ transactionQualificationUser :: QualificationUserId
, transactionQualification :: QualificationId
, transactionUser :: UserId
, transactionQualificationValidUntil :: Day
{ transactionQualificationUser :: QualificationUserId
, transactionQualification :: QualificationId
, transactionUser :: UserId
, transactionQualificationValidUntil :: Day
, transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration)
}
| TransactionQualificationUserDelete
{ transactionQualificationUser :: QualificationUserId

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

@ -333,8 +333,9 @@ embedRenderMessage ''UniWorX ''LicenceTableAction id
data LicenceTableActionData = LicenceTableChangeAvsData
| LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
| LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
, licenceTableChangeFDriveEnd :: Day
| LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
, licenceTableChangeFDriveEnd :: Day
, licenceTableChangeFDriveRenew :: Maybe Bool
}
deriving (Eq, Ord, Read, Show, Generic)
@ -423,7 +424,7 @@ getProblemAvsSynchR = do
nups <- runDB $ do
qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
forM_ selectedUsers $ upsertQualificationUser qId nowaday $ pred nowaday
forM_ selectedUsers $ upsertQualificationUser qId nowaday (pred nowaday) Nothing
return $ length selectedUsers
addMessageI Success $ MsgRevokeFraDriveLicences alic nups
redirect ProblemAvsSynchR -- must be outside runDB
@ -433,7 +434,7 @@ getProblemAvsSynchR = do
uas <- selectList [UserAvsPersonId <-. Set.toList apids] []
let uids = view _userAvsUser <$> uas
-- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG
forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd
forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew
(length uids,) <$> get404 licenceTableChangeFDriveQId
addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
redirect ProblemAvsSynchR -- must be outside runDB
@ -577,6 +578,7 @@ mkLicenceTable PaginationParameters{..} dbtIdent aLic apids = do
else singletonMap LicenceTableGrantFDrive $ LicenceTableGrantFDriveData
<$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
<*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!
<*> aopt (convertField not not (boolField . Just $ SomeMessage MsgBoolIrrelevant)) (fslI MsgQualificationUserNoRenewal) Nothing
]
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST

2
src/Handler/Course/ParticipantInvite.hs
View File

@ -143,7 +143,7 @@ postCAddUserR tid ssh csh = do
((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
auReqUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
auReqTutorial <- optionalActionW
( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting
( fslI MsgCourseParticipantsRegisterTutorialOption )

2
src/Handler/SAP.hs
View File

@ -57,7 +57,7 @@ instance ToNamedRecord SapUserTableCsv where
-- TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l
, readMay persNo > Just 0 -- filter E-accounts for SAP export
, readMay persNo > Just (0::Int) -- filter E-accounts for SAP export
, let res = SapUserTableCsv
{ csvSUTpersonalNummer = persNo
, csvSUTqualifikation = sapId

2
src/Handler/Tutorial/Users.hs
View File

@ -100,7 +100,7 @@ postTUsersR tid ssh csh tutn = do
(TutorialUserGrantQualificationData{..}, selectedUsers) -> do
-- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
today <- utctDay <$> liftIO getCurrentTime
runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil
runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserSendMailData{}, selectedUsers) -> do

4
src/Handler/Users.hs
View File

@ -188,10 +188,10 @@ postUsersR = do
acts = mconcat
[ singletonMap UserLdapSync $ pure UserLdapSyncData
, singletonMap UserAddSupervisor $ UserAddSupervisorData
<$> apopt (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
, singletonMap UserSetSupervisor $ UserSetSupervisorData
<$> apopt (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
, singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
]

22
src/Handler/Utils/Qualification.hs
View File

@ -11,23 +11,27 @@ module Handler.Utils.Qualification
import Import
upsertQualificationUser :: QualificationId -> Day -> Day -> UserId -> DB ()
upsertQualificationUser qualificationUserQualification today qualificationUserValidUntil qualificationUserUser = do
upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB ()
upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do
Entity quid _ <- upsert
QualificationUser
{ qualificationUserLastRefresh = today
, qualificationUserFirstHeld = today
{ qualificationUserFirstHeld = qualificationUserLastRefresh
, qualificationUserBlockedDue = Nothing
, qualificationUserScheduleRenewal = True
, qualificationUserScheduleRenewal = fromMaybe True mbScheduleRenewal
, ..
}
[ QualificationUserValidUntil =. qualificationUserValidUntil
, QualificationUserLastRefresh =. today
, QualificationUserBlockedDue =. Nothing
]
(
[ QualificationUserScheduleRenewal =. scheduleRenewal | Just scheduleRenewal <- [mbScheduleRenewal]
] ++
[ QualificationUserValidUntil =. qualificationUserValidUntil
, QualificationUserLastRefresh =. qualificationUserLastRefresh
, QualificationUserBlockedDue =. Nothing
]
)
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = qualificationUserValidUntil
, transactionQualificationScheduleRenewal = mbScheduleRenewal
}

12
src/Utils/Form.hs
View File

@ -22,6 +22,7 @@ import Utils.Lens
import Text.Blaze (Markup)
import qualified Text.Blaze.Internal as Blaze (null)
import qualified Data.Text as T
import qualified Data.Char as C
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
@ -849,6 +850,17 @@ cfCI = convertField CI.mk CI.original
cfCommaSeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.splitOn ",") (T.intercalate ", " . Set.toList)
cfAnySeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", " . Set.toList)
where anySeparator :: Char -> Bool
anySeparator c = C.isSeparator c || c == ',' || c == ';'
-- -- TODO: consider using package ordered-containers?
-- cfAnySeparatedList :: (Functor m) => Field m Text -> Field m [Text]
-- cfAnySeparatedList = guardField (not . null) . convertField (mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", ")
-- where anySeparator :: Char -> Bool
-- anySeparator c = C.isSeparator c || c == ',' || c == ';'
isoField :: Functor m => AnIso' a b -> Field m a -> Field m b
isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso)