diff --git a/messages/uniworx/categories/admin/de-de-formal.msg b/messages/uniworx/categories/admin/de-de-formal.msg index 3138ac164..279d59ebe 100644 --- a/messages/uniworx/categories/admin/de-de-formal.msg +++ b/messages/uniworx/categories/admin/de-de-formal.msg @@ -114,6 +114,7 @@ ProblemsNoStalePrintJobs n@Integer: Alle Briefversandaufträge #{pluralDE n "des ProblemsNoBadAPCIds: Alle kürzlich empfangenen Druckauftragsbestätigungen waren gültig ProblemsUnreachableHeading: Unerreichbare Benutzer ProblemsUnreachableBody: Benutzer ohne E-Mail oder Postadresse, welche z.B. bei ablaufenden Berechtigungen nicht benachrichtigt werden können: +ProblemsUnreachableButtons: Synchronisation für Unerreichbare starten ProblemsRWithoutFHeading: Fahrer mit R ohne F ProblemsRWithoutFBody: Diese Fahrer sind wegen einer ungültigen Vorfeld-Fahrberechtigung komplett gesperrt, obwohl eine gültige Rollfeld-Fahrberechtigung besteht: ProblemsNoAvsIdHeading: Fahrer ohne AVS-Id diff --git a/messages/uniworx/categories/admin/en-eu.msg b/messages/uniworx/categories/admin/en-eu.msg index 96972ad87..ebca9a147 100644 --- a/messages/uniworx/categories/admin/en-eu.msg +++ b/messages/uniworx/categories/admin/en-eu.msg @@ -114,6 +114,7 @@ ProblemsNoStalePrintJobs n: All requests for letter mailing within the last #{pl ProblemsNoBadAPCIds: All recently received print job ids from Airport Print Center were legit ProblemsUnreachableHeading: Unreachable Users ProblemsUnreachableBody: Users without Email nor postal address, who thus cannot be notified about expiring qualifications: +ProblemsUnreachableButtons: Start synchronisation for unreachable users only ProblemsRWithoutFHeading: Drivers having 'R' but not 'F' ProblemsRWithoutFBody: Drivers without apron driving licence are prohibited from driving, even if they own a valid maneuvering driving licence: ProblemsNoAvsIdHeading: Drivers without AVS id diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index b2ab14351..2f5b7b4bb 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -37,10 +37,10 @@ AuthPWHashAlreadyConfigured: Nutzer:in meldet sich bereits mit FRADrive spezifis AuthPWHashConfigured: Nutzer:in meldet sich nun mit FRADrive spezifischer Kennung an UsersCourseSchool: Bereich ActionNoUsersSelected: Keine Benutzer:innen ausgewählt -SynchroniseAvsUserQueued n@Int: AVS-Synchronisation von #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} zwingend angestoßen -SynchroniseAvsAllUsersQueued n@Int64: AVS-Synchronisation von allen #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} angestoßen, welche heute noch nicht synchronisiert wurden -SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} angestoßen -SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzer:innen angestoßen +SynchroniseAvsUserQueued n@Int: AVS-Synchronisation von #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} zwingend angestoßen, die Ausführung wird mehrere Minuten benötigen! +SynchroniseAvsAllUsersQueued n@Int64: AVS-Synchronisation von allen #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} angestoßen, welche heute noch nicht synchronisiert wurden, die Ausführung wird eine Weile brauchen! +SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} angestoßen, die Ausführung wird mehrere Minuten benötigen! +SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzer:innen angestoßen, die Ausführung kann eine Weile brauchen! UserListTitle: Komprehensive Benutzerliste AccessRightsSaved: Berechtigungen erfolgreich verändert AccessRightsNotChanged: Berechtigungen wurden nicht verändert diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index 265344219..e4ec93fff 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -37,10 +37,10 @@ AuthPWHashAlreadyConfigured: User already logs in using their FRADrive specific AuthPWHashConfigured: User now logs in using their FRADrive specific account UsersCourseSchool: Department ActionNoUsersSelected: No users selected -SynchroniseAvsUserQueued n: Triggered forced AVS synchronisation of #{n} #{pluralEN n "user" "users"} -SynchroniseAvsAllUsersQueued n: Triggered AVS synchronisation of all #{n} #{pluralEN n "user" "users"} that were not already synchronised today -SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n "user" "users"} -SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users +SynchroniseAvsUserQueued n: Triggered forced AVS synchronisation of #{n} #{pluralEN n "user" "users"}, which may take several minutes to complete. +SynchroniseAvsAllUsersQueued n: Triggered AVS synchronisation of all #{n} #{pluralEN n "user" "users"} that were not already synchronised today, which may take quite a while to complete. +SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n "user" "users"}, which may take several minutes to complete. +SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users, which may take quite a while to complete. UserListTitle: Comprehensive list of users AccessRightsSaved: Successfully updated permissions AccessRightsNotChanged: Permissions left unchanged diff --git a/routes b/routes index 98042a4a7..21518dfa5 100644 --- a/routes +++ b/routes @@ -71,7 +71,7 @@ /admin/avs/#CryptoUUIDUser AdminAvsUserR GET POST /admin/ldap AdminLdapR GET POST /admin/problems AdminProblemsR GET POST -/admin/problems/no-contact ProblemUnreachableR GET +/admin/problems/no-contact ProblemUnreachableR GET POST /admin/problems/no-avs-id ProblemWithoutAvsId GET /admin/problems/r-without-f ProblemFbutNoR GET /admin/problems/avs ProblemAvsSynchR GET POST diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 64c4acadd..1567da027 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -24,11 +24,13 @@ import qualified Database.Esqueleto.Experimental as E import qualified Database.Esqueleto.Legacy as EL (on) -- needed for dbTable import qualified Database.Esqueleto.Utils as E +import Jobs import Handler.Utils import Handler.Utils.Avs import Handler.Utils.Users -- import Handler.Utils.Company import Handler.Health.Interface +import Handler.Users (AllUsersAction(..)) import Handler.Admin.Test as Handler.Admin import Handler.Admin.ErrorMessage as Handler.Admin @@ -140,12 +142,34 @@ postAdminProblemsR = do addMessageI mkind $ msg oks when (oks > 0) $ reloadKeepGetParams AdminProblemsR -- reload to update all tables -getProblemUnreachableR :: Handler Html -getProblemUnreachableR = do +getProblemUnreachableR, postProblemUnreachableR :: Handler Html +getProblemUnreachableR = postProblemUnreachableR +postProblemUnreachableR = do unreachables <- runDB retrieveUnreachableUsers + + -- the following form is a nearly identicaly copy from Handler.Users: + ((noreachUsersRes, noreachUsersWgt'), noreachUsersEnctype) <- runFormPost . identifyForm FIDUnreachableUsersAction $ buttonForm + let noreachUsersWgt = wrapForm noreachUsersWgt' def + { formSubmit = FormNoSubmit + , formAction = Just $ SomeRoute ProblemUnreachableR + , formEncoding = noreachUsersEnctype + } + formResult noreachUsersRes $ \case + AllUsersLdapSync -> do + forM_ unreachables $ \Entity{entityKey=uid} -> void . queueJob $ JobSynchroniseLdapUser uid + addMessageI Success . MsgSynchroniseLdapUserQueued $ length unreachables + redirect ProblemUnreachableR + AllUsersAvsSync -> do + n <- runDB $ queueAvsUpdateByUID (entityKey <$> unreachables) Nothing + addMessageI Success . MsgSynchroniseAvsUserQueued $ fromIntegral n + redirect ProblemUnreachableR + siteLayoutMsg MsgProblemsUnreachableHeading $ do setTitleI MsgProblemsUnreachableHeading [whamlet| +
+

_{MsgProblemsUnreachableButtons} + ^{noreachUsersWgt}
#{length unreachables} _{MsgProblemsUnreachableBody}
    diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 5b611c79e..6a48bdec4 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -320,6 +320,7 @@ data FormIdentifier | FIDAddSupervisor | FIDFirmUserChangeRequest | FIDFirmAction + | FIDUnreachableUsersAction deriving (Eq, Ord, Read, Show) instance PathPiece FormIdentifier where