From 83afb6f15fb107b5302958020dcba4018f98ba8d Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Fri, 30 Aug 2019 14:22:06 +0200
Subject: [PATCH] feat(ldap): manually trigger ldap sync

---
 config/settings.yml             |  2 +-
 messages/uniworx/de.msg         |  6 ++++-
 src/Handler/Admin.hs            | 42 +++++++++++++++++++++++++++------
 src/Jobs/Crontab.hs             |  7 +++---
 templates/admin/ldapSync.hamlet | 10 ++++++++
 5 files changed, 55 insertions(+), 12 deletions(-)
 create mode 100644 templates/admin/ldapSync.hamlet

diff --git a/config/settings.yml b/config/settings.yml
index 05984ad70..e4568d03f 100644
--- a/config/settings.yml
+++ b/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:
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 360d5faeb..255106768 100644
--- a/messages/uniworx/de.msg
+++ b/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.
\ No newline at end of file
+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
\ No newline at end of file
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 9d8c03552..75af736a3 100644
--- a/src/Handler/Admin.hs
+++ b/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
diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs
index 7d5dce6f1..014160f3c 100644
--- a/src/Jobs/Crontab.hs
+++ b/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
diff --git a/templates/admin/ldapSync.hamlet b/templates/admin/ldapSync.hamlet
new file mode 100644
index 000000000..11c7afebd
--- /dev/null
+++ b/templates/admin/ldapSync.hamlet
@@ -0,0 +1,10 @@
+<dl>
+  <dt>
+    _{MsgOldestLdapSynchronisation}
+  <dd>
+    $maybe time <- oldestLdapSync'
+      #{time}
+    $nothing
+      _{MsgNever}
+
+^{ldapSyncView}