feat(qualfications): renewal actions and filtering by card and personal number
This commit is contained in:
parent
bb2c0858d1
commit
4df024374d
@ -86,6 +86,7 @@ QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung un
|
||||
QualificationActBlockSupervisor: Dauerhaft entziehen und Ansprechpartner entfernen, mit sofortiger Wirkung
|
||||
QualificationActBlock: Entziehen
|
||||
QualificationActUnblock: Entzug löschen
|
||||
QualificationActRenew: Qualifikation regulär verlängern
|
||||
QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} entzogen
|
||||
QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert
|
||||
LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
|
||||
|
||||
@ -86,6 +86,7 @@ QualificationSetUnexpire n: Expiry notification and e‑learning activated for #
|
||||
QualificationActBlockSupervisor: Waive permanently and remove all supervisiors, effective immediately
|
||||
QualificationActBlock: Revoke
|
||||
QualificationActUnblock: Clear revocation
|
||||
QualificationActRenew: Renew Qualification
|
||||
QualificationStatusBlock l n m: #{n}/#{m} #{l} revoked
|
||||
QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated
|
||||
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter.
|
||||
|
||||
@ -253,21 +253,30 @@ data QualificationTableAction
|
||||
| QualificationActBlockSupervisor
|
||||
| QualificationActBlock
|
||||
| QualificationActUnblock
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
| QualificationActRenew
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
|
||||
instance Universe QualificationTableAction
|
||||
instance Finite QualificationTableAction
|
||||
nullaryPathPiece ''QualificationTableAction $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''QualificationTableAction id
|
||||
|
||||
-- Not yet needed, since there is no additional data for now:
|
||||
{-
|
||||
isAdminAct :: QualificationTableAction -> Bool
|
||||
isAdminAct QualificationActExpire = False
|
||||
isAdminAct QualificationActUnexpire = False
|
||||
isAdminAct QualificationActBlockSupervisor = False
|
||||
isAdminAct _ = True
|
||||
-}
|
||||
|
||||
data QualificationTableActionData
|
||||
= QualificationActExpireData
|
||||
| QualificationActUnexpireData
|
||||
| QualificationActBlockSupervisorData
|
||||
| QualificationActBlockData { qualTableActBlockReason :: Text}
|
||||
| QualificationActBlockData { qualTableActBlockReason :: Text}
|
||||
| QualificationActUnblockData
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
| QualificationActRenewData
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
isExpiryAct :: QualificationTableActionData -> Bool
|
||||
isExpiryAct QualificationActExpireData = True
|
||||
@ -356,15 +365,17 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
|
||||
E.&&. ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
|
||||
(E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) ))
|
||||
, single ("user-company", FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
|
||||
(E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
|
||||
testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
|
||||
testcrit = maybe testname testnumber $ readMay $ CI.original criterion
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
||||
)
|
||||
, single ("avs-card" , FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \(usrAvs `E.InnerJoin` avsCard) -> do
|
||||
E.on $ usrAvs E.^. UserAvsPersonId E.==. avsCard E.^. UserAvsCardPersonId
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
|
||||
E.&&. ((E.explicitUnsafeCoerceSqlExprValue "citext" (avsCard E.^. UserAvsCardCardNo) :: E.SqlExpr (E.Value (CI Text)))
|
||||
`E.hasInfix` (E.val criterion :: E.SqlExpr (E.Value (CI Text))))
|
||||
)
|
||||
, single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
|
||||
| Set.null criteria -> E.true
|
||||
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
||||
)
|
||||
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification nowaday))
|
||||
, single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
|
||||
if | Just renewal <- mbRenewal
|
||||
@ -375,8 +386,10 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
|
||||
, prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo)
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
|
||||
, if isNothing mbRenewal then mempty
|
||||
else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
|
||||
@ -460,10 +473,11 @@ postQualificationR sid qsh = do
|
||||
[ singletonMap QualificationActExpire $ pure QualificationActExpireData
|
||||
, singletonMap QualificationActUnexpire $ pure QualificationActUnexpireData
|
||||
] ++ bool
|
||||
[ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ] -- nonAdmin Supervisor
|
||||
[ singletonMap QualificationActUnblock $ pure QualificationActUnblockData
|
||||
[ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ] -- nonAdmin actions, ie. Supervisor
|
||||
[ singletonMap QualificationActUnblock $ pure QualificationActUnblockData -- Admin-only actions
|
||||
, singletonMap QualificationActBlock $ QualificationActBlockData
|
||||
<$> apreq textField (fslI MsgQualificationBlockReason) Nothing
|
||||
, singletonMap QualificationActRenew $ pure QualificationActRenewData
|
||||
] isAdmin
|
||||
linkLmsUser = toMaybe isAdmin LmsUserR
|
||||
linkUserName = bool ForProfileR ForProfileDataR isAdmin
|
||||
@ -471,18 +485,8 @@ postQualificationR sid qsh = do
|
||||
colChoices cmpMap = mconcat
|
||||
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
|
||||
, colUserNameModalHdr MsgLmsUser linkUserName
|
||||
, colUserEmail
|
||||
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view $ resultUser . _entityKey -> 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.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let companies = intercalate (text2markup ", ") $
|
||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
pure $ toWgt companies
|
||||
, sortable (Just "company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
|
||||
, colUserEmail
|
||||
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
|
||||
let icnSuper = text2markup " " <> icon IconSupervisor
|
||||
cs = [ (cmpName, cmpSpr)
|
||||
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
|
||||
@ -509,7 +513,11 @@ postQualificationR sid qsh = do
|
||||
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
||||
return (tbl, qent)
|
||||
|
||||
formResult lmsRes $ \case
|
||||
formResult lmsRes $ \case
|
||||
(QualificationActRenewData, selectedUsers) | isAdmin -> do
|
||||
noks <- runDB $ renewValidQualificationUsers qid $ Set.toList selectedUsers
|
||||
addMessageI (if noks > 0 && noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
|
||||
reloadKeepGetParams $ QualificationR sid qsh
|
||||
(action, selectedUsers) | isExpiryAct action -> do
|
||||
let isUnexpire = action == QualificationActUnexpireData
|
||||
upd <- runDB $ updateWhereCount
|
||||
|
||||
@ -163,7 +163,7 @@ fillDb = do
|
||||
, userAuthentication = pwSimple
|
||||
, userLastAuthentication = Nothing
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userMatrikelnummer = Just "94094094094"
|
||||
, userMatrikelnummer = Just "12345678"
|
||||
, userEmail = "S.Jost@Fraport.de"
|
||||
, userDisplayEmail = "jost@tcs.ifi.lmu.de"
|
||||
, userDisplayName = "Steffen Jost"
|
||||
@ -680,6 +680,10 @@ fillDb = do
|
||||
void . insert' $ UserAvs (AvsPersonId 4) sbarth 4
|
||||
void . insert' $ UserAvs (AvsPersonId 5) fhamann 5
|
||||
void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77
|
||||
void . insert' $ UserAvsCard (AvsPersonId 12345678) (AvsFullCardNo (AvsCardNo "1234") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "1234") "4") now
|
||||
void . insert' $ UserAvsCard (AvsPersonId 2) (AvsFullCardNo (AvsCardNo "3344") "1") (AvsDataPersonCard True Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "3344") "1") now
|
||||
void . insert' $ UserAvsCard (AvsPersonId 3) (AvsFullCardNo (AvsCardNo "7788") "1") (AvsDataPersonCard False Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "7788") "1") now
|
||||
void . insert' $ UserAvsCard (AvsPersonId 4) (AvsFullCardNo (AvsCardNo "9999") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "9999") "4") now
|
||||
|
||||
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
|
||||
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user