chore(auth): enabled ldap lookup for oauth2 creds

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

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{..}
+  $logDebugS "oauth" $ tshow creds
-  -- TODO look user up in DB
+  -- TODO If user not in DB then put
-  -- If not in DB then put (maybe prompt for email)
+  pool <- getsYesod $ view _appLdapPool
-  -- 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
   flip catches excHandlers $ case pool of
     Just ldapPool
       | Just upsertMode' <- upsertMode -> do
-          ldapData <- campusUser ldapPool campusUserFailoverMode Creds{..}
+          ldapData <- campusUser ldapPool campusUserFailoverMode creds
-          $logDebugS "LDAP" $ "Successful LDAP lookup: " <> tshow ldapData
+          $logDebugS "OAuth" $ "Successful LDAP lookup of Azure user: " <> tshow ldapData
-          Authenticated . entityKey <$> upsertCampusUser upsertMode' 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