diff --git a/models/auth.model b/models/auth.model index 147fefa9b..4f0420ecf 100644 --- a/models/auth.model +++ b/models/auth.model @@ -31,28 +31,18 @@ AuthSourceLdap deriving Show Eq Ord Generic --- | User authentication data, source-agnostic data -UserAuth - ident UserIdent -- Human-readable text uniquely identifying a user - lastLogin UTCTime Maybe -- When did the corresponding User last authenticate using this entry? - lastSync UTCTime Maybe -- When was the corresponding User entry last synced with any external source? - Primary ident - UniqueAuthentication ident - deriving Show Eq Ord Generic - -- | User authentication data fetched from external user sources ExternalAuth - ident UserIdent + user UserId source AuthenticationSourceIdent -- Identifier of the external source in the config data Value "default='{}'::jsonb" -- Raw user data from external source lastSync UTCTime -- When was the corresponding User entry last synced with this external source? -- TODO rethink - UniqueExternalAuth ident source -- At most one entry of this user per source + UniqueExternalAuth user source -- At most one entry of this user per source deriving Show Eq Ord Generic -- | FraDrive-specific user authentication data, internal logins have precedence over external authentication InternalAuth - ident UserIdent + user UserId hash Text -- Hashed password - Primary ident - UniqueInternalAuth ident + UniqueInternalAuth user deriving Show Eq Ord Generic diff --git a/models/users.model b/models/users.model index 739b73688..901d30bd9 100644 --- a/models/users.model +++ b/models/users.model @@ -47,7 +47,8 @@ User json -- Each Uni2work user has a corresponding row in this table; create prefersPostal Bool default=false -- user prefers letters by post instead of email examOfficeGetSynced Bool default=true -- whether synced status should be displayed for exam results by default examOfficeGetLabels Bool default=true -- whether labels should be displayed for exam results by default - UniqueUser ident -- Column 'ident' can be used as a row-key in this table + lastLogin UTCTime Maybe -- When did the user last authenticate? + UniqueAuthentication ident -- Column 'ident' can be used as a row-key in this table UniqueEmail email -- Column 'email' can be used as a row-key in this table deriving Show Eq Ord Generic -- Haskell-specific settings for runtime-value representing a row in memory diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index 8dfef326b..fdb85bc8a 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -73,7 +73,7 @@ hashLogin pwHashAlgo = AuthPlugin{..} Just (Entity _ InternalAuth{..}) | verifyPasswordWith pwHashAlgo (2^) (encodeUtf8 hashPassword) (encodeUtf8 internalAuthHash) -> do -- (2^) is magic. observeLoginOutcome apName LoginSuccessful - setCredsRedirect $ Creds apName (CI.original internalAuthIdent) [] + setCredsRedirect $ Creds apName (CI.original internalAuthUser) [] other -> do $logDebugS apName $ tshow other observeLoginOutcome apName LoginInvalidCredentials diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs index 9a8c15327..a217bf91c 100644 --- a/src/Foundation/Instances.hs +++ b/src/Foundation/Instances.hs @@ -121,7 +121,7 @@ instance YesodPersistRunner UniWorX where instance YesodAuth UniWorX where - type AuthId UniWorX = UserAuthId + type AuthId UniWorX = UserId -- Where to send a user after successful login loginDest _ = NewsR @@ -172,7 +172,6 @@ instance YesodAuth UniWorX where BearerToken{..} <- MaybeT . liftHandler $ runDBRead maybeBearerToken hoistMaybe bearerImpersonate --- TODO: update to new AuthId! instance YesodAuthPersist UniWorX where getAuthEntity :: (HasCallStack, MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (Maybe User) getAuthEntity = liftHandler . runDBRead . get diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 975b2b825..d805aba9f 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -45,7 +45,7 @@ import qualified Ldap.Client as Ldap authenticate :: ( MonadHandler m, HandlerSite m ~ UniWorX , YesodPersist UniWorX, BackendCompatible SqlBackend (YesodPersistBackend UniWorX) - , YesodAuth UniWorX, UserAuthId ~ AuthId UniWorX + , YesodAuth UniWorX, UserId ~ AuthId UniWorX ) => Creds UniWorX -> m (AuthenticationResult UniWorX) @@ -77,6 +77,7 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend = return res excHandlers = + -- TODO: merge ldap and azure exception types [ C.Handler $ \(ldapExc :: LdapUserException) -> case ldapExc of LdapUserNoResult -> do $logWarnS "Auth" $ "LDAP user lookup failed after successful login for " <> credsIdent @@ -116,7 +117,7 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend -> return () case res of Authenticated uid - | not isDummy -> res <$ update uid [ UserAuthLastLogin =. Just now ] + | not isDummy -> res <$ update uid [ UserLastLogin =. Just now ] _other -> return res $logDebugS "Auth" $ tshow Creds{..} @@ -691,9 +692,8 @@ decodeUser now UserDefaultConf{..} upsertData = do -- vs = Text.decodeUtf8' <$> (azureMap !!! attr) -associateUserSchoolsByTerms :: MonadIO m => UserAuthId -> SqlPersistT m () -associateUserSchoolsByTerms uaid = do - uid <- join $ fmap (fromMaybe $ error "associateUserSchoolsByTerms: No User for given UserAuthId!") . getKeyBy . UniqueUser . userAuthIdent <$> getJust uaid +associateUserSchoolsByTerms :: MonadIO m => UserId -> SqlPersistT m () +associateUserSchoolsByTerms uid = do sfs <- selectList [StudyFeaturesUser ==. uid] [] forM_ sfs $ \(Entity _ StudyFeatures{..}) -> do