SCIM onboarding flow again

libs/brig-types/src/Brig/Types/Intra.hs

@@ -26,6 +26,7 @@ module Brig.Types.Intra
     AccountStatusResp (..),
     ConnectionStatus (..),
     UserAccount (..),
+    NewUserScimInvitation (..),
     UserSet (..),
     ReAuthUser (..),
   )
@@ -35,7 +36,7 @@ import Brig.Types.Connection
 import Brig.Types.User
 import Data.Aeson
 import qualified Data.HashMap.Strict as M
-import Data.Id (UserId)
+import Data.Id (TeamId, UserId)
 import Data.Misc (PlainTextPassword (..))
 import qualified Data.Text as Text
 import Imports
@@ -48,6 +49,10 @@ data AccountStatus
   | Suspended
   | Deleted
   | Ephemeral
+  | -- | for most intents & purposes, this is another form of inactive.  it is used for
+    -- allowing scim to find users that have not accepted their invitation yet after
+    -- creating via scim.
+    PendingInvitation
   deriving (Eq, Show, Generic)
 
 instance FromJSON AccountStatus where
@@ -56,13 +61,15 @@ instance FromJSON AccountStatus where
     "suspended" -> pure Suspended
     "deleted" -> pure Deleted
     "ephemeral" -> pure Ephemeral
+    "pending-invitation" -> pure PendingInvitation
     _ -> fail $ "Invalid account status: " ++ Text.unpack s
 
 instance ToJSON AccountStatus where
   toJSON Active = String "active"
   toJSON Suspended = String "suspended"
   toJSON Deleted = String "deleted"
   toJSON Ephemeral = String "ephemeral"
+  toJSON PendingInvitation = String "pending-invitation"
 
 data AccountStatusResp = AccountStatusResp {fromAccountStatusResp :: AccountStatus}
 
@@ -135,6 +142,34 @@ instance ToJSON UserAccount where
       other ->
         error $ "toJSON UserAccount: not an object: " <> show (encode other)
 
+-------------------------------------------------------------------------------
+-- NewUserScimInvitation
+
+data NewUserScimInvitation = NewUserScimInvitation
+  { newUserScimInvTeamId :: TeamId,
+    newUserScimInvLocale :: Maybe Locale,
+    newUserScimInvName :: Name,
+    newUserScimInvEmail :: Email
+  }
+  deriving (Eq, Show, Generic)
+
+instance FromJSON NewUserScimInvitation where
+  parseJSON = withObject "NewUserScimInvitation" $ \o ->
+    NewUserScimInvitation
+      <$> o .: "team_id"
+      <*> o .:? "locale"
+      <*> o .: "name"
+      <*> o .: "email"
+
+instance ToJSON NewUserScimInvitation where
+  toJSON (NewUserScimInvitation tid loc name email) =
+    object
+      [ "team_id" .= tid,
+        "locale" .= loc,
+        "name" .= name,
+        "email" .= email
+      ]
+
 -------------------------------------------------------------------------------
 -- UserList
 

libs/brig-types/test/unit/Test/Brig/Types/User.hs

@@ -27,7 +27,7 @@
 
 module Test.Brig.Types.User where
 
-import Brig.Types.Intra (ReAuthUser (..))
+import Brig.Types.Intra (NewUserScimInvitation (..), ReAuthUser (..))
 import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..))
 import Imports
 import Test.Brig.Roundtrip (testRoundTrip)
@@ -41,7 +41,8 @@ roundtripTests :: [TestTree]
 roundtripTests =
   [ testRoundTrip @ManagedByUpdate,
     testRoundTrip @ReAuthUser,
-    testRoundTrip @RichInfoUpdate
+    testRoundTrip @RichInfoUpdate,
+    testRoundTrip @NewUserScimInvitation
   ]
 
 instance Arbitrary ManagedByUpdate where
@@ -52,3 +53,6 @@ instance Arbitrary RichInfoUpdate where
 
 instance Arbitrary ReAuthUser where
   arbitrary = ReAuthUser <$> arbitrary
+
+instance Arbitrary NewUserScimInvitation where
+  arbitrary = NewUserScimInvitation <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

services/brig/src/Brig/API/Error.hs

@@ -158,6 +158,7 @@ authError AuthInvalidUser = StdError badCredentials
 authError AuthInvalidCredentials = StdError badCredentials
 authError AuthSuspended = StdError accountSuspended
 authError AuthEphemeral = StdError accountEphemeral
+authError AuthPendingInvitation = StdError accountPending
 
 reauthError :: ReAuthError -> Error
 reauthError ReAuthMissingPassword = StdError missingAuthError

services/brig/src/Brig/API/Internal.hs

@@ -35,6 +35,7 @@ import qualified Brig.Data.User as Data
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Provider.API as Provider
 import qualified Brig.Team.API as Team
+import Brig.Team.DB (lookupInvitationByEmail)
 import Brig.Types
 import Brig.Types.Intra
 import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..))
@@ -57,6 +58,7 @@ import Network.Wai.Predicate hiding (result, setStatus)
 import Network.Wai.Routing
 import Network.Wai.Utilities as Utilities
 import Network.Wai.Utilities.ZAuth (zauthConnId, zauthUserId)
+import qualified System.Logger.Class as Log
 import Wire.API.User
 import Wire.API.User.RichInfo
 
@@ -117,6 +119,7 @@ sitemap = do
   get "/i/users" (continue listActivatedAccountsH) $
     accept "application" "json"
       .&. (param "ids" ||| param "handles")
+      .&. def False (query "includePendingInvitations")
 
   get "/i/users" (continue listAccountsByIdentityH) $
     accept "application" "json"
@@ -334,20 +337,40 @@ changeSelfEmailMaybeSend u DoNotSendEmail email = do
     ChangeEmailIdempotent -> pure ChangeEmailResponseIdempotent
     ChangeEmailNeedsActivation _ -> pure ChangeEmailResponseNeedsActivation
 
-listActivatedAccountsH :: JSON ::: Either (List UserId) (List Handle) -> Handler Response
-listActivatedAccountsH (_ ::: qry) = do
-  json <$> lift (listActivatedAccounts qry)
-
-listActivatedAccounts :: Either (List UserId) (List Handle) -> AppIO [UserAccount]
-listActivatedAccounts = \case
-  Left us -> byIds (fromList us)
-  Right hs -> do
-    us <- mapM (API.lookupHandle) (fromList hs)
-    byIds (catMaybes us)
+listActivatedAccountsH :: JSON ::: Either (List UserId) (List Handle) ::: Bool -> Handler Response
+listActivatedAccountsH (_ ::: qry ::: includePendingInvitations) = do
+  json <$> lift (listActivatedAccounts qry includePendingInvitations)
+
+listActivatedAccounts :: Either (List UserId) (List Handle) -> Bool -> AppIO [UserAccount]
+listActivatedAccounts elh includePendingInvitations = do
+  Log.debug (Log.msg $ "listActivatedAccounts: " <> show (elh, includePendingInvitations))
+  case elh of
+    Left us -> byIds (fromList us)
+    Right hs -> do
+      us <- mapM (API.lookupHandle) (fromList hs)
+      byIds (catMaybes us)
   where
-    byIds uids =
-      filter (isJust . userIdentity . accountUser)
-        <$> API.lookupAccounts uids
+    byIds :: [UserId] -> AppIO [UserAccount]
+    byIds uids = API.lookupAccounts uids >>= filterM accountValid
+
+    accountValid :: UserAccount -> AppIO Bool
+    accountValid account = case userIdentity . accountUser $ account of
+      Nothing -> pure False
+      Just ident ->
+        case (accountStatus account, includePendingInvitations, emailIdentity ident) of
+          (PendingInvitation, False, _) -> pure False
+          (PendingInvitation, True, Just email) -> do
+            hasInvitation <- isJust <$> lookupInvitationByEmail email
+            unless hasInvitation $ do
+              -- user invited via scim should expire together with its invitation
+              API.deleteUserNoVerify (userId . accountUser $ account)
+            pure hasInvitation
+          (PendingInvitation, True, Nothing) ->
+            pure True -- cannot happen, user invited via scim always has an email
+          (Active, _, _) -> pure True
+          (Suspended, _, _) -> pure True
+          (Deleted, _, _) -> pure True
+          (Ephemeral, _, _) -> pure True
 
 listAccountsByIdentityH :: JSON ::: Either Email Phone -> Handler Response
 listAccountsByIdentityH (_ ::: emailOrPhone) =

services/brig/src/Brig/API/Public.hs

@@ -39,6 +39,7 @@ import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Provider.API as Provider
 import qualified Brig.Team.API as Team
 import qualified Brig.Team.Email as Team
+import Brig.Types.Activation (ActivationPair)
 import Brig.Types.Intra (AccountStatus (Ephemeral), UserAccount (UserAccount, accountUser))
 import qualified Brig.User.API.Auth as Auth
 import qualified Brig.User.API.Search as Search
@@ -74,6 +75,7 @@ import Network.Wai.Utilities as Utilities
 import Network.Wai.Utilities.Swagger (document, mkSwaggerApi)
 import qualified Network.Wai.Utilities.Swagger as Doc
 import Network.Wai.Utilities.ZAuth (zauthConnId, zauthUserId)
+import qualified System.Logger.Class as Log
 import qualified Wire.API.Connection as Public
 import qualified Wire.API.Properties as Public
 import qualified Wire.API.Swagger as Public.Swagger (models)
@@ -987,6 +989,7 @@ createUser (Public.NewUserPublic new) = do
   for_ (Public.newUserPhone new) $ checkWhitelist . Right
   result <- API.createUser new !>> newUserError
   let acc = createdAccount result
+  lift $ Log.debug (Log.msg $ "createUser: acc: " <> show acc)
   let eac = createdEmailActivation result
   let pac = createdPhoneActivation result
   let epair = (,) <$> (activationKey <$> eac) <*> (activationCode <$> eac)
@@ -1009,13 +1012,15 @@ createUser (Public.NewUserPublic new) = do
     UserAccount _ _ -> lift $ Auth.newCookie @ZAuth.User userId Public.PersistentCookie newUserLabel
   pure $ CreateUserResponse cok userId (Public.SelfProfile usr)
   where
+    sendActivationEmail :: Public.Email -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> AppIO ()
     sendActivationEmail e u p l mTeamUser
       | Just teamUser <- mTeamUser,
         Public.NewTeamCreator creator <- teamUser,
         let Public.BindingNewTeamUser (Public.BindingNewTeam team) _ = creator =
         sendTeamActivationMail e u p l (fromRange $ team ^. Public.newTeamName)
       | otherwise =
         sendActivationMail e u p l Nothing
+
     sendWelcomeEmail :: Public.Email -> CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> AppIO ()
     -- NOTE: Welcome e-mails for the team creator are not dealt by brig anymore
     sendWelcomeEmail e (CreateUserTeam t n) newUser l = case newUser of