chore(auth): switch back to AuthId UniWorX == UserId

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 user
-    UniqueInternalAuth ident
     deriving Show Eq Ord Generic

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
 

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

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

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 :: MonadIO m => UserId -> SqlPersistT m ()
-associateUserSchoolsByTerms uaid = do
+associateUserSchoolsByTerms uid = do
-  uid <- join $ fmap (fromMaybe $ error "associateUserSchoolsByTerms: No User for given UserAuthId!") . getKeyBy . UniqueUser . userAuthIdent <$> getJust uaid
   sfs <- selectList [StudyFeaturesUser ==. uid] []
 
   forM_ sfs $ \(Entity _ StudyFeatures{..}) -> do