fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(model): remigrate ExternalAuth -> ExternalUser for more general data lookup; redefine lastSync timestamp semantics contd

Browse Source
This commit is contained in:
Sarah Vaupel 2024-03-01 12:03:38 +01:00
parent 40fe8ecfc6
commit f88e527fe4
11 changed files with 36 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Foundation/Authorization.hs
View File

@ -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

4
src/Foundation/Yesod/Auth.hs
View File

@ -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)

1
src/Handler/LMS/Fake.hs
View File

@ -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

2
src/Handler/Profile.hs
View File

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

8
src/Handler/SAP.hs
View File

@ -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

16
src/Handler/Users.hs
View File

@ -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

6
src/Jobs/HealthReport.hs
View File

@ -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

2
src/Model/Types/Auth.hs
View File

@ -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

1
src/Utils/Users.hs
View File

@ -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

4
templates/profileData.hamlet
View File

@ -123,13 +123,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<dt .deflist__dt>
_{MsgAdminUserAuthentication}
<dd .deflist__dd>
$if null externalAuths && is _Nothing userPasswordHash
$if null externalUsers && is _Nothing userPasswordHash
_{MsgAuthKindNoLogin}
$else
<ul>
$if is _Just userPasswordHash
<li>_{MsgAuthKindPWHash}
$forall (authIdent, sourceIdent, lsync) <- externalAuths
$forall (authIdent, sourceIdent, lsync) <- externalUsers
<li>
$case sourceIdent
$of AuthSourceIdAzure _clientId

11
test/Database/Fill.hs
View File

@ -84,6 +84,7 @@ fillDb = do
{ userIdent = "G.Kleen@campus.lmu.de"
, userPasswordHash = Nothing
, userLastAuthentication = Just now
, userLastSync = Just now
, userTokensIssuedAfter = Just now
, userMatrikelnummer = Nothing
, userEmail = "G.Kleen@campus.lmu.de"
@ -122,6 +123,7 @@ fillDb = do
{ userIdent = "felix.hamann@campus.lmu.de"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Nothing
, userEmail = "noEmailKnown"
@ -165,6 +167,7 @@ fillDb = do
{ userIdent = "jost@tcs.ifi.lmu.de"
, userPasswordHash = Just pwSimple
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Just "12345678"
, userEmail = "S.Jost@Fraport.de"
@ -203,6 +206,7 @@ fillDb = do
{ userIdent = "max@campus.lmu.de"
, userPasswordHash = Nothing
, userLastAuthentication = Just now
, userLastSync = Just now
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Just "1299"
, userEmail = "max@campus.lmu.de"
@ -241,6 +245,7 @@ fillDb = do
{ userIdent = "tester@campus.lmu.de"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Just "999"
, userEmail = "tester@campus.lmu.de"
@ -279,6 +284,7 @@ fillDb = do
{ userIdent = "vaupel.sarah@campus.lmu.de"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Nothing
, userEmail = "vaupel.sarah@campus.lmu.de"
@ -317,6 +323,7 @@ fillDb = do
{ userIdent = "Stephan.Barth@campus.lmu.de"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Nothing
, userEmail = "Stephan.Barth@lmu.de"
@ -355,6 +362,7 @@ fillDb = do
{ userIdent = "AVSID:996699"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Nothing
, userEmail = "E996699@fraport.de"
@ -393,6 +401,7 @@ fillDb = do
{ userIdent = "AVSID:669966"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Nothing
, userEmail = "E669966@fraport.de"
@ -431,6 +440,7 @@ fillDb = do
{ userIdent = "AVSID:6969"
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Nothing
, userEmail = "E6969@fraport.de"
@ -507,6 +517,7 @@ fillDb = do
{ userIdent
, userPasswordHash = Nothing
, userLastAuthentication = Nothing
, userLastSync = Nothing
, userTokensIssuedAfter = Nothing
, userMatrikelnummer = Just userMatrikelnummer'
, userEmail = userEmail'