chore(sap): generalize ldap-cutoff over configured ldap sources
This commit is contained in:
parent
87b3214c84
commit
039b1234c5
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -17,11 +17,9 @@ import Handler.Utils.Csv
|
||||
import Handler.Utils.Profile
|
||||
|
||||
import qualified Data.Text as Text (intercalate)
|
||||
-- import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Csv as Csv
|
||||
import Database.Esqueleto.Experimental ((:&)(..))
|
||||
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
|
||||
-- import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
@ -96,8 +94,21 @@ compileBlocks dStart dEnd = go (dStart, True)
|
||||
getQualificationSAPDirectR :: Handler TypedContent
|
||||
getQualificationSAPDirectR = do
|
||||
now <- liftIO getCurrentTime
|
||||
fdate <- formatTime' "%Y%m%d_%H-%M" now
|
||||
let ldap_cutoff = addDiffDaysRollOver (fromMonths $ -3) now
|
||||
fdate <- formatTime' "%Y%m%d_%H-%M" now
|
||||
userAuthConf <- getsYesod $ view _appUserAuthConf
|
||||
|
||||
let
|
||||
ldapSources = case userAuthConf of
|
||||
UserAuthConfSingleSource (AuthSourceConfLdap LdapConf{..})
|
||||
-> [ AuthSourceIdLdap
|
||||
{ authSourceIdLdapHost = tshow ldapConfHost -- TODO: ugh... what to do in case of tls?
|
||||
, authSourceIdLdapPort = fromInteger $ toInteger ldapConfPort -- TODO: ugh...
|
||||
}
|
||||
]
|
||||
_other
|
||||
-> mempty
|
||||
ldapCutoff = addDiffDaysRollOver (fromMonths $ -3) now
|
||||
|
||||
qualUsers <- runDB $ E.select $ do
|
||||
(qual :& qualUser :& user :& qualBlock) <-
|
||||
E.from $ E.table @Qualification
|
||||
@ -111,9 +122,12 @@ getQualificationSAPDirectR = do
|
||||
E.&&. E.val now E.>~. qualBlock E.?. QualificationUserBlockFrom
|
||||
)
|
||||
E.where_ $ E.isJust (qual E.^. QualificationSapId)
|
||||
E.&&. E.isJust (user E.^. UserCompanyPersonalNumber)
|
||||
E.&&. E.isJust (user E.^. UserLastLdapSynchronisation)
|
||||
E.&&. (E.justVal ldap_cutoff E.<=. user E.^. UserLastLdapSynchronisation)
|
||||
E.&&. E.isJust (user E.^. UserCompanyPersonalNumber)
|
||||
E.where_ . E.exists $ do
|
||||
externalAuth <- E.from $ E.table @ExternalAuth
|
||||
E.where_ $ externalAuth E.^. ExternalAuthUser E.==. user E.^. UserId
|
||||
E.&&. externalAuth E.^. ExternalAuthSource `E.in_` E.valList ldapSources
|
||||
E.&&. externalAuth E.^. ExternalAuthLastSync E.>=. E.val ldapCutoff
|
||||
E.groupBy ( user E.^. UserCompanyPersonalNumber
|
||||
, qualUser E.^. QualificationUserFirstHeld
|
||||
, qualUser E.^. QualificationUserValidUntil
|
||||
|
||||
Reference in New Issue
Block a user