From 2a981489938c7443dab5aecdcb38b8cc06baf7e9 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 6 Dec 2022 18:20:09 +0100 Subject: [PATCH] chore(admin): add problem overview on admin main page --- .../uniworx/categories/admin/de-de-formal.msg | 13 +- messages/uniworx/categories/admin/en-eu.msg | 12 +- .../uniworx/categories/term/de-de-formal.msg | 2 +- messages/uniworx/categories/term/en-eu.msg | 2 +- src/Handler/Admin.hs | 167 +++++++++++------- src/Handler/Admin/Avs.hs | 2 +- src/Handler/Utils/Avs.hs | 68 ++++--- templates/admin-problems.hamlet | 43 +++++ test/Utils/TypesSpec.hs | 4 +- 9 files changed, 210 insertions(+), 103 deletions(-) create mode 100644 templates/admin-problems.hamlet diff --git a/messages/uniworx/categories/admin/de-de-formal.msg b/messages/uniworx/categories/admin/de-de-formal.msg index d11cce147..18693317d 100644 --- a/messages/uniworx/categories/admin/de-de-formal.msg +++ b/messages/uniworx/categories/admin/de-de-formal.msg @@ -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 \ No newline at end of file diff --git a/messages/uniworx/categories/admin/en-eu.msg b/messages/uniworx/categories/admin/en-eu.msg index 25d9dcff0..bcde387b8 100644 --- a/messages/uniworx/categories/admin/en-eu.msg +++ b/messages/uniworx/categories/admin/en-eu.msg @@ -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 \ No newline at end of file diff --git a/messages/uniworx/categories/term/de-de-formal.msg b/messages/uniworx/categories/term/de-de-formal.msg index 9166aaf30..8a93e5698 100644 --- a/messages/uniworx/categories/term/de-de-formal.msg +++ b/messages/uniworx/categories/term/de-de-formal.msg @@ -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 diff --git a/messages/uniworx/categories/term/en-eu.msg b/messages/uniworx/categories/term/en-eu.msg index 4491e0ef4..7880cc072 100644 --- a/messages/uniworx/categories/term/en-eu.msg +++ b/messages/uniworx/categories/term/en-eu.msg @@ -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 diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 87f0902ee..232d7cdf6 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -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 = -} - \ No newline at end of file +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 + diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 6d24f2ffa..d455788ae 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -209,7 +209,7 @@ postAdminAvsR = do let msg = tshow (e :: SomeException) return $ Just [whamlet|

Licence check error:

#{msg}|] BtnSynchLicences -> do - res <- try checkLicences + res <- try synchAvsLicences case res of (Right True) -> return $ Just [whamlet|

Success:

Licences sychronized.|] diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index dc17218ab..79835197e 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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 diff --git a/templates/admin-problems.hamlet b/templates/admin-problems.hamlet new file mode 100644 index 000000000..94467b4b8 --- /dev/null +++ b/templates/admin-problems.hamlet @@ -0,0 +1,43 @@ +$newline never + +$# SPDX-FileCopyrightText: 2022 Steffen Jost +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + +
+

+ _{MsgProblemsHeadingDrivers} + +
+
#{boolSymbol driversHaveAvsIds} +
_{MsgProblemsDriversHaveAvsIds} + + $case diffLics + $of Left err +
#{boolSymbol False} +
_{MsgProblemsAvsProblem err} + + $of Right (ok0,ok1,ok2) +
#{boolSymbol ok2} +
_{MsgProblemsDriverSynch2} + +
#{boolSymbol ok1} +
_{MsgProblemsDriverSynch1} + +
#{boolSymbol ok0} +
_{MsgProblemsDriverSynch0} + +
#{boolSymbol rDriversHaveFs} +
_{MsgProblemsRDriversHaveFs} + + +
+

+ _{MsgProblemsHeadingUsers} + +
+
#{boolSymbol usersAreReachable} +
_{MsgProblemsUsersAreReachable} + +
#{boolSymbol noStalePrintJobs} +
_{MsgProblemsNoStalePrintJobs cutOffPrintDays} diff --git a/test/Utils/TypesSpec.hs b/test/Utils/TypesSpec.hs index d1a82bb09..b3b8aaea6 100644 --- a/test/Utils/TypesSpec.hs +++ b/test/Utils/TypesSpec.hs @@ -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