diff --git a/models/users.model b/models/users.model index fdbdb6fcf..39ea0ae09 100644 --- a/models/users.model +++ b/models/users.model @@ -56,7 +56,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create -- | User data fetched from external user sources, used for authentication and data queries ExternalUser - user UserId -- TODO: use UserIdent or Text instead; not every external user may have ever logged in (or needs to), i.e. users that have been queried in admin handler! + user UserIdent source AuthSourceIdent -- Identifier of the external source in the config data Value "default='{}'::jsonb" -- Raw user data from external source -- TODO: maybe make Maybe, iff the source only ever responds with "success"? lastSync UTCTime -- When was the external source last queried? diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs index de4575a8d..507c0619e 100644 --- a/src/Foundation/Authorization.hs +++ b/src/Foundation/Authorization.hs @@ -1533,8 +1533,8 @@ tagAccessPredicate AuthIsExternal = APDB $ \_ _ _ route _ -> exceptT return retu referencedUser' <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt referencedUser 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 [ ExternalUserUser ==. uid, ExternalUserSource <-. availableSources ] + Entity _ User{userIdent} <- MaybeT $ getEntity referencedUser' + guardM . lift $ exists [ ExternalUserUser ==. userIdent, 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 2c0ffc3ef..94573e8fd 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -203,13 +203,23 @@ fetchUserData Creds{..} = do Nothing -> throwM FetchUserDataException -- insert ExternalUser entries for each fetched dataset - whenIsJust results $ \ress -> forM_ ress $ \res -> - let externalUserUser = error "no userid" -- TODO: use azureUserPrimaryKey/ldapPrimaryKey once UserIdent is referenced instead of UserId - externalUserLastSync = now + whenIsJust results $ \ress -> forM_ ress $ \res -> do + let externalUserLastSync = now (externalUserData, externalUserSource) = case res of UpsertUserDataAzure{..} -> (toJSON upsertUserAzureData, AuthSourceIdAzure upsertUserAzureTenantId) UpsertUserDataLdap{..} -> (toJSON upsertUserLdapData, AuthSourceIdLdap upsertUserLdapHost) - in void $ upsert ExternalUser{..} [ExternalUserData =. externalUserData, ExternalUserLastSync =. externalUserLastSync] + externalUserUser <- if + | UpsertUserDataAzure{..} <- res + , azureData <- Map.fromListWith (++) $ upsertUserAzureData <&> \(t,bs) -> (t, filter (not . ByteString.null) bs) + , [(Text.decodeUtf8' -> Right azureUserPrincipalName')] <- azureData !!! azureUserPrincipalName + -> return $ CI.mk azureUserPrincipalName' + | UpsertUserDataLdap{..} <- res + , ldapData <- Map.fromListWith (++) $ upsertUserLdapData <&> \(t,bs) -> (t, filter (not . ByteString.null) bs) + , [(Text.decodeUtf8' -> Right ldapPrimaryKey')] <- ldapData !!! ldapPrimaryKey + -> return $ CI.mk ldapPrimaryKey' + | otherwise + -> throwM DecodeUserInvalidIdent + void $ upsert ExternalUser{..} [ExternalUserData =. externalUserData, ExternalUserLastSync =. externalUserLastSync] return results diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 8365d8b07..a29a60933 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) - externalUsers <- (\(Entity _ ExternalUser{..}) -> ("" :: Text, externalUserSource, externalUserLastSync)) <<$>> selectList [ ExternalUserUser ==. uid ] [] -- TODO: define and use user identification in ExternalUser model + externalUsers <- (\(Entity _ ExternalUser{..}) -> (externalUserUser, externalUserSource, externalUserLastSync)) <<$>> selectList [ ExternalUserUser ==. userIdent ] [] -- 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 a04ba50ab..327900b59 100644 --- a/src/Handler/SAP.hs +++ b/src/Handler/SAP.hs @@ -120,7 +120,7 @@ getQualificationSAPDirectR = do E.&&. E.isJust (user E.^. UserCompanyPersonalNumber) E.where_ . E.exists $ do externalUser <- E.from $ E.table @ExternalUser - E.where_ $ externalUser E.^. ExternalUserUser E.==. user E.^. UserId + E.where_ $ externalUser E.^. ExternalUserUser E.==. user E.^. UserIdent E.&&. externalUser E.^. ExternalUserSource `E.in_` E.valList ldapSources E.&&. externalUser E.^. ExternalUserLastSync E.>=. E.val ldapCutoff E.groupBy ( user E.^. UserCompanyPersonalNumber diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index 0752cac76..8e2da381a 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -107,6 +107,7 @@ dispatchHealthCheckHTTPReachable = fmap HealthHTTPReachable . yesodTimeout (^. _ getsYesod $ (== clusterId) . appClusterID +-- TODO: generalize health check dispatchHealthCheckLDAPAdmins :: Handler HealthReport dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHealthCheckLDAPAdminsTimeout) (Just 0) $ do ldapPool' <- getsYesod appLdapPool @@ -121,7 +122,7 @@ dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHea E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin E.where_ . E.exists . E.from $ \externalUser -> E.where_ $ - externalUser E.^. ExternalUserUser E.==. user E.^. UserId + externalUser E.^. ExternalUserUser E.==. user E.^. UserIdent E.&&. externalUser E.^. ExternalUserSource `E.in_` E.valList currentLdapSources return $ user E.^. UserIdent for (assertM' (not . null) ldapAdminUsers') $ \ldapAdminUsers -> do