chore(auth): change user identification to UserIdent for ExternalUser entries

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?

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

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
 

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] []

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

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