diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index f91f9136b..e906e59d2 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -27,17 +27,16 @@ import Import import Auth.LDAP (ldapUserMatr') import Foundation.Yesod.Auth (upsertUser) -import Crypto.Hash (hashlazy) +-- import Crypto.Hash (hashlazy) import Data.ByteArray (constEq) import Data.Maybe (fromJust) import qualified Data.List.NonEmpty as NonEmpty (fromList) -import qualified Data.Aeson as JSON +-- import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON import qualified Data.Set as Set --- import qualified Data.List as List import qualified Data.CaseInsensitive as CI import Database.Esqueleto.Experimental ((:&)(..)) @@ -235,11 +234,12 @@ guessUser (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) | EQ <- x `closeness` x' = x : takeClosest (x':xs) | otherwise = [x] + -- TODO: Generalize doLdap userMatr = do ldapPool' <- getsYesod $ view _appLdapPool - fmap join . for ldapPool' $ \ldapPool -> do + fmap join . for ldapPool' $ \ldapPool@(upsertUserLdapConf,_) -> do ldapData <- ldapUserMatr' ldapPool userMatr - for ldapData $ upsertLdapUser UpsertUserGuessUser + for ldapData $ \upsertUserLdapData -> upsertUser UpsertUserGuessUser UpsertUserDataLdap{..} let getTermMatr :: [PredLiteral GuessUserInfo] -> Maybe UserMatriculation @@ -909,9 +909,8 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do mergeMaybe = mergeBy (\oldV newV -> isNothing newV && isJust oldV) update newUserId $ catMaybes -- NOTE: persist does shortcircuit null updates as expected - [ mergeMaybe UserLdapPrimaryKey - , mergeBy (<) UserAuthentication - , mergeBy (>) UserLastAuthentication + [ mergeMaybe UserPasswordHash + , mergeBy (>) UserLastLogin , mergeBy (<) UserCreated , toMaybe (not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail)) (UserEmail =. oldUser ^. _userEmail)