chore(auth): userLookupAndUpsert

src/Foundation/Yesod/Auth.hs

@@ -4,7 +4,7 @@
 
 module Foundation.Yesod.Auth
   ( authenticate
-  -- , ldapLookupAndUpsert -- TODO: remove in favour of fetchUserData
+  , userLookupAndUpsert
   , upsertUser
   , decodeUserTest
   , UserConversionException(..)
@@ -114,7 +114,7 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
     | not isDummy, not isOther
     -- , UserAuthConfSingleSource (AuthSourceConfAzureAdV2 upsertUserAzureConf) <- userAuthConf
     , Just upsertMode' <- upsertMode -> do
-        userData <- fetchUserData upsertMode' Creds{..}
+        userData <- fetchUserData Creds{..}
         $logDebugS "Auth" $ "Successful user data lookup: " <> tshow userData
         Authenticated . entityKey <$> upsertUser upsertMode' userData
         -- Authenticated . entityKey <$> upsertUser upsertMode' UpsertUserDataAzure{..}
@@ -169,6 +169,19 @@ _upsertUserMode mMode cs@Creds{..}
     defaultOther = apHash
 
 
+userLookupAndUpsert :: forall m.
+                       ( MonadHandler m
+                       , HandlerSite m ~ UniWorX
+                       , MonadMask m
+                       , MonadUnliftIO m
+                       )
+                    => Text
+                    -> UpsertUserMode
+                    -> SqlPersistT m (Entity User)
+userLookupAndUpsert credsIdent mode =
+  fetchUserData Creds{credsPlugin=mempty,credsExtra=mempty,..} >>= upsertUser mode
+
+
 data FetchUserDataException
   = FetchUserDataNoResult
   | FetchUserDataAmbiguous
@@ -176,24 +189,6 @@ data FetchUserDataException
   deriving (Eq, Ord, Read, Show, Generic)
   deriving anyclass (Exception)
 
--- TODO: deprecate in favour of fetchUserData
--- ldapLookupAndUpsert :: forall m.
---                        ( MonadHandler m
---                        , HandlerSite m ~ UniWorX
---                        , MonadMask m
---                        , MonadUnliftIO m
---                        )
---                     => Text
---                     -> SqlPersistT m (Entity User)
--- ldapLookupAndUpsert ident = 
---   getsYesod (view _appLdapPool) >>= \case 
---     Nothing -> throwM $ LdapUserLdapError $ LdapHostNotResolved "No LDAP configuration in Foundation."
---     Just ldapPool ->
---       ldapUser'' ldapPool ident >>= \case
---         Nothing -> throwM LdapUserNoResult
---         Just ldapData -> upsertUser UpsertUserGuessUser ldapData
-
-
 -- | Fetch user data with given credentials from external source(s)
 fetchUserData :: forall m site.
                  ( MonadHandler m
@@ -202,10 +197,9 @@ fetchUserData :: forall m site.
                  , MonadMask m
                  , MonadUnliftIO m
                  )
-              => UpsertUserMode
+              => Creds site
-              -> Creds site
               -> SqlPersistT m (NonEmpty UpsertUserData)
-fetchUserData _upsertMode creds@Creds{..} = do
+fetchUserData creds@Creds{..} = do
   userAuthConf <- getsYesod $ view _appUserAuthConf
   now <- liftIO getCurrentTime