chore(qualifications): use blocking mechanism (WIP)
This commit is contained in:
parent
8cc04c8e11
commit
09c4eb3a7b
@ -22,10 +22,11 @@ AvsImportAmbiguous n@Int: Import für #{show n} uneindeutige AVS IDs fehlgeschla
|
||||
AvsImportUnknowns n@Int: Import für #{show n} unbekannte AVS IDs fehlgeschlagen
|
||||
AvsSetLicences alic@AvsLicence n@Int m@Int: _{alic} im AVS gesetzt: #{show n}/#{show m}
|
||||
SetFraDriveLicences q@String n@Int: #{q} in FRADrive gewährt für #{show n} Benutzer
|
||||
RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive zum Vortag beendet für #{show n} Fahrer
|
||||
RevokeFraDriveLicencesError alic@AvsLicence: Entzug der _{alic} Lizenzen komplett fehlgeschlagen
|
||||
RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive entzogen für #{show n} Fahrer
|
||||
RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt
|
||||
RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer konnten entzogen werden, siehe Log für Details
|
||||
AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
|
||||
LicenceTableChangeAvs: Im AVS ändern
|
||||
LicenceTableGrantFDrive: In FRADrive erteilen
|
||||
LicenceTableRevokeFDrive: In FRADrive zum Vortag entziehen
|
||||
LicenceTableRevokeFDrive: In FRADrive entziehen
|
||||
@ -22,10 +22,11 @@ AvsImportAmbiguous n@Int: Import failed for #{show n} ambiguous AVS Ids
|
||||
AvsImportUnknowns n@Int: Import failed for #{show n} unknown AVS Ids
|
||||
AvsSetLicences alic n m: _{alic} set in AVS: #{show n}/#{show m}
|
||||
SetFraDriveLicences q@String n@Int: #{q} granted in FRADrive for #{show n} users
|
||||
RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} now ended yesterday in FRADrive for #{show n} drivers
|
||||
RevokeFraDriveLicencesError alic@AvsLicence: Revoking licences _{alic} failed entirely
|
||||
RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} revoked in FRADrive for #{show n} drivers
|
||||
RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked
|
||||
RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could be revoked, see log for details
|
||||
AvsCommunicationError: AVS interface returned an unexpected error.
|
||||
LicenceTableChangeAvs: Change in AVS
|
||||
LicenceTableGrantFDrive: Grant in FRADrive
|
||||
LicenceTableRevokeFDrive: Revoke yesterday in FRADrive
|
||||
LicenceTableRevokeFDrive: Revoke in FRADrive
|
||||
|
||||
@ -20,13 +20,14 @@ TableQualificationSapExportTooltip: Wird die Qualifikation an das SAP übermitte
|
||||
LmsQualificationValidUntil: Gültig bis
|
||||
TableQualificationLastRefresh: Zuletzt erneuert
|
||||
TableQualificationFirstHeld: Erstmalig
|
||||
TableQualificationBlockedDue: Suspendiert
|
||||
TableQualificationBlockedDue: Entzogen
|
||||
TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
|
||||
TableQualificationBlockedTooltipSimple: Wann wurde die Qualifikation aus besonderem Grund wiederrufen?
|
||||
TableQualificationNoRenewal: Storniert
|
||||
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
|
||||
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
|
||||
QualificationBlockReason: Entzugsbegründung
|
||||
LmsUser: Inhaber
|
||||
TableLmsEmail: E-Mail
|
||||
TableLmsIdent: LMS Identifikation
|
||||
@ -70,10 +71,13 @@ MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort
|
||||
MailBodyQualificationRenewal qname@Text: Sie müssen die Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
|
||||
MailBodyQualificationExpiry: Diese Qualifikation läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
|
||||
MailBodyQualificationExpired: Diese Qualifikation is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Learning.
|
||||
QualificationActExpire: Qualifikation ohne Benachrichtigung auslaufen lassen
|
||||
QualificationActUnexpire: Benachrichtigung bei anstehender Erneuerung senden
|
||||
QualificationActExpire: Stornieren - Qualifikation läuft ohne Benachrichtigung ab
|
||||
QualificationActUnexpire: Stornierung aufheben - Benachrichtigung bei anstehender Erneuerung senden
|
||||
QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"}
|
||||
QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"}
|
||||
QualificationActBlockSupervisor: Dauerhaft zurückgeben
|
||||
QualificationActBlock: Entziehen
|
||||
QualificationActUnblock: Entzug löschen
|
||||
LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort Ihre Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
|
||||
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden.
|
||||
LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden
|
||||
|
||||
@ -20,13 +20,14 @@ TableQualificationSapExportTooltip: Is this qualification transmitted to SAP? On
|
||||
LmsQualificationValidUntil: Valid until
|
||||
TableQualificationLastRefresh: Last renewed
|
||||
TableQualificationFirstHeld: First held
|
||||
TableQualificationBlockedDue: Suspended
|
||||
TableQualificationBlockedDue: Revoked
|
||||
TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
|
||||
TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons?
|
||||
TableQualificationNoRenewal: Canceled
|
||||
TableQualificationNoRenewal: Cancelled
|
||||
TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
|
||||
QualificationUserNoRenewal: Expires without further notification
|
||||
QualificationUserNone: No registered qualifications for this person.
|
||||
QualificationBlockReason: Reason for revoking
|
||||
LmsUser: Licensee
|
||||
TableLmsEmail: Email
|
||||
TableLmsIdent: LMS Identifier
|
||||
@ -70,10 +71,13 @@ MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
|
||||
MailBodyQualificationRenewal qname: You will soon need to renew qualification #{qname} by completing an e-learning course. For details see attachment.
|
||||
MailBodyQualificationExpiry: This qualification expires soon. You may then no longer execute any duties that require this qualification as a precondition!
|
||||
MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning.
|
||||
QualificationActExpire: Qualification shall expire silently
|
||||
QualificationActUnexpire: Notify upon due renewal
|
||||
QualificationActExpire: Cancel - qualification expires silently
|
||||
QualificationActUnexpire: Uncancel - notify upon due renewal
|
||||
QualificationSetExpire n: Expiry notification and e-learning deactivated for #{n} #{pluralENs n "person"}
|
||||
QualificationSetUnexpire n: Expiry notification and e-learning activated for #{n} #{pluralENs n "person"}
|
||||
QualificationActBlockSupervisor: Waive permanently
|
||||
QualificationActBlock: Revoke
|
||||
QualificationActUnblock: Clear revocation
|
||||
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with your chosen FRADrive PDF-Password. If you have not yet chosen a PDF-Password yet, then the password is your Fraport id card number, inkluding the punctuation mark and the Digit thereafter.
|
||||
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
|
||||
LmsActNotify: Resend e-learning notification by post or email
|
||||
|
||||
@ -197,20 +197,24 @@ data Transaction
|
||||
, transactionNote :: Maybe Text
|
||||
, transactionReceived :: UTCTime -- when was the csv file received?
|
||||
}
|
||||
|
||||
| TransactionQualificationUserEdit
|
||||
{ transactionQualificationUser :: QualificationUserId
|
||||
, transactionQualification :: QualificationId
|
||||
, transactionUser :: UserId -- qualification holder that is updated
|
||||
| TransactionQualificationUserEdit -- Note that a renewal always entails unblocking as well!
|
||||
{ transactionUser :: UserId -- qualification holder that is updated
|
||||
, transactionQualificationUser :: QualificationUserId
|
||||
, transactionQualification :: QualificationId
|
||||
, transactionQualificationValidUntil :: Day
|
||||
, transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration)
|
||||
}
|
||||
| TransactionQualificationUserDelete
|
||||
{ transactionQualificationUser :: QualificationUserId
|
||||
, transactionQualification :: QualificationId
|
||||
, transactionUser :: UserId
|
||||
{ transactionUser :: UserId
|
||||
, transactionQualificationUser :: QualificationUserId
|
||||
, transactionQualification :: QualificationId
|
||||
}
|
||||
| TransactionQualificationUserBlocking
|
||||
{ transactionUser :: UserId -- qualification holder that is updated
|
||||
-- , transactionQualificationUser :: QualificationUserId -- not neccessary due to UniqueQualificationUser
|
||||
, transactionQualification :: QualificationId
|
||||
, transactionQualificationBlock :: Maybe QualificationBlocked -- Nothing indicates unblocking
|
||||
}
|
||||
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
|
||||
@ -309,11 +309,15 @@ nullaryPathPiece ''LicenceTableAction $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''LicenceTableAction id
|
||||
|
||||
data LicenceTableActionData = LicenceTableChangeAvsData
|
||||
| LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
|
||||
| LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
|
||||
, licenceTableChangeFDriveEnd :: Day
|
||||
, licenceTableChangeFDriveRenew :: Maybe Bool
|
||||
}
|
||||
| LicenceTableRevokeFDriveData
|
||||
{ licenceTableChangeFDriveQId :: QualificationId
|
||||
, licenceTableChangeFDriveReason :: Text
|
||||
}
|
||||
| LicenceTableGrantFDriveData
|
||||
{ licenceTableChangeFDriveQId :: QualificationId
|
||||
, licenceTableChangeFDriveEnd :: Day
|
||||
, licenceTableChangeFDriveRenew :: Maybe Bool
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
|
||||
@ -393,19 +397,26 @@ getProblemAvsSynchR = do
|
||||
addMessageI mkind $ MsgAvsSetLicences aLic oks no_req
|
||||
redirect ProblemAvsSynchR -- reload to update all tables
|
||||
|
||||
procRes alic (LicenceTableRevokeFDriveData, apids) = do
|
||||
nups <- runDB $ do
|
||||
procRes alic (LicenceTableRevokeFDriveData{..}, apids) = do
|
||||
oks <- runDB $ do
|
||||
qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
|
||||
selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
|
||||
forM_ selectedUsers $ upsertQualificationUser qId nowaday (pred nowaday) Nothing
|
||||
return $ length selectedUsers
|
||||
addMessageI Success $ MsgRevokeFraDriveLicences alic nups
|
||||
if qId /= licenceTableChangeFDriveQId
|
||||
then return (-1)
|
||||
else do
|
||||
uids <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
|
||||
qualificationUserBlocking licenceTableChangeFDriveQId uids $
|
||||
Just $ QualificationBlocked
|
||||
{ qualificationBlockedDay = nowaday
|
||||
, qualificationBlockedReason = licenceTableChangeFDriveReason
|
||||
}
|
||||
if | oks < 0 -> addMessageI Error $ MsgRevokeFraDriveLicencesError alic
|
||||
| oks == length apids -> addMessageI Success $ MsgRevokeFraDriveLicences alic oks
|
||||
| otherwise -> addMessageI Warning $ MsgRevokeFraDriveLicences alic oks
|
||||
redirect ProblemAvsSynchR -- must be outside runDB
|
||||
|
||||
procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do
|
||||
(n, Qualification{qualificationShorthand}) <- runDB $ do
|
||||
uas <- selectList [UserAvsPersonId <-. Set.toList apids] []
|
||||
let uids = view _userAvsUser <$> uas
|
||||
uids <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
|
||||
-- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG
|
||||
forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew
|
||||
(length uids,) <$> get404 licenceTableChangeFDriveQId
|
||||
@ -547,7 +558,9 @@ mkLicenceTable dbtIdent aLic apids = do
|
||||
acts = mconcat
|
||||
[ singletonMap LicenceTableChangeAvs $ pure LicenceTableChangeAvsData
|
||||
, if aLic == AvsNoLicence
|
||||
then singletonMap LicenceTableRevokeFDrive $ pure LicenceTableRevokeFDriveData
|
||||
then singletonMap LicenceTableRevokeFDrive $ LicenceTableRevokeFDriveData
|
||||
<$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
|
||||
<*> apreq textField (fslI MsgQualificationBlockReason) Nothing
|
||||
else singletonMap LicenceTableGrantFDrive $ LicenceTableGrantFDriveData
|
||||
<$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
|
||||
<*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!
|
||||
|
||||
@ -236,7 +236,12 @@ instance HasEntity QualificationTableData User where
|
||||
instance HasUser QualificationTableData where
|
||||
hasUser = resultUser . _entityVal
|
||||
|
||||
data QualificationTableAction = QualificationActExpire | QualificationActUnexpire
|
||||
data QualificationTableAction
|
||||
= QualificationActExpire
|
||||
| QualificationActUnexpire
|
||||
| QualificationActBlockSupervisor
|
||||
| QualificationActBlock
|
||||
| QualificationActUnblock
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
|
||||
instance Universe QualificationTableAction
|
||||
@ -245,12 +250,24 @@ nullaryPathPiece ''QualificationTableAction $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''QualificationTableAction id
|
||||
|
||||
-- Not yet needed, since there is no additional data for now:
|
||||
data QualificationTableActionData = QualificationActExpireData | QualificationActUnexpireData
|
||||
data QualificationTableActionData
|
||||
= QualificationActExpireData
|
||||
| QualificationActUnexpireData
|
||||
| QualificationActBlockSupervisorData
|
||||
| QualificationActBlockData { qualTableActBlockReason :: Text}
|
||||
| QualificationActUnblockData
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
isExpiryAct :: QualificationTableActionData -> Bool -- const true, but this may change in the future
|
||||
isExpiryAct :: QualificationTableActionData -> Bool
|
||||
isExpiryAct QualificationActExpireData = True
|
||||
isExpiryAct QualificationActUnexpireData = True
|
||||
isExpiryAct _ = False
|
||||
|
||||
isBlockAct :: QualificationTableActionData -> Bool
|
||||
isBlockAct QualificationActBlockSupervisorData = True
|
||||
isBlockAct QualificationActBlockData{} = True
|
||||
isBlockAct QualificationActUnblockData = True
|
||||
isBlockAct _ = False
|
||||
|
||||
qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr
|
||||
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
|
||||
@ -400,10 +417,15 @@ postQualificationR sid qsh = do
|
||||
((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
|
||||
qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
|
||||
acts = mconcat
|
||||
acts = mconcat $
|
||||
[ singletonMap QualificationActExpire $ pure QualificationActExpireData
|
||||
, singletonMap QualificationActUnexpire $ pure QualificationActUnexpireData
|
||||
]
|
||||
] ++ bool
|
||||
[ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ] -- nonAdmin Supervisor
|
||||
[ singletonMap QualificationActUnblock $ pure QualificationActUnblockData
|
||||
, singletonMap QualificationActBlock $ QualificationActBlockData
|
||||
<$> apreq textField (fslI MsgQualificationBlockReason) Nothing
|
||||
] isAdmin
|
||||
linkLmsUser = toMaybe isAdmin LmsUserR
|
||||
colChoices = mconcat
|
||||
[ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
|
||||
@ -426,6 +448,7 @@ postQualificationR sid qsh = do
|
||||
return (tbl, qent)
|
||||
|
||||
formResult lmsRes $ \case
|
||||
-- TODO: continue here
|
||||
_ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page for now
|
||||
(action, selectedUsers) | isExpiryAct action -> do
|
||||
let isUnexpire = action == QualificationActUnexpireData
|
||||
@ -436,7 +459,7 @@ postQualificationR sid qsh = do
|
||||
msgVal = upd & if isUnexpire then MsgQualificationSetUnexpire else MsgQualificationSetExpire
|
||||
addMessageI msgKind msgVal
|
||||
redirect currentRoute
|
||||
_ -> return ()
|
||||
_ -> addMessageI Error MsgUnauthorized -- TODO continue here
|
||||
|
||||
let heading = citext2widget $ qualificationName quali
|
||||
siteLayout heading $ do
|
||||
|
||||
@ -10,6 +10,7 @@ module Handler.Utils.Qualification
|
||||
import Import
|
||||
|
||||
-- import Data.Time.Calendar (CalendarDiffDays(..))
|
||||
import Database.Persist.Sql (updateWhereCount)
|
||||
import qualified Database.Esqueleto.Experimental as E -- might need TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
@ -100,4 +101,40 @@ renewValidQualificationUsers qid uids =
|
||||
, transactionQualificationScheduleRenewal = Nothing
|
||||
}
|
||||
return $ length quEnts
|
||||
_ -> return (-1) -- qualificationId not found, isNothing qualificationValidDuration, etc.
|
||||
_ -> return (-1) -- qualificationId not found, isNothing qualificationValidDuration, etc.
|
||||
|
||||
|
||||
-- qualificationUserBlocking :: QualificationId -> [UserId] -> Maybe QualificationBlocked -> DB Int64
|
||||
qualificationUserBlocking ::
|
||||
( AuthId (HandlerSite m) ~ Key User
|
||||
, IsPersistBackend (YesodPersistBackend (HandlerSite m))
|
||||
, BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
|
||||
, BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
|
||||
, PersistQueryWrite (YesodPersistBackend (HandlerSite m))
|
||||
, PersistUniqueWrite (YesodPersistBackend (HandlerSite m))
|
||||
, HasInstanceID (HandlerSite m) InstanceId
|
||||
, YesodAuthPersist (HandlerSite m)
|
||||
, HasAppSettings (HandlerSite m)
|
||||
, MonadHandler m
|
||||
, MonadCatch m
|
||||
, Num n
|
||||
) => QualificationId -> [UserId] -> Maybe QualificationBlocked -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
|
||||
|
||||
qualificationUserBlocking qid uids qb = do
|
||||
oks <- updateWhereCount -- prevents storage of transactionQualificatioUser
|
||||
( [ QualificationUserBlockedDue !=. Nothing | isNothing qb -- only unblock blocked qualification; allow overwrite for existing blocks
|
||||
] ++
|
||||
[ QualificationUserQualification ==. qid
|
||||
, QualificationUserUser <-. uids
|
||||
]
|
||||
)
|
||||
[ QualificationUserBlockedDue =. qb
|
||||
]
|
||||
forM_ uids $ \uid -> do
|
||||
audit TransactionQualificationUserBlocking
|
||||
{ -- transactionQualificationUser = quid
|
||||
transactionQualification = qid
|
||||
, transactionUser = uid
|
||||
, transactionQualificationBlock = qb
|
||||
}
|
||||
return $ fromIntegral oks
|
||||
@ -28,13 +28,11 @@ import qualified Data.Set as Set
|
||||
import qualified Data.Time.Zones as TZ
|
||||
import Handler.Utils.DateTime
|
||||
import Handler.Utils.LMS (randomLMSIdentBut, randomLMSpw, maxLmsUserIdentRetries)
|
||||
import Handler.Utils.Qualification
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
blockedByElearning :: Text
|
||||
blockedByElearning = "E-Learning durchgefallen"
|
||||
|
||||
dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX
|
||||
dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsEnqueue
|
||||
|
||||
@ -219,7 +217,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
|
||||
, QualificationUserLastRefresh =. lmsResultSuccess
|
||||
]
|
||||
-- WORKAROUND LMS-Bug: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
|
||||
when (Just blockedByElearning == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
|
||||
when (Just (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
|
||||
update quid [ QualificationUserBlockedDue =. Nothing ]
|
||||
update luid [ LmsUserStatus =. Just newStatus
|
||||
, LmsUserReceived =. Just lmsResultTimestamp
|
||||
@ -295,9 +293,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
|
||||
, transactionReceived = lReceived
|
||||
}
|
||||
update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
|
||||
updateBy (UniqueQualificationUser qid (lmsUserUser luser))
|
||||
[QualificationUserBlockedDue =. Just (QualificationBlocked { qualificationBlockedDay = blockedDay
|
||||
, qualificationBlockedReason = blockedByElearning } )]
|
||||
void $ qualificationUserBlocking qid [lmsUserUser luser] $ Just $ mkQualificationBlocked QualificationBlockFailedELearning blockedDay
|
||||
queueDBJob JobSendNotification
|
||||
{ jRecipient = lmsUserUser luser
|
||||
, jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = blockedDay }
|
||||
|
||||
@ -11,6 +11,8 @@ module Model.Types.Lms
|
||||
) where
|
||||
|
||||
import Import.NoModel
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map ((!))
|
||||
import Database.Persist.Sql
|
||||
import qualified Database.Esqueleto.Experimental as E
|
||||
import qualified Data.Csv as Csv
|
||||
@ -87,6 +89,25 @@ instance Csv.ToField QualificationBlocked where
|
||||
-- instance ToMessage QualificationBlocked where -- no longer used
|
||||
-- toMessage QualificationBlocked{..} = qualificationBlockedReason
|
||||
|
||||
data QualificationBlockStandardReason
|
||||
= QualificationBlockFailedELearning
|
||||
| QualificationBlockReturnedByCompany
|
||||
deriving (Eq, Ord, Enum, Bounded, Universe, Finite)
|
||||
|
||||
instance Show QualificationBlockStandardReason where
|
||||
show QualificationBlockFailedELearning = "E-Learning durchgefallen"
|
||||
show QualificationBlockReturnedByCompany = "Zurückgebeben durch Firma"
|
||||
|
||||
qualificationBlockedReasonText :: QualificationBlockStandardReason -> Text
|
||||
qualificationBlockedReasonText =
|
||||
let dictionary :: Map.Map QualificationBlockStandardReason Text = Map.fromList [(r, tshow r) | r <- universeF]
|
||||
in (dictionary !) -- cannot fail due to universeF
|
||||
|
||||
mkQualificationBlocked :: QualificationBlockStandardReason -> Day -> QualificationBlocked
|
||||
mkQualificationBlocked reason qualificationBlockedDay = QualificationBlocked{..}
|
||||
where
|
||||
qualificationBlockedReason = qualificationBlockedReasonText reason
|
||||
|
||||
-- | LMS interface requires Bool to be encoded by 0 or 1 only
|
||||
newtype LmsBool = LmsBool { lms2bool :: Bool }
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
@ -145,7 +145,7 @@ $endif$
|
||||
|
||||
\begin{textblock}{65}(84,232)%hpos,vpos
|
||||
\textcolor{black!39}{
|
||||
\begin{labeling}{Password:}
|
||||
\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)$
|
||||
\item[Benutzer:] \texttt{$login$}
|
||||
\item[Passwort:] \texttt{$pin$}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user