From cf89722c7fd47c0d0202bbaf44779ca847f18c61 Mon Sep 17 00:00:00 2001
From: David Mosbach <mosbach@cip.ifi.lmu.de>
Date: Mon, 4 Dec 2023 00:32:01 +0000
Subject: [PATCH] chore(auth): enabled ldap lookup for oauth2 creds

---
 src/Foundation/Instances.hs  |  4 +++-
 src/Foundation/Yesod/Auth.hs | 36 +++++++++++++++++++++++-------------
 2 files changed, 26 insertions(+), 14 deletions(-)

diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs
index 0b3e23892..79fefdccf 100644
--- a/src/Foundation/Instances.hs
+++ b/src/Foundation/Instances.hs
@@ -139,7 +139,9 @@ instance YesodAuth UniWorX where
         setTitleI MsgLoginTitle
         $(widgetFile "login")
 
-    authenticate = UniWorX.oAuthenticate -- UniWorX.authenticate
+    authenticate c@Creds{..}
+      | credsPlugin `elem` ["azureadv2", "uniworx_dev"] = UniWorX.oAuthenticate c
+      | otherwise                                       = UniWorX.authenticate c
 
     authPlugins UniWorX{ appSettings' = AppSettings{..}, appLdapPool, appAuthPlugins } = appAuthPlugins ++ catMaybes
       [ flip campusLogin campusUserFailoverMode <$> appLdapPool
diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs
index d01605495..2bd046479 100644
--- a/src/Foundation/Yesod/Auth.hs
+++ b/src/Foundation/Yesod/Auth.hs
@@ -182,23 +182,17 @@ oAuthenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
           | not isDummy -> res <$ update uid [ UserLastAuthentication =. Just now ]
         _other -> return res
 
-  $logDebugS "oauth" $ tshow Creds{..}
-  -- TODO look user up in DB
-  -- If not in DB then put (maybe prompt for email)
-  -- If in DB but first time oauth then prompt for password & update entry
-  -- Now user should be in DB -> authenticated
-  flip catches excHandlers $ case upsertMode of
-    Just upsertMode' -> error $ show upsertMode' --TODO
-    Nothing -> error "nothing" --TODO
-  {-pool <- getsYesod $ view _appLdapPool
+  $logDebugS "oauth" $ tshow creds
+  -- TODO If user not in DB then put
+  pool <- getsYesod $ view _appLdapPool
   flip catches excHandlers $ case pool of
     Just ldapPool
       | Just upsertMode' <- upsertMode -> do
-          ldapData <- campusUser ldapPool campusUserFailoverMode Creds{..}
-          $logDebugS "LDAP" $ "Successful LDAP lookup: " <> tshow ldapData
-          Authenticated . entityKey <$> upsertCampusUser upsertMode' ldapData
+          ldapData <- campusUser ldapPool campusUserFailoverMode creds
+          $logDebugS "OAuth" $ "Successful LDAP lookup of Azure user: " <> tshow ldapData
+          Authenticated . entityKey <$> upsertAzureUser upsertMode' ldapData
     _other
-      -> acceptExisting-}
+      -> acceptExisting
 
 
 
@@ -267,6 +261,22 @@ ldapLookupAndUpsert ident =
         Nothing -> throwM CampusUserNoResult
         Just ldapResponse -> upsertCampusUser UpsertCampusUserGuessUser ldapResponse
 
+
+upsertAzureUser :: forall m.
+                   ( MonadHandler m, HandlerSite m ~ UniWorX
+                   , MonadCatch m
+                   )
+                => UpsertAzureUserMode -> Ldap.AttrList [] -> SqlPersistT m (Entity User) -- TODO UpsertAzureUserMode is probably redundant
+upsertAzureUser upsertMode = upsertCampusUser (toCampus upsertMode)
+  where
+    toCampus :: UpsertAzureUserMode -> UpsertCampusUserMode
+    toCampus  UpsertAzureUserLoginOAuth    = UpsertCampusUserLoginLdap
+    toCampus (UpsertAzureUserLoginDummy u) = UpsertCampusUserLoginDummy u
+    toCampus (UpsertAzureUserLoginOther u) = UpsertCampusUserLoginOther u
+    toCampus (UpsertAzureUserOAuthSync  u) = UpsertCampusUserLdapSync u
+    toCampus  UpsertAzureUserGuessUser     = UpsertCampusUserGuessUser
+
+
 {- THIS FUNCION JUST DECODES, BUT IT DOES NOT QUERY LDAP!
 upsertCampusUserByCn :: forall m.
                         ( MonadHandler m, HandlerSite m ~ UniWorX