diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs index b85e397d7..de4575a8d 100644 --- a/src/Foundation/Authorization.hs +++ b/src/Foundation/Authorization.hs @@ -1534,7 +1534,7 @@ tagAccessPredicate AuthIsExternal = APDB $ \_ _ _ route _ -> exceptT return retu let availableSources = error "tagAccessPredicate: no available sources yet" -- TODO: implement once config supports source idents maybeTMExceptT (unauthorizedI MsgUnauthorizedExternal) $ do Entity uid _ <- MaybeT $ getEntity referencedUser' - guardM . lift $ exists [ ExternalAuthUser ==. uid, ExternalAuthSource <-. availableSources ] + guardM . lift $ exists [ ExternalUserUser ==. uid, ExternalUserSource <-. availableSources ] return Authorized tagAccessPredicate AuthIsInternal = APDB $ \_ _ _ route _ -> exceptT return return $ do referencedUser <- case route of diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index bc5092881..d80405f60 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -321,7 +321,6 @@ decodeUser now UserDefaultConf{..} upsertData = do , userNotificationSettings = def , userCsvOptions = def , userTokensIssuedAfter = Nothing - , userCreated = now , userDisplayEmail = userEmail , userMatrikelnummer = Nothing -- TODO: not known from Azure/LDAP, must be derived from REST interface to AVS , userPostAddress = Nothing -- TODO: not known from Azure/LDAP, must be derived from REST interface to AVS @@ -330,6 +329,8 @@ decodeUser now UserDefaultConf{..} upsertData = do , userPrefersPostal = userDefaultPrefersPostal , userPasswordHash = Nothing , userLastAuthentication = Nothing + , userCreated = now + , userLastSync = Just now , .. } userUpdate = @@ -341,6 +342,7 @@ decodeUser now UserDefaultConf{..} upsertData = do , UserMobile =. userMobile , UserCompanyPersonalNumber =. userCompanyPersonalNumber , UserCompanyDepartment =. userCompanyDepartment + , UserLastSync =. Just now ] return (newUser, userUpdate) diff --git a/src/Handler/LMS/Fake.hs b/src/Handler/LMS/Fake.hs index 67e8ed912..743f076f8 100644 --- a/src/Handler/LMS/Fake.hs +++ b/src/Handler/LMS/Fake.hs @@ -90,6 +90,7 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u userDisplayName = Text.unwords $ firstNames <> [userSurname] userMatrikelnummer = Just "TESTUSER" userCreated = now + userLastSync = Just now userTokensIssuedAfter = Nothing userFirstName = Text.unwords firstNames userTitle = Nothing diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4f3c89e90..8365d8b07 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -584,7 +584,7 @@ makeProfileData :: Entity User -> DB Widget makeProfileData (Entity uid User{..}) = do now <- liftIO getCurrentTime avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid) - externalAuths <- (\(Entity _ ExternalAuth{..}) -> ("" :: Text, externalAuthSource, externalAuthLastSync)) <<$>> selectList [ ExternalAuthUser ==. uid ] [] -- TODO: define and use user identification in ExternalAuth model + externalUsers <- (\(Entity _ ExternalUser{..}) -> ("" :: Text, externalUserSource, externalUserLastSync)) <<$>> selectList [ ExternalUserUser ==. uid ] [] -- TODO: define and use user identification in ExternalUser model -- avsCards <- maybe (pure mempty) (\a -> selectList [UserAvsCardPersonId ==. userAvsPersonId a] []) avsId functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] [] diff --git a/src/Handler/SAP.hs b/src/Handler/SAP.hs index f7b1eaffa..a04ba50ab 100644 --- a/src/Handler/SAP.hs +++ b/src/Handler/SAP.hs @@ -119,10 +119,10 @@ getQualificationSAPDirectR = do E.where_ $ E.isJust (qual E.^. QualificationSapId) 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 + externalUser <- E.from $ E.table @ExternalUser + E.where_ $ externalUser E.^. ExternalUserUser E.==. user E.^. UserId + E.&&. externalUser E.^. ExternalUserSource `E.in_` E.valList ldapSources + E.&&. externalUser E.^. ExternalUserLastSync E.>=. E.val ldapCutoff E.groupBy ( user E.^. UserCompanyPersonalNumber , qualUser E.^. QualificationUserFirstHeld , qualUser E.^. QualificationUserValidUntil diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index b0bad05d8..d29bbd82d 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -125,8 +125,8 @@ postUsersR = do icnReroute = text2widget " " <> toWgt (icon IconLetter) pure $ mconcat supervisors , sortable (Just "last-login") (i18nCell MsgLastLogin) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastAuthentication - -- , sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication -- TODO: reintroduce via ExternalAuth - -- , sortable (Just "ldap-sync") (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation -- TODO: reintroduce via ExternalAuth + -- , sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication -- TODO: reintroduce via ExternalUser + -- , sortable (Just "ldap-sync") (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation -- TODO: reintroduce via ExternalUser , flip foldMap universeF $ \function -> sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do schools <- liftHandler . runDB . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do @@ -223,13 +223,13 @@ postUsersR = do ) -- , ( "auth-ldap" -- , SortColumn $ \user -> user E.^. UserAuthentication E.!=. E.val AuthLDAP - -- ) -- TODO: reintroduce via ExternalAuth + -- ) -- TODO: reintroduce via ExternalUser , ( "last-login" , SortColumn $ \user -> user E.^. UserLastAuthentication ) -- , ( "ldap-sync" -- , SortColumn $ \user -> user E.^. UserLastLdapSynchronisation - -- ) -- TODO: reintroduce via ExternalAuth + -- ) -- TODO: reintroduce via ExternalUser , ( "user-company" , SortColumn $ \user -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId @@ -276,7 +276,7 @@ postUsersR = do -- -> (user E.^. UserAuthentication E.==. E.val AuthLDAP) E.==. E.val crit -- | otherwise -- -> E.true - -- ) -- TODO: reintroduce via ExternalAuth + -- ) -- TODO: reintroduce via ExternalUser , ( "school", FilterColumn $ \user criterion -> if | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool) | otherwise -> let schools = E.valList (Set.toList criterion) in @@ -288,7 +288,7 @@ postUsersR = do -- -> let minTime = minimum (criteria' :: NonNull (Set UTCTime)) -- in E.maybe E.true (E.<=. E.val minTime) $ user E.^. UserLastLdapSynchronisation -- | otherwise -> E.val True :: E.SqlExpr (E.Value Bool) - -- ) -- TODO: reintroduce via ExternalAuth + -- ) -- TODO: reintroduce via ExternalUser , ( "user-company", FilterColumn . E.mkExistsFilter $ \user criterion -> E.from $ \(usrComp `E.InnerJoin` comp) -> do let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf` @@ -330,8 +330,8 @@ postUsersR = do , prismAForm (singletonFilter "user-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) , prismAForm (singletonFilter "school") mPrev $ aopt (lift `hoistField` selectFieldList schoolOptions) (fslI MsgCourseSchool) , prismAForm (singletonFilter "is-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgUserIsSupervisor) - -- , prismAForm (singletonFilter "auth-ldap" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode) -- TODO: reintroduce via ExternalAuth - -- , prismAForm (singletonFilter "ldap-sync" . maybePrism _PathPiece) mPrev $ aopt utcTimeField (fslI MsgLdapSyncedBefore) -- TODO: reintroduce via ExternalAuth + -- , prismAForm (singletonFilter "auth-ldap" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode) -- TODO: reintroduce via ExternalUser + -- , prismAForm (singletonFilter "ldap-sync" . maybePrism _PathPiece) mPrev $ aopt utcTimeField (fslI MsgLdapSyncedBefore) -- TODO: reintroduce via ExternalUser ] , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } , dbtParams = DBParamsForm diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index 04f4f9006..0752cac76 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -120,9 +120,9 @@ dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHea ldapAdminUsers' <- fmap (map E.unValue) . runDB . E.select . E.from $ \(user `E.InnerJoin` userFunction) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin - E.where_ . E.exists . E.from $ \externalAuth -> E.where_ $ - externalAuth E.^. ExternalAuthUser E.==. user E.^. UserId - E.&&. externalAuth E.^. ExternalAuthSource `E.in_` E.valList currentLdapSources + E.where_ . E.exists . E.from $ \externalUser -> E.where_ $ + externalUser E.^. ExternalUserUser E.==. user E.^. UserId + E.&&. externalUser E.^. ExternalUserSource `E.in_` E.valList currentLdapSources return $ user E.^. UserIdent for (assertM' (not . null) ldapAdminUsers') $ \ldapAdminUsers -> do let numAdmins = genericLength ldapAdminUsers diff --git a/src/Model/Types/Auth.hs b/src/Model/Types/Auth.hs index fe683f258..add176291 100644 --- a/src/Model/Types/Auth.hs +++ b/src/Model/Types/Auth.hs @@ -72,7 +72,7 @@ type AzureScopes = Set Text type UserEduPersonPrincipalName = Text -- | Subset of the configuration settings of an authentication source that uniquely identify a given source --- | Used for uniquely storing ExternalAuth entries per user and source +-- | Used for uniquely storing ExternalUser entries per user and source data AuthSourceIdent = AuthSourceIdAzure { authSourceIdAzureClientId :: UUID diff --git a/src/Utils/Users.hs b/src/Utils/Users.hs index 946bfc080..7c676299a 100644 --- a/src/Utils/Users.hs +++ b/src/Utils/Users.hs @@ -77,5 +77,6 @@ addNewUser AddUserData{..} = do , userPrefersPostal = audPrefersPostal , userPinPassword = audPinPassword , userMatrikelnummer = audMatriculation + , userLastSync = Nothing -- TODO: combine add user with external sync? } runDB $ insertUnique newUser \ No newline at end of file diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 2b10fa14f..1501f3c53 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -123,13 +123,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgAdminUserAuthentication}
- $if null externalAuths && is _Nothing userPasswordHash + $if null externalUsers && is _Nothing userPasswordHash _{MsgAuthKindNoLogin} $else