chore(admin): add problem overview on admin main page
This commit is contained in:
Steffen Jost
parent
baedd492d2
commit
2a98148993
@ -79,7 +79,7 @@ StudyFeatureInferenceNoNameConflicts: Keine Konflikte beobachtet
|
||||
StudyFeatureInferenceNameConflictsHeading: Studiengangseinträge mit beobachteten Konflikten
|
||||
|
||||
AdminHeading !ident-ok: Administration
|
||||
AdminPageEmpty: Diese Seite soll eine Übersichtsseite für Administrator:innen werden. Aktuell finden sich hier nur Links zu wichtigen Administrator-Funktionalitäten.
|
||||
|
||||
BearerTokenImpersonate: Auftreten als
|
||||
BearerTokenImpersonateNone: Keine Änderung
|
||||
BearerTokenImpersonateSingle: Einzelner Benutzer/Einzelne Benutzerin
|
||||
@ -94,3 +94,14 @@ BearerTokenArchiveName !ident-ok: tokens.zip
|
||||
TestDownloadDirect: Direkte Generierung
|
||||
TestDownloadInTransaction: Generierung während Datenbank-Transaktion
|
||||
TestDownloadFromDatabase: Generierung während Download aus Datenbank
|
||||
|
||||
ProblemsHeadingDrivers: Synchronisation Fahrberechtigungen mit Ausweisverwaltung
|
||||
ProblemsAvsProblem e@Text: Synchronisation mit AVS/MoBaKo komplett fehlgeschlagen: #{e}
|
||||
ProblemsDriverSynch0: Alle Sperrungen von Fahrberechtigungen sind im AVS eingetragen
|
||||
ProblemsDriverSynch1: Alle gültigen Vorfeld-Fahrberechtigungen 'F' sind im AVS eingetragen
|
||||
ProblemsDriverSynch2: Alle gültigen Rollfeld-Fahrberechtigungen 'R' sind im AVS eingetragen
|
||||
ProblemsRDriversHaveFs: Alle Inhaber einer Rollfeld-Fahrberechtigung besitzen auch eine gültige Vorfeld-Fahrberechtigung
|
||||
ProblemsDriversHaveAvsIds: Alle Inhaber einer Fahrberechtigung konnten einer AVS Identifikationsnummer zugeordnet werden
|
||||
ProblemsHeadingUsers: Allgemein
|
||||
ProblemsUsersAreReachable: Für alle Benutzer ist eine E-Mail oder postalische Adresse bekannt
|
||||
ProblemsNoStalePrintJobs n@Integer: Alle Briefversandaufträge der vergangenen #{show n} Tage wurden von der Druckerei bestätigt
|
||||
@ -79,7 +79,6 @@ StudyFeatureInferenceNoNameConflicts: No observed conflicts
|
||||
StudyFeatureInferenceNameConflictsHeading: Fields of study with observed conflicts
|
||||
|
||||
AdminHeading: Administration
|
||||
AdminPageEmpty: This page shall provide an overview for administrators in the future. For now there are only links to important administrator-functions.
|
||||
|
||||
BearerTokenImpersonate: Impersonate
|
||||
BearerTokenImpersonateNone: No one
|
||||
@ -95,3 +94,14 @@ BearerTokenArchiveName: tokens.zip
|
||||
TestDownloadDirect: Direct generation
|
||||
TestDownloadInTransaction: Generate during database transaction
|
||||
TestDownloadFromDatabase: Generate while streaming from database
|
||||
|
||||
ProblemsHeadingDrivers: Synchronisation of Driving Licences with Airport ID Card Center
|
||||
ProblemsAvsProblem e: Synchronisation with AVS/MoBaKo failed entirely: #{e}
|
||||
ProblemsDriverSynch0: All revocations of driving licences were successfully registered with AVS
|
||||
ProblemsDriverSynch1: All valid apron driving licences 'F' were successfully registered with AVS
|
||||
ProblemsDriverSynch2: All valid maneuvering area driving licences 'R' were successfully registered with AVS
|
||||
ProblemsRDriversHaveFs: All driving licence 'R' holders also have a valid 'F' licence
|
||||
ProblemsDriversHaveAvsIds: All driving licence holder could be matched with their AVS id
|
||||
ProblemsHeadingUsers: Miscellaneous
|
||||
ProblemsUsersAreReachable: Either Email or postal address is known for all users
|
||||
ProblemsNoStalePrintJobs n: All requests for letter mailing within the last #{show n} days were acknowledged as printed by the airport printing center
|
||||
@ -28,7 +28,7 @@ TermLectureStartTooltip: Muss am oder nach dem Beginn liegen
|
||||
TermLectureEndTooltip: Muss am oder vor dem Ende liegen
|
||||
TermActive: Aktiv
|
||||
TermActiveTooltip: Zeitraum in dem Lehrende Kurse anlegen dürfen; kann auf angegebene Lehrende eingeschränkt werden
|
||||
TermActiveForPlaceholder: Email (optional)
|
||||
TermActiveForPlaceholder: E-Mail (optional)
|
||||
NumCourses num@Int64: #{num} #{pluralDE num "Kurs" "Kurse"}
|
||||
TermsHeading: Semesterübersicht
|
||||
TermEditHeading: Semester editieren/anlegen
|
||||
|
||||
@ -28,7 +28,7 @@ TermLectureStartTooltip: Must be on or after starting day
|
||||
TermLectureEndTooltip: Must be before or on ending day
|
||||
TermActive: Active
|
||||
TermActiveTooltip: Timeframe when lecturers may add courses; maybe restricted for specified lecturers
|
||||
TermActiveForPlaceholder: E-Mail (optional)
|
||||
TermActiveForPlaceholder: Email (optional)
|
||||
NumCourses num: #{num} #{pluralEN num "course" "courses"}
|
||||
TermsHeading: Semesters
|
||||
TermEditHeading: Edit semester
|
||||
|
||||
@ -12,6 +12,9 @@ import Database.Esqueleto.Experimental ((:&)(..))
|
||||
import qualified Database.Esqueleto.Experimental as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Handler.Utils.DateTime
|
||||
import Handler.Utils.Avs
|
||||
|
||||
import Handler.Admin.Test as Handler.Admin
|
||||
import Handler.Admin.ErrorMessage as Handler.Admin
|
||||
import Handler.Admin.Tokens as Handler.Admin
|
||||
@ -22,78 +25,25 @@ import Handler.Admin.Ldap as Handler.Admin
|
||||
|
||||
getAdminR :: Handler Html
|
||||
getAdminR = do
|
||||
_userReachability <- runDB areAllUsersReachable
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
cutOffPrintDays = 7
|
||||
cutOffPrintJob = addLocalDays (-cutOffPrintDays) now
|
||||
(usersAreReachable, driversHaveAvsIds, rDriversHaveFs, noStalePrintJobs) <- runDB $ (,,,)
|
||||
<$> areAllUsersReachable
|
||||
<*> allDriversHaveAvsId nowaday
|
||||
<*> allRDriversHaveFs nowaday
|
||||
<*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated <=. cutOffPrintJob])
|
||||
diffLics <- try retrieveDifferingLicences <&> \case
|
||||
(Left e) -> Left $ tshow (e :: SomeException)
|
||||
(Right (to0, to1, to2)) -> Right (null to0, null to1, null to2)
|
||||
|
||||
siteLayoutMsg MsgAdminHeading $ do
|
||||
setTitleI MsgAdminHeading
|
||||
i18n MsgAdminPageEmpty
|
||||
-- TODO: use MessageStatus for colored icons; hide long AVS errormessage in modal; count avs differences instead of simple bool
|
||||
$(widgetFile "admin-problems")
|
||||
|
||||
|
||||
areAllUsersReachable :: DB Bool
|
||||
areAllUsersReachable = isNothing <$> E.selectOne getUnreachableUsers
|
||||
|
||||
getUnreachableUsers :: E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getUnreachableUsers = do
|
||||
user <- E.from $ E.table @User
|
||||
E.where_ $ E.isNothing (user E.^. UserPostAddress)
|
||||
E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%")
|
||||
return user
|
||||
|
||||
allDriversHaveAvsId :: DB Bool
|
||||
allDriversHaveAvsId = do
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
isNothing <$> E.selectOne (getDriversWithoutAvsId nowaday)
|
||||
|
||||
-- | Returns users more than once if they own multiple avs-related valid licences, but no AvsID is known
|
||||
getDriversWithoutAvsId :: Day -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getDriversWithoutAvsId nowaday = do
|
||||
(usr :& qualUsr :& qual) <- E.from $ E.table @User
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(usr :& qualUsr) -> usr E.^. UserId E.==. qualUsr E.^. QualificationUserUser)
|
||||
`E.innerJoin` E.table @Qualification
|
||||
`E.on` (\(_usr :& qualUsr :& qual) -> qual E.^. QualificationId E.==. qualUsr E.^. QualificationUserQualification)
|
||||
E.where_ $ -- is avs licence
|
||||
E.isJust (qual E.^. QualificationAvsLicence)
|
||||
E.&&. -- currently valid
|
||||
(E.val nowaday `E.between` ( qualUsr E.^. QualificationUserFirstHeld
|
||||
, qualUsr E.^. QualificationUserValidUntil))
|
||||
E.&&. -- not blocked
|
||||
E.isNothing (qualUsr E.^. QualificationUserBlockedDue)
|
||||
E.&&. -- AvsId is unknown
|
||||
E.notExists (do
|
||||
avsUsr <- E.from $ E.table @UserAvs
|
||||
E.where_ $ avsUsr E.^. UserAvsUser E.==. usr E.^. UserId
|
||||
)
|
||||
return usr
|
||||
|
||||
-- | Returns users at most once, even if they own multiple avs-related licences, but no AvsID is known
|
||||
getDriversWithoutAvsId' :: Day -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getDriversWithoutAvsId' nowaday = do
|
||||
usr <- E.from $ E.table @User
|
||||
E.where_ $
|
||||
E.exists (do -- a valid avs licence
|
||||
(qual :& qualUsr) <- E.from (E.table @Qualification
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(qual :& qualUsr) -> qual E.^. QualificationId E.==. qualUsr E.^. QualificationUserQualification))
|
||||
E.where_ $ -- is avs licence
|
||||
E.isJust (qual E.^. QualificationAvsLicence)
|
||||
E.&&. -- currently valid
|
||||
(E.val nowaday `E.between` ( qualUsr E.^. QualificationUserFirstHeld
|
||||
, qualUsr E.^. QualificationUserValidUntil))
|
||||
E.&&. -- not blocked
|
||||
E.isNothing (qualUsr E.^. QualificationUserBlockedDue)
|
||||
E.&&. -- matches user
|
||||
(qualUsr E.^. QualificationUserUser E.==. usr E.^. UserId)
|
||||
)
|
||||
E.&&.
|
||||
E.notExists (do -- a known AvsId
|
||||
avsUsr <- E.from $ E.table @UserAvs
|
||||
E.where_ $ avsUsr E.^. UserAvsUser E.==. usr E.^. UserId
|
||||
)
|
||||
return usr
|
||||
|
||||
{-
|
||||
mkUnreachableUsersTable = do
|
||||
let dbtSQLQuery user -> do
|
||||
@ -105,4 +55,85 @@ mkUnreachableUsersTable = do
|
||||
dbtColonnade =
|
||||
-}
|
||||
|
||||
|
||||
areAllUsersReachable :: DB Bool
|
||||
areAllUsersReachable = isNothing <$> E.selectOne getUnreachableUsers
|
||||
|
||||
getUnreachableUsers :: E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getUnreachableUsers = do
|
||||
user <- E.from $ E.table @User
|
||||
E.where_ $ E.isNothing (user E.^. UserPostAddress)
|
||||
E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%")
|
||||
return user
|
||||
|
||||
allDriversHaveAvsId :: Day -> DB Bool
|
||||
allDriversHaveAvsId = fmap isNothing . E.selectOne . getDriversWithoutAvsId
|
||||
|
||||
qIsValid :: E.SqlExpr (Entity QualificationUser) -> Day -> E.SqlExpr (E.Value Bool)
|
||||
qIsValid qualUsr nowaday =
|
||||
E.isNothing (qualUsr E.^. QualificationUserBlockedDue) -- not blocked
|
||||
E.&&. -- currently valid
|
||||
(E.val nowaday `E.between`
|
||||
( qualUsr E.^. QualificationUserFirstHeld
|
||||
, qualUsr E.^. QualificationUserValidUntil))
|
||||
|
||||
{-
|
||||
-- | Returns users more than once if they own multiple avs-related valid licences, but no AvsID is known
|
||||
getDriversWithoutAvsId' :: Day -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getDriversWithoutAvsId' nowaday = do
|
||||
(usr :& qualUsr :& qual) <- E.from $ E.table @User
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(usr :& qualUsr) -> usr E.^. UserId E.==. qualUsr E.^. QualificationUserUser)
|
||||
`E.innerJoin` E.table @Qualification
|
||||
`E.on` (\(_usr :& qualUsr :& qual) -> qual E.^. QualificationId E.==. qualUsr E.^. QualificationUserQualification)
|
||||
E.where_ $ -- is avs licence
|
||||
E.isJust (qual E.^. QualificationAvsLicence)
|
||||
E.&&. (qualUsr `qIsValid` nowaday)
|
||||
E.&&. -- AvsId is unknown
|
||||
E.notExists (do
|
||||
avsUsr <- E.from $ E.table @UserAvs
|
||||
E.where_ $ avsUsr E.^. UserAvsUser E.==. usr E.^. UserId
|
||||
)
|
||||
return usr
|
||||
-}
|
||||
|
||||
-- | Returns users at most once, even if they own multiple avs-related licences, but no AvsID is known
|
||||
getDriversWithoutAvsId :: Day -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getDriversWithoutAvsId nowaday = do
|
||||
usr <- E.from $ E.table @User
|
||||
E.where_ $
|
||||
E.exists (do -- a valid avs licence
|
||||
(qual :& qualUsr) <- E.from (E.table @Qualification
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(qual :& qualUsr) -> qual E.^. QualificationId E.==. qualUsr E.^. QualificationUserQualification))
|
||||
E.where_ $ -- is avs licence
|
||||
E.isJust (qual E.^. QualificationAvsLicence)
|
||||
E.&&. (qualUsr `qIsValid` nowaday) -- currently valid
|
||||
E.&&. -- matches user
|
||||
(qualUsr E.^. QualificationUserUser E.==. usr E.^. UserId)
|
||||
)
|
||||
E.&&.
|
||||
E.notExists (do -- a known AvsId
|
||||
avsUsr <- E.from $ E.table @UserAvs
|
||||
E.where_ $ avsUsr E.^. UserAvsUser E.==. usr E.^. UserId
|
||||
)
|
||||
return usr
|
||||
|
||||
|
||||
allRDriversHaveFs :: Day -> DB Bool
|
||||
allRDriversHaveFs = fmap isNothing . E.selectOne . getDriversRWithoutF
|
||||
|
||||
-- | Returns users at most once, even if they own multiple avs-related licences, but no AvsID is known
|
||||
getDriversRWithoutF :: Day -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
getDriversRWithoutF nowaday = do
|
||||
usr <- E.from $ E.table @User
|
||||
let hasValidQual lic = do
|
||||
(qual :& qualUsr) <- E.from (E.table @Qualification
|
||||
`E.innerJoin` E.table @QualificationUser
|
||||
`E.on` (\(qual :& qualUsr) -> qual E.^. QualificationId E.==. qualUsr E.^. QualificationUserQualification))
|
||||
E.where_ $ (qual E.^. QualificationAvsLicence E.==. E.justVal lic) -- matches licence
|
||||
E.&&. (qualUsr E.^. QualificationUserUser E.==. usr E.^. UserId) -- matches user
|
||||
E.&&. (qualUsr `qIsValid` nowaday) -- currently valid
|
||||
E.where_ $ E.exists (hasValidQual AvsLicenceRollfeld)
|
||||
E.&&. E.notExists (hasValidQual AvsLicenceVorfeld)
|
||||
return usr
|
||||
|
||||
|
||||
@ -209,7 +209,7 @@ postAdminAvsR = do
|
||||
let msg = tshow (e :: SomeException)
|
||||
return $ Just [whamlet|<h2>Licence check error:</h2> #{msg}|]
|
||||
BtnSynchLicences -> do
|
||||
res <- try checkLicences
|
||||
res <- try synchAvsLicences
|
||||
case res of
|
||||
(Right True) ->
|
||||
return $ Just [whamlet|<h2>Success:</h2> Licences sychronized.|]
|
||||
|
||||
@ -8,8 +8,9 @@
|
||||
module Handler.Utils.Avs
|
||||
( upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard
|
||||
-- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
|
||||
, setLicence, setLicenceAvs, setLicencesAvs, computeDifferingLicences
|
||||
, checkLicences
|
||||
, setLicence, setLicenceAvs, setLicencesAvs
|
||||
, retrieveDifferingLicences, computeDifferingLicences
|
||||
, synchAvsLicences
|
||||
, lookupAvsUser, lookupAvsUsers
|
||||
, AvsException(..)
|
||||
) where
|
||||
@ -145,8 +146,8 @@ setLicencesAvs persLics = do
|
||||
-- | Retrieve all currently valid driving licences and check against our database
|
||||
-- Only react to changes as compared to last seen status in avs.model
|
||||
-- TODO: run in a background job, once the interface is actually available
|
||||
checkLicences :: Handler Bool
|
||||
checkLicences = do
|
||||
synchAvsLicences :: Handler Bool
|
||||
synchAvsLicences = do
|
||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||
allLicences <- throwLeftM avsQueryGetAllLicences
|
||||
deltaLicences <- computeDifferingLicences allLicences
|
||||
@ -157,7 +158,20 @@ checkLicences = do
|
||||
return setResponse
|
||||
|
||||
computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
|
||||
computeDifferingLicences (AvsResponseGetLicences licences) = do
|
||||
computeDifferingLicences argl = do
|
||||
(setTo0, setTo1, setTo2) <- getDifferingLicences argl
|
||||
return $ Set.map (AvsPersonLicence AvsNoLicence) setTo0
|
||||
<> Set.map (AvsPersonLicence AvsLicenceVorfeld) setTo1
|
||||
<> Set.map (AvsPersonLicence AvsLicenceRollfeld) setTo2
|
||||
|
||||
retrieveDifferingLicences :: Handler (Set AvsPersonId, Set AvsPersonId, Set AvsPersonId)
|
||||
retrieveDifferingLicences = do
|
||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||
allLicences <- throwLeftM avsQueryGetAllLicences
|
||||
getDifferingLicences allLicences
|
||||
|
||||
getDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonId, Set AvsPersonId, Set AvsPersonId)
|
||||
getDifferingLicences (AvsResponseGetLicences licences) = do
|
||||
now <- liftIO getCurrentTime
|
||||
--let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences
|
||||
-- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
|
||||
@ -203,30 +217,28 @@ computeDifferingLicences (AvsResponseGetLicences licences) = do
|
||||
let setTo0 = vorfRevoke -- ready to use with SET 0
|
||||
setTo1 = (vorfGrant Set.\\ rollGrant ) `Set.union` (rollRevoke Set.\\ vorfRevoke)
|
||||
setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld)
|
||||
{-
|
||||
Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) :
|
||||
A (0,0,0) -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem
|
||||
B (0,0,1) -> ((_,_),(x,_)) : nop; do nothing -- CHECK since id is returned by roll-query
|
||||
C (0,1,0) -> ((x,_),(_,_)) : set F for id
|
||||
D (0,1,1) -> ((x,_),(x,_)) : set R for id
|
||||
E (1,0,0) -> ((_,x),(_,_)) : set 0 for id
|
||||
F (1,0,1) -> ((_,x),(x,_)) : set 0 for id
|
||||
G (1,1,0) -> ((_,_),(_,_)) : nop
|
||||
H (1,1,1) -> ((_,_),(x,_)) : set R for id
|
||||
I (2,0,0) -> ((_,x),(_,x)) : set 0 for id
|
||||
J (2,0,1) -> ((_,x),(_,_)) : set 0 for id
|
||||
K (2,1,0) -> ((_,_),(_,x)) : set F for id
|
||||
L (2,1,1) -> ((_,_),(_,_)) : nop
|
||||
return (setTo0, setTo1, setTo2)
|
||||
{- Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) :
|
||||
A (0,0,0) -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem
|
||||
B (0,0,1) -> ((_,_),(x,_)) : nop; do nothing -- CHECK since id is returned by roll-query
|
||||
C (0,1,0) -> ((x,_),(_,_)) : set F for id
|
||||
D (0,1,1) -> ((x,_),(x,_)) : set R for id
|
||||
E (1,0,0) -> ((_,x),(_,_)) : set 0 for id
|
||||
F (1,0,1) -> ((_,x),(x,_)) : set 0 for id
|
||||
G (1,1,0) -> ((_,_),(_,_)) : nop
|
||||
H (1,1,1) -> ((_,_),(x,_)) : set R for id
|
||||
I (2,0,0) -> ((_,x),(_,x)) : set 0 for id
|
||||
J (2,0,1) -> ((_,x),(_,_)) : set 0 for id
|
||||
K (2,1,0) -> ((_,_),(_,x)) : set F for id
|
||||
L (2,1,1) -> ((_,_),(_,_)) : nop
|
||||
|
||||
PROBLEM: B & H in conflict! (Note that nop is automatic except for case B)
|
||||
Results:
|
||||
set to 0: determined by vorfeld-unset -- zuerst
|
||||
set to 1: vorfeld-set && nicht in rollfeld-set || rollfeld-unset && nicht in vorfeld-unset
|
||||
set to 2: rollfeld-set && nicht in vorfeld-unset && (in vorfeld-set || AVS_Licence>0 == vorORrollfeld)
|
||||
-}
|
||||
return $ Set.map (AvsPersonLicence AvsNoLicence) setTo0
|
||||
<> Set.map (AvsPersonLicence AvsLicenceVorfeld) setTo1
|
||||
<> Set.map (AvsPersonLicence AvsLicenceRollfeld) setTo2
|
||||
PROBLEM: B & H in conflict! (Note that nop is automatic except for case B)
|
||||
Results:
|
||||
set to 0: determined by vorfeld-unset -- zuerst
|
||||
set to 1: vorfeld-set && nicht in rollfeld-set || rollfeld-unset && nicht in vorfeld-unset
|
||||
set to 2: rollfeld-set && nicht in vorfeld-unset && (in vorfeld-set || AVS_Licence>0 == vorORrollfeld)
|
||||
-}
|
||||
|
||||
|
||||
-- | Always update AVS Data
|
||||
upsertAvsUser :: Text -> Handler (Maybe UserId) -- TODO: change to Entity
|
||||
|
||||
43
templates/admin-problems.hamlet
Normal file
43
templates/admin-problems.hamlet
Normal file
@ -0,0 +1,43 @@
|
||||
$newline never
|
||||
|
||||
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
$#
|
||||
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgProblemsHeadingDrivers}
|
||||
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>#{boolSymbol driversHaveAvsIds}
|
||||
<dd .deflist__dd>_{MsgProblemsDriversHaveAvsIds}
|
||||
|
||||
$case diffLics
|
||||
$of Left err
|
||||
<dt .deflist__dt>#{boolSymbol False}
|
||||
<dd .deflist__dd>_{MsgProblemsAvsProblem err}
|
||||
|
||||
$of Right (ok0,ok1,ok2)
|
||||
<dt .deflist__dt>#{boolSymbol ok2}
|
||||
<dd .deflist__dd>_{MsgProblemsDriverSynch2}
|
||||
|
||||
<dt .deflist__dt>#{boolSymbol ok1}
|
||||
<dd .deflist__dd>_{MsgProblemsDriverSynch1}
|
||||
|
||||
<dt .deflist__dt>#{boolSymbol ok0}
|
||||
<dd .deflist__dd>_{MsgProblemsDriverSynch0}
|
||||
|
||||
<dt .deflist__dt>#{boolSymbol rDriversHaveFs}
|
||||
<dd .deflist__dd>_{MsgProblemsRDriversHaveFs}
|
||||
|
||||
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgProblemsHeadingUsers}
|
||||
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>#{boolSymbol usersAreReachable}
|
||||
<dd .deflist__dd>_{MsgProblemsUsersAreReachable}
|
||||
|
||||
<dt .deflist__dt>#{boolSymbol noStalePrintJobs}
|
||||
<dd .deflist__dd>_{MsgProblemsNoStalePrintJobs cutOffPrintDays}
|
||||
@ -126,7 +126,7 @@ spec = do
|
||||
[ eqLaws, showLaws, jsonLaws]
|
||||
|
||||
describe "AvsLicence" $ do
|
||||
it "ordering is consistent with its PersistField instance" . property $ -- this assumption is used in Handler.Utils.Avs.checkLicences
|
||||
it "ordering is consistent with its PersistField instance" . property $ -- this assumption is used in Handler.Utils.Avs.synchAvsLicences
|
||||
\a (b :: AvsLicence) -> compare a b == compare (toPersistValue a) (toPersistValue b)
|
||||
it "assigns AvsLicence fixed SQL values" . example $ do -- ensure that DB encoding does not change unnoticed
|
||||
toPersistValue AvsLicenceVorfeld `shouldBe` toPersistValue (1::Int64)
|
||||
@ -140,7 +140,7 @@ spec = do
|
||||
\p0 p1@AvsPersonLicence{avsLicenceRampLicence=v1} ->
|
||||
let p2@AvsPersonLicence{avsLicenceRampLicence=v2} = p0 in
|
||||
(v1 /= v2) ==> compare p1 p2 == compare v1 v2
|
||||
it "has antitone Function avsPersonLicenceIsGEQ" . property $ -- this assumption is used in Handler.Utils.Avs.checkLicences
|
||||
it "has antitone Function avsPersonLicenceIsGEQ" . property $ -- this assumption is used in Handler.Utils.Avs.synchAvsLicences
|
||||
\j k l -> j < k ==> avsPersonLicenceIsLEQ j l >= avsPersonLicenceIsLEQ k l
|
||||
|
||||
describe "Ord AvsDataCard" $ do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user