Feature request: allow to interact with database before setting creds

[c-ding-math]

Imagine the situation: a user, who is logged in via google, also hopes to loggin with github.

We need to go through the following progress: identify the user via his google creds -> add his github creds to database as an unverified creds associated with his id in database -> set the creds and redirect to verify

[pbrisbin]

Hmm, I'm not sure we need do anything in the library to support this. I think it's possible to handle what you describe just fine in your authenticate function. If I were to implement this feature, I'd maintain a separate creds table, with a one-to-many to users. Then you can store any number of Credentials for a given User. Unless I'm missing something, you'll always need some other bit of data to know if a new credential represents an existing user or not. I assume this would be done by email.

Here's a rough sketch of what I'm picturing:

-- config/models
--   User
--     email Text
--     UniqueUser email
--
--   Credential
--     plugin Text
--     identifier Text
--     user UserId
--     UniqueCredential plugin identifier

authenticate Creds {..} = runDB $ do
  mCredential <- getBy $ UniqueCredential credsPlugin credsIdent

  let mEmail = lookupEmailSomehow credsExtra

  case (mCredential, mEmail) of
    -- New credential, but no way to find an existing user. Up to you what to
    -- do here. My hypothetical system requires emails, so I need to error.
    -- Otherwise, you could just make a new User and Credential
    (Nothing, Nothing) -> UserError "Email is required"

    (Nothing, Just email) -> do
      -- If we have an email, we know we can always get a User
      userId <- do
        mUser <- getByEntity $ UniqueUser email

        case mUser of
          -- It's either for a new user we'll create
          Nothing -> insert $ User { userEmail = email }

          -- Or for existing user we found
          Just (Entity userId _) -> pure userId

      -- Either way, we add the new credential
      Authenticated userId <$ insert (Credential credsPlugin credsIdent userId)

    -- Known credential. You should probably also:
    --
    -- - Verify the userId exists in users (though FKs could do that)
    -- - Verify the user's email is the same as the creds email and/or update
    --   and/or append a new email (if your system supports that)
    --
    -- The types only require we return AuthId ~ UserId so:
    (Just (Entity _ Credential {..}), _) -> pure $ Authenticated credentialUser

Am I missing anything? Have you tried this?

[pbrisbin]

I actually know this is possible, because I allow users to log in with GitHub or GitLab on Restyled, and it maintains the single User by either credential. I did this a long time ago and didn't think to do the separate credentials table, so it looks different than what I show above -- but it works.

[c-ding-math]

Thanks for your reply. What I want to do is: If the user is already logged in via some creds, then the new creds will be tried to add to his account. So, I don't need some other bit of data to know if a new credential represents an existing user, I need to know the user's login status after we get the new creds and before the new creds are set.

In the example you give, you in fact treat email as a special loggin method. Think about the situation when the new creds don't contain an email data, or even don't contain any extra data.

Hmm, I'm not sure we need do anything in the library to support this. I think it's possible to handle what you describe just fine in your authenticate function. If I were to implement this feature, I'd maintain a separate creds table, with a one-to-many to users. Then you can store any number of Credentials for a given User. Unless I'm missing something, you'll always need some other bit of data to know if a new credential represents an existing user or not. I assume this would be done by email.

Here's a rough sketch of what I'm picturing:

-- config/models
--   User
--     email Text
--     UniqueUser email
--
--   Credential
--     plugin Text
--     identifier Text
--     user UserId
--     UniqueCredential plugin identifier

authenticate Creds {..} = runDB $ do
  mCredential <- getBy $ UniqueCredential credsPlugin credsIdent

  let mEmail = lookupEmailSomehow credsExtra

  case (mCredential, mEmail) of
    -- New credential, but no way to find an existing user. Up to you what to
    -- do here. My hypothetical system requires emails, so I need to error.
    -- Otherwise, you could just make a new User and Credential
    (Nothing, Nothing) -> UserError "Email is required"

    (Nothing, Just email) -> do
      -- If we have an email, we know we can always get a User
      userId <- do
        mUser <- getByEntity $ UniqueUser email

        case mUser of
          -- It's either for a new user we'll create
          Nothing -> insert $ User { userEmail = email }

          -- Or for existing user we found
          Just (Entity userId _) -> pure userId

      -- Either way, we add the new credential
      Authenticated userId <$ insert (Credential credsPlugin credsIdent userId)

    -- Known credential. You should probably also:
    --
    -- - Verify the userId exists in users (though FKs could do that)
    -- - Verify the user's email is the same as the creds email and/or update
    --   and/or append a new email (if your system supports that)
    --
    -- The types only require we return AuthId ~ UserId so:
    (Just (Entity _ Credential {..}), _) -> pure $ Authenticated credentialUser

Am I missing anything? Have you tried this?

[pbrisbin]

What I want to do is: If the user is already logged in via some creds, then the new creds will be tried to add to his account

Fair enough, can't you just replace getBy $ UniqueUser email with maybeAuthId?

authenticate Creds {..} = do
  mCredential <- runDB $ getBy $ UniqueCredential credsPlugin credsIdent
  mCurrentUserId <- maybeAuthId

  case (mCredential, mCurrentUserId) of
    (Nothing, Nothing) -> -- create a new Credential and User

    (Nothing, Just currentUserId) -> -- add a new Credential to the current User

    (Just (Entity _ Credential {..}), Nothing) -> -- ...
    (Just (Entity _ Credential {..}), Just currentUserId) -> -- ...

I still don't see how yesod-auth-oauth2 needs to be involved in this feature -- in fact, don't you want it to work across any auth plugin, and so must it not be implemented external to them?

[c-ding-math]

You are definitely correct! I thought it was too late to ask maybeAuthId in the authenticate function.

Thanks for making such a nice auth plugin!

What I want to do is: If the user is already logged in via some creds, then the new creds will be tried to add to his account

Fair enough, can't you just replace getBy $ UniqueUser email with maybeAuthId?

authenticate Creds {..} = do
  mCredential <- runDB $ getBy $ UniqueCredential credsPlugin credsIdent
  mCurrentUserId <- maybeAuthId

  case (mCredential, mCurrentUserId) of
    (Nothing, Nothing) -> -- create a new Credential and User

    (Nothing, Just currentUserId) -> -- add a new Credential to the current User

    (Just (Entity _ Credential {..}), Nothing) -> -- ...
    (Just (Entity _ Credential {..}), Just currentUserId) -> -- ...

I still don't see how yesod-auth-oauth2 needs to be involved in this feature -- in fact, don't you want it to work across any auth plugin, and so must it not be implemented external to them?

[pbrisbin]

I thought it was too late to ask maybeAuthId

I actually had the same thought after I posted my message, but I'm glad it works!