feat(ldap): manually trigger ldap sync

config/settings.yml

@@ -41,7 +41,7 @@ health-check-delay-notify: "_env:HEALTHCHECK_DELAY_NOTIFY:true"
 health-check-http: "_env:HEALTHCHECK_HTTP:true" # Can we assume, that we can reach ourselves under APPROOT via HTTP (reverse proxies or firewalls might prevent this)?
 health-check-active-job-executors-timeout: "_env:HEALTHCHECK_ACTIVE_JOB_EXECUTORS_TIMEOUT:5"
 
-synchronise-ldap-users-within: "_env:SYNCHRONISE_LDAP_WITHIN:604800"
+synchronise-ldap-users-within: "_env:SYNCHRONISE_LDAP_WITHIN:1209600"
 synchronise-ldap-users-interval: "_env:SYNCHRONISE_LDAP_INTERVAL:3600"
 
 log-settings:

messages/uniworx/de.msg

@@ -1589,4 +1589,8 @@ SchoolLecturer: Dozent
 SchoolEvaluation: Kursumfragenverwaltung
 SchoolExamOffice: Prüfungsamt
 
-ApplicationEditTip: Während des Bewerbungszeitraums können eigene Bewerbungen beliebig angepasst und auch wieder zurückgezogen werden.
+ApplicationEditTip: Während des Bewerbungszeitraums können eigene Bewerbungen beliebig angepasst und auch wieder zurückgezogen werden.
+
+BtnAdminSynchroniseLdap: Alle Ldap-Daten synchronisieren
+LdapSynchronisationQueued: LDAP-Synchronisation angestoßen
+OldestLdapSynchronisation: Älteste LDAP-Synchronisation

src/Handler/Admin.hs

@@ -29,15 +29,43 @@ import qualified Handler.Utils.TermCandidates as Candidates
 
 -- import qualified Data.UUID.Cryptographic as UUID
 
+data AdminButton = BtnAdminSynchroniseLdap
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe AdminButton
+instance Finite AdminButton
+
+nullaryPathPiece ''AdminButton $ camelToPathPiece' 2
+
+embedRenderMessage ''UniWorX ''AdminButton id
+
+instance Button UniWorX AdminButton where
+  btnClasses _ = [BCIsButton, BCPrimary]
+
 
 getAdminR :: Handler Html
-getAdminR = -- do
-   siteLayoutMsg MsgAdminHeading $ do
-      setTitleI MsgAdminHeading
-      [whamlet|
-        This shall become the Administrators' overview page.
-        Its current purpose is to provide links to some important admin functions
-      |]
+getAdminR = do
+  ((ldapSyncRes, ldapSyncView), ldapSyncEnctype) <- runFormPost $ buttonForm' [BtnAdminSynchroniseLdap]
+
+  formResult ldapSyncRes $ \case
+    BtnAdminSynchroniseLdap -> do
+      queueJob' $ JobSynchroniseLdap 1 0 0
+      addMessageI Success MsgLdapSynchronisationQueued
+      redirect AdminR
+
+  oldestLdapSync <- fmap (join . preview (_head . _Value)) . runDB . E.select . E.from $ \user -> do
+    E.orderBy [E.desc . E.isNothing $ user E.^. UserLastLdapSynchronisation, E.asc $ user E.^. UserLastLdapSynchronisation]
+    E.limit 1
+    return $ user E.^. UserLastLdapSynchronisation
+  oldestLdapSync' <- for oldestLdapSync $ formatTime SelFormatDateTime
+    
+  
+  siteLayoutMsg MsgAdminHeading $ do
+    setTitleI MsgAdminHeading
+    wrapForm $(widgetFile "admin/ldapSync") def
+      { formAction = Just $ SomeRoute AdminR
+      , formSubmit = FormNoSubmit
+      , formEncoding = ldapSyncEnctype
+      }
 
 -- BEGIN - Buttons needed only here
 data ButtonCreate = CreateMath | CreateInf  -- Dummy for Example

src/Jobs/Crontab.hs

@@ -105,11 +105,12 @@ determineCrontab = execWriterT $ do
       -> do
         now <- liftIO getPOSIXTime
         let
+          epochInterval = syncWithin / 2
           interval = appSynchroniseLdapUsersInterval
           
-          (ldapEpoch, epochNow) = now `divMod'` syncWithin
+          (ldapEpoch, epochNow) = now `divMod'` epochInterval
           ldapInterval = epochNow `div'` interval
-          numIntervals = floor $ syncWithin / interval
+          numIntervals = floor $ epochInterval / interval
 
           nextIntervals = do
             let
@@ -118,7 +119,7 @@ determineCrontab = execWriterT $ do
             let
               ((+ ldapEpoch) -> nextEpoch, nextInterval) = (ldapInterval + i) `divMod` numIntervals
               nextIntervalTime
-                = posixSecondsToUTCTime $ fromInteger nextEpoch * syncWithin + fromInteger nextInterval * interval
+                = posixSecondsToUTCTime $ fromInteger nextEpoch * epochInterval + fromInteger nextInterval * interval
             return (nextEpoch, nextInterval, nextIntervalTime)
 
         forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime) -> do

templates/admin/ldapSync.hamlet

@@ -0,0 +1,10 @@
+<dl>
+  <dt>
+    _{MsgOldestLdapSynchronisation}
+  <dd>
+    $maybe time <- oldestLdapSync'
+      #{time}
+    $nothing
+      _{MsgNever}
+
+^{ldapSyncView}