content: {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
  
  -- This file is part of the Wire Server implementation.
  --
  -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
  --
  -- This program is free software: you can redistribute it and/or modify it under
  -- the terms of the GNU Affero General Public License as published by the Free
  -- Software Foundation, either version 3 of the License, or (at your option) any
  -- later version.
  --
  -- This program is distributed in the hope that it will be useful, but WITHOUT
  -- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  -- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
  -- details.
  --
  -- You should have received a copy of the GNU Affero General Public License along
  -- with this program. If not, see <https://www.gnu.org/licenses/>.
  
  module API.User.Account
    ( tests,
    )
  where
  
  import API.Search.Util qualified as Search
  import API.Team.Util
  import API.User.Util
  import Bilge hiding (accept, timeout)
  import Bilge.Assert
  import Brig.AWS qualified as AWS
  import Brig.AWS.Types
  import Brig.Options qualified as Opt
  import Brig.Types.Activation
  import Brig.Types.Intra
  import Control.Arrow ((&&&))
  import Control.Exception (throw)
  import Control.Lens (ix, preview, (^.), (^?))
  import Control.Monad.Catch
  import Data.Aeson
  import Data.Aeson qualified as Aeson
  import Data.Aeson.Lens
  import Data.Aeson.Lens qualified as AesonL
  import Data.ByteString qualified as C8
  import Data.ByteString.Char8 (pack)
  import Data.ByteString.Conversion
  import Data.Domain
  import Data.Handle
  import Data.Id
  import Data.Json.Util (fromUTCTimeMillis)
  import Data.LegalHold
  import Data.List.NonEmpty qualified as NonEmpty
  import Data.List1 (singleton)
  import Data.Mailbox
  import Data.Misc (plainTextPassword6Unsafe)
  import Data.Proxy
  import Data.Qualified
  import Data.Range
  import Data.Set qualified as Set
  import Data.String.Conversions
  import Data.Text qualified as T
  import Data.Text qualified as Text
  import Data.Text.Encoding qualified as T
  import Data.UUID qualified as UUID
  import Data.UUID.V4 qualified as UUID
  import Federator.MockServer (FederatedRequest (..), MockException (..))
  import Imports hiding (head)
  import Imports qualified
  import Network.HTTP.Types qualified as HTTP
  import Network.HTTP.Types qualified as Http
  import Network.Wai qualified as Wai
  import Network.Wai.Utilities.Error qualified as Error
  import Network.Wai.Utilities.Error qualified as Wai
  import Test.QuickCheck (arbitrary, generate)
  import Test.Tasty hiding (Timeout)
  import Test.Tasty.Cannon hiding (Cannon, Timeout)
  import Test.Tasty.Cannon qualified as WS
  import Test.Tasty.HUnit
  import UnliftIO (mapConcurrently_)
  import Util
  import Util.AWS as Util
  import Util.Timeout
  import Web.Cookie (parseSetCookie)
  import Wire.API.Asset hiding (Asset)
  import Wire.API.Asset qualified as Asset
  import Wire.API.Connection
  import Wire.API.Conversation
  import Wire.API.Routes.MultiTablePaging
  import Wire.API.Team.Feature
  import Wire.API.Team.Invitation
  import Wire.API.Team.Permission hiding (self)
  import Wire.API.User
  import Wire.API.User.Activation
  import Wire.API.User.Auth
  import Wire.API.User.Auth qualified as Auth
  import Wire.API.User.Client
  
  tests :: ConnectionLimit -> Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> CargoHold -> Galley -> AWS.Env -> UserJournalWatcher -> TestTree
  tests _ at opts p b c ch g aws userJournalWatcher =
    testGroup
      "account"
      [ test p "post /register - 201 (with preverified)" $ testCreateUserWithPreverified opts b userJournalWatcher,
        test p "testCreateUserWithInvalidVerificationCode - post /register - 400 (with preverified)" $ testCreateUserWithInvalidVerificationCode b,
        test p "post /register - 201" $ testCreateUser b g,
        test p "post /register - 201 anonymous" $ testCreateUserAnon b g,
        test p "testCreateUserEmptyName - post /register - 400 empty name" $ testCreateUserEmptyName b,
        test p "testCreateUserLongName - post /register - 400 name too long" $ testCreateUserLongName b,
        test p "post /register - 201 anonymous expiry" $ testCreateUserAnonExpiry b,
        test p "post /register - 201 pending" $ testCreateUserPending opts b,
        test p "testCreateUserConflict - post /register - 409 conflict" $ testCreateUserConflict opts b,
        test p "testCreateUserInvalidEmail - post /register - 400 invalid input" $ testCreateUserInvalidEmail opts b,
        test p "post /register - 403 blacklist" $ testCreateUserBlacklist opts b aws,
        test p "post /register - 400 external-SSO" $ testCreateUserExternalSSO b,
        test p "post /register - 403 restricted user creation" $ testRestrictedUserCreation opts b,
        test p "post /register - 403 too many members for legalhold" $ testTooManyMembersForLegalhold opts b,
        test p "post /activate - 200/204 + expiry" $ testActivateWithExpiry opts b at,
        test p "get /users/:uid - 404" $ testNonExistingUserUnqualified b,
        test p "get /users/<localdomain>/:uid - 404" $ testNonExistingUser b,
        test p "get /users/:domain/:uid - 422" $ testUserInvalidDomain b,
        test p "get /users/:uid - 200" $ testExistingUserUnqualified b,
        test p "get /users/<localdomain>/:uid - 200" $ testExistingUser b,
        test p "get /users?:id=.... - 200" $ testMultipleUsersUnqualified b,
        test p "head /users/:uid - 200" $ testUserExistsUnqualified b,
        test p "head /users/:uid - 404" $ testUserDoesNotExistUnqualified b,
        test p "head /users/:domain/:uid - 200" $ testUserExists b,
        test p "head /users/:domain/:uid - 404" $ testUserDoesNotExist b,
        test p "post /list-users@v3 - 200" $ testMultipleUsersV3 b,
        test p "post /list-users - 200" $ testMultipleUsers opts b,
        test p "put /self - 200" $ testUserUpdate b c userJournalWatcher,
        test p "put /access/self/email - 2xx" $ testEmailUpdate b userJournalWatcher,
        test p "head /self/password - 200/404" $ testPasswordSet b,
        test p "put /self/password - 400" $ testPasswordSetInvalidPasswordLength b,
        test p "put /self/password - 403 (anon user)" $ testPasswordChangeAnonUser b,
        test p "put /self/locale - 200" $ testUserLocaleUpdate b userJournalWatcher,
        test p "post /activate/send - 200" $ testSendActivationCode opts b,
        test p "post /activate/send - 400 invalid input" $ testSendActivationCodeInvalidEmailOrPhone b,
        test p "put /i/users/:uid/status (suspend)" $ testSuspendUser b,
        test p "get /i/users?:email - 200" $ testGetByIdentity b,
        -- "get /i/users?:ids=...&includePendingInvitations=..." is tested in 'testCreateUserNoIdP', 'testCreateUserTimeout'
        -- in spar's integration tests, module "Test.Spar.Scim.UserSpec"
        test p "delete/by-password" $ testDeleteUserByPassword b c userJournalWatcher,
        test p "delete/with-legalhold" $ testDeleteUserWithLegalHold b c userJournalWatcher,
        test p "delete/by-code" $ testDeleteUserByCode b,
        test p "delete/anonymous" $ testDeleteAnonUser b,
        test p "delete with profile pic" $ testDeleteWithProfilePic b ch,
        test p "put /i/users/:uid/sso-id" $ testUpdateSSOId b g,
        testGroup
          "update user email by team owner"
          [ test p "put /users/:uid/email" $ testUpdateUserEmailByTeamOwner opts b
          ],
        testGroup
          "delete /i/users/:uid"
          [ test p "does nothing for completely deleted user" $ testDeleteUserWithCompletelyDeletedUser b c userJournalWatcher,
            test p "does nothing when the user doesn't exist" $ testDeleteUserWithNoUser b,
            test p "deletes a not deleted user" $ testDeleteUserWithNotDeletedUser b c userJournalWatcher,
            test p "delete again because of dangling property" $ testDeleteUserWithDanglingProperty b c userJournalWatcher
          ]
      ]
  
  -- The testCreateUserWithInvalidVerificationCode test conforms to the following testing standards:
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  --
  -- Registering with an invalid verification code and valid account details should fail.
  testCreateUserWithInvalidVerificationCode :: Brig -> Http ()
  testCreateUserWithInvalidVerificationCode brig = do
    -- Attempt to register (pre verified) user with email
    e <- randomEmail
    code <- randomActivationCode -- incorrect but syntactically valid activation code
    let Object regEmail =
          object
            [ "name" .= Name "Alice",
              "email" .= fromEmail e,
              "email_code" .= code
            ]
    postUserRegister' regEmail brig !!! const 404 === statusCode
  
  -- @END
  
  testUpdateUserEmailByTeamOwner :: Opt.Opts -> Brig -> Http ()
  testUpdateUserEmailByTeamOwner opts brig = do
    (_, teamOwner, emailOwner : otherTeamMember : _) <- createPopulatedBindingTeamWithNamesAndHandles brig 2
    (teamOwnerDifferentTeam, _) <- createUserWithTeam' brig
    newEmail <- randomEmail
    _ <- initiateEmailUpdate brig newEmail (userId emailOwner)
    checkActivationCode newEmail True
    checkLetActivationExpire newEmail
    checkActivationCode newEmail False
    checkSetUserEmail teamOwner emailOwner newEmail 200
    checkActivationCode newEmail True
    checkUnauthorizedRequests emailOwner otherTeamMember teamOwnerDifferentTeam newEmail
    activateEmail brig newEmail
    -- apparently activating the email does not invalidate the activation code
    -- therefore we let the activation code expire again
    checkLetActivationExpire newEmail
    checkSetUserEmail teamOwner emailOwner newEmail 200
    checkActivationCode newEmail False
    checkUnauthorizedRequests emailOwner otherTeamMember teamOwnerDifferentTeam newEmail
    checkActivationCode newEmail False
    where
      checkLetActivationExpire :: EmailAddress -> Http ()
      checkLetActivationExpire email = do
        let timeout = round opts.settings.activationTimeout
        threadDelay ((timeout + 1) * 1000_000)
        checkActivationCode email False
  
      checkActivationCode :: EmailAddress -> Bool -> Http ()
      checkActivationCode email shouldExist = do
        maybeActivationCode <- Util.getActivationCode brig (Left email)
        void $
          lift $
            if shouldExist
              then assertBool "activation code should exists" (isJust maybeActivationCode)
              else assertBool "activation code should not exists" (isNothing maybeActivationCode)
  
      checkSetUserEmail :: User -> User -> EmailAddress -> Int -> Http ()
      checkSetUserEmail teamOwner emailOwner email expectedStatusCode =
        setUserEmail brig (userId teamOwner) (userId emailOwner) email !!! (const expectedStatusCode === statusCode)
  
      checkUnauthorizedRequests :: User -> User -> User -> EmailAddress -> Http ()
      checkUnauthorizedRequests emailOwner otherTeamMember teamOwnerDifferentTeam email = do
        setUserEmail brig (userId teamOwnerDifferentTeam) (userId emailOwner) email !!! (const 404 === statusCode)
        setUserEmail brig (userId otherTeamMember) (userId emailOwner) email !!! (const 403 === statusCode)
  
  testCreateUserWithPreverified :: Opt.Opts -> Brig -> UserJournalWatcher -> Http ()
  testCreateUserWithPreverified opts brig userJournalWatcher = do
    -- Register (pre verified) user with email
    e <- randomEmail
    let emailReq = RequestBodyLBS . encode $ object ["email" .= fromEmail e]
    post (brig . path "/activate/send" . contentJson . body emailReq)
      !!! (const 200 === statusCode)
    getActivationCode brig (Left e) >>= \case
      Nothing -> liftIO $ assertFailure "missing activation key/code"
      Just (_, c) -> do
        let Object reg =
              object
                [ "name" .= Name "Alice",
                  "email" .= fromEmail e,
                  "email_code" .= c
                ]
        if opts.settings.restrictUserCreation == Just True
          then do
            postUserRegister' reg brig !!! const 403 === statusCode
          else do
            usr <- postUserRegister reg brig
            let uid = userId usr
            get (brig . path "/self" . zUser uid) !!! do
              const 200 === statusCode
              const (Just e) === (userEmail <=< responseJsonMaybe)
            Util.assertUserActivateJournaled userJournalWatcher usr "user activate"
  
  testCreateUser :: Brig -> Galley -> Http () -- TODO: this has nothing to do with /register.  what's going on here?
  testCreateUser brig galley = do
    uid <- userId <$> randomUser brig
    assertOnlySelfConversations galley uid
  
  assertOnlySelfConversations :: Galley -> UserId -> Http ()
  assertOnlySelfConversations galley uid = do
    page :: ConvIdsPage <-
      responseJsonError
        =<< post
          ( galley
              . paths ["conversations", "list-ids"]
              . json
                ( GetPaginatedConversationIds Nothing (toRange (Proxy @100)) ::
                    GetPaginatedConversationIds
                )
              . zAuthAccess uid "conn"
          )
          <!! const 200 === statusCode
  
    let results = mtpResults page
    -- check number of conversations
    liftIO $ length results @?= 2
  
    -- check conversation type
    r <-
      responseJsonError
        =<< post
          ( galley
              . zAuthAccess uid "conn"
              . paths ["conversations", "list"]
              . json (ListConversations (unsafeRange results))
          )
          <!! const 200 === statusCode
    for_ (crFound r) $ \conv ->
      liftIO $ cnvType conv @?= SelfConv
  
  -- The testCreateUserEmptyName test conforms to the following testing standards:
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  --
  -- An empty name is not allowed on registration
  testCreateUserEmptyName :: Brig -> Http ()
  testCreateUserEmptyName brig = do
    let p =
          RequestBodyLBS . encode $
            object
              ["name" .= ("" :: Text)]
    post
      ( brig
          . path "/register"
          . contentJson
          . body p
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! const 400 === statusCode
  
  -- @END
  
  -- The testCreateUserLongName test conforms to the following testing standards:
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  --
  -- a name with > 128 characters is not allowed.
  testCreateUserLongName :: Brig -> Http ()
  testCreateUserLongName brig = do
    let nameTooLong = cs $ concat $ replicate 129 "a"
    let p =
          RequestBodyLBS . encode $
            object
              ["name" .= (nameTooLong :: Text)]
    post
      ( brig
          . path "/register"
          . contentJson
          . body p
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! const 400 === statusCode
  
  -- @END
  
  testCreateUserAnon :: Brig -> Galley -> Http ()
  testCreateUserAnon brig galley = do
    let p =
          RequestBodyLBS . encode $
            object
              ["name" .= ("Mr. Pink" :: Text)]
    rs <-
      post
        ( brig
            . path "/register"
            . contentJson
            . body p
            . header "X-Forwarded-For" "127.0.0.42"
        )
        <!! const 201 === statusCode
    -- Every registered user gets a cookie.
    let zuid = parseSetCookie <$> getHeader "Set-Cookie" rs
    liftIO $ assertBool "Missing zuid cookie" (isJust zuid)
    -- Every registered user gets two self conversations.
    let Just uid = userId <$> responseJsonMaybe rs
        Just quid = userQualifiedId <$> responseJsonMaybe rs
    assertOnlySelfConversations galley uid
    -- should not appear in search
    suid <- userId <$> randomUser brig
    Search.refreshIndex brig
    Search.assertCan'tFind brig suid quid "Mr. Pink"
  
  testCreateUserPending :: Opt.Opts -> Brig -> Http ()
  testCreateUserPending (Opt.restrictUserCreation . Opt.settings -> Just True) _ = pure ()
  testCreateUserPending _ brig = do
    e <- randomEmail
    let p =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("Mr. Pink" :: Text),
                "email" .= fromEmail e,
                "password" .= defPassword
              ]
    rs <-
      post
        ( brig
            . path "/register"
            . contentJson
            . body p
            . header "X-Forwarded-For" "127.0.0.42"
        )
        <!! const 201 === statusCode
    -- Even though activation is pending, the user gets an access cookie,
    -- i.e. every user starts out as a "Wireless" user.
    let zuid = parseSetCookie <$> getHeader "Set-Cookie" rs
    liftIO $ assertBool "Missing zuid cookie" (isJust zuid)
    -- Cannot login via email (pending activation)
    login brig (defEmailLogin e) PersistentCookie !!! do
      const 403 === statusCode
      const (Just "pending-activation") === fmap Error.label . responseJsonMaybe
    -- The user has no verified / activated identity yet
    let Just uid = userId <$> responseJsonMaybe rs
        Just quid = userQualifiedId <$> responseJsonMaybe rs
    get (brig . path "/self" . zUser uid) !!! do
      const 200 === statusCode
      const (Just True) === \rs' -> do
        self <- responseJsonMaybe rs'
        pure $! isNothing (userIdentity (selfUser self))
    -- should not appear in search
    suid <- userId <$> randomUser brig
    Search.refreshIndex brig
    Search.assertCan'tFind brig suid quid "Mr. Pink"
  
  -- The testCreateUserConflict test conforms to the following testing standards:
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  --
  -- email address must not be taken on @/register@.
  testCreateUserConflict :: Opt.Opts -> Brig -> Http ()
  testCreateUserConflict (Opt.restrictUserCreation . Opt.settings -> Just True) _ = pure ()
  testCreateUserConflict _ brig = do
    -- trusted email domains
    u <- createUser "conflict" brig
    let p =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("conflict1" :: Text),
                "email" .= (fromEmail <$> userEmail u), -- dup. email
                "password" .= defPassword
              ]
    post
      ( brig
          . path "/register"
          . contentJson
          . body p
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! do
        const 409 === statusCode
        const (Just "key-exists") === fmap Error.label . responseJsonMaybe
    -- untrusted email domains
    u2 <- createUserUntrustedEmail "conflict" brig
    let Just email = userEmail u2
        dom = T.decodeUtf8 $ domainPart email
        loc = T.decodeUtf8 $ localPart email
    let p2 =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("conflict2" :: Text),
                "email" .= (T.takeWhile (/= '+') loc <> "@" <> dom), -- dup. email
                "password" .= defPassword
              ]
    post
      ( brig
          . path "/register"
          . contentJson
          . body p2
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! do
        const 409 === statusCode
        const (Just "key-exists") === fmap Error.label . responseJsonMaybe
  
  -- @END
  
  -- The testCreateUserInvalidEmail test conforms to the following testing standards:
  -- @SF.Provisioning @TSFI.RESTfulAPI @S2
  --
  -- Test to make sure a new user cannot be created with an invalid email address
  testCreateUserInvalidEmail :: Opt.Opts -> Brig -> Http ()
  testCreateUserInvalidEmail (Opt.restrictUserCreation . Opt.settings -> Just True) _ = pure ()
  testCreateUserInvalidEmail _ brig = do
    let reqPhone =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("foo" :: Text),
                "email" .= ("invalid@" :: Text),
                "password" .= defPassword
              ]
    post
      ( brig
          . path "/register"
          . contentJson
          . body reqPhone
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! const 400 === statusCode
  
  -- @END
  
  testCreateUserBlacklist :: Opt.Opts -> Brig -> AWS.Env -> Http ()
  testCreateUserBlacklist (Opt.restrictUserCreation . Opt.settings -> Just True) _ _ = pure ()
  testCreateUserBlacklist _ brig aws =
    mapM_ ensureBlacklist ["bounce", "complaint"]
    where
      ensureBlacklist typ = do
        e <- randomEmail
        flip finally (removeBlacklist brig e) $ do
          post
            ( brig
                . path "/register"
                . contentJson
                . body (p e)
                . header "X-Forwarded-For" "127.0.0.42"
            )
            !!! const 201 === statusCode
          -- If we are using a local env, we need to fake this bounce
          unless (Util.isRealSESEnv aws) $
            forceBlacklist typ e
          -- Typically bounce/complaint messages arrive instantaneously
          awaitBlacklist 30 e
          post
            ( brig
                . path "/register"
                . contentJson
                . body (p e)
                . header "X-Forwarded-For" "127.0.0.42"
            )
            !!! do
              const 403 === statusCode
              const (Just "blacklisted-email") === fmap Error.label . responseJsonMaybe
      p email =
        RequestBodyLBS . encode $
          object
            [ "name" .= ("Alice" :: Text),
              "email" .= email,
              "password" .= defPassword
            ]
      -- If there is no queue available, we need to force it either by publishing an event or using the API
      forceBlacklist :: Text -> EmailAddress -> Http ()
      forceBlacklist typ em = case aws ^. AWS.sesQueue of
        Just queue -> publishMessage typ em queue
        Nothing -> Bilge.post (brig . path "i/users/blacklist" . queryItem "email" (toByteString' em)) !!! const 200 === statusCode
      publishMessage :: Text -> EmailAddress -> Text -> Http ()
      publishMessage typ em queue = do
        let bdy = encode $ case typ of
              "bounce" -> MailBounce BouncePermanent [Mailbox Nothing em]
              "complaint" -> MailComplaint [Mailbox Nothing em]
              x -> error ("Unsupported message type: " ++ show x)
        void . AWS.execute aws $ AWS.enqueueStandard queue bdy
      awaitBlacklist :: Int -> EmailAddress -> Http ()
      awaitBlacklist n e = do
        r <- Bilge.head (brig . path "i/users/blacklist" . queryItem "email" (toByteString' e))
        when (statusCode r == 404 && n > 0) $ do
          liftIO $ threadDelay 1000000
          awaitBlacklist (n - 1) e
  
  testCreateUserExternalSSO :: Brig -> Http ()
  testCreateUserExternalSSO brig = do
    teamid <- Id <$> liftIO UUID.nextRandom
    let ssoid = UserSSOId mkSimpleSampleUref
        p withsso withteam =
          RequestBodyLBS . encode . object $
            ["name" .= ("foo" :: Text)]
              <> ["sso_id" .= Just ssoid | withsso]
              <> ["team_id" .= Just teamid | withteam]
    post
      ( brig
          . path "/register"
          . contentJson
          . body (p False True)
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! const 400 === statusCode
    post
      ( brig
          . path "/register"
          . contentJson
          . body (p True False)
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! const 400 === statusCode
    post
      ( brig
          . path "/register"
          . contentJson
          . body (p True True)
          . header "X-Forwarded-For" "127.0.0.42"
      )
      !!! const 400 === statusCode
  
  testActivateWithExpiry :: Opt.Opts -> Brig -> Timeout -> Http ()
  testActivateWithExpiry (Opt.restrictUserCreation . Opt.settings -> Just True) _ _ = pure ()
  testActivateWithExpiry _ brig timeout = do
    u <- responseJsonError =<< registerUser "dilbert" brig
    let email = fromMaybe (error "missing email") (userEmail u)
    act <- getActivationCode brig (Left email)
    case act of
      Nothing -> liftIO $ assertFailure "activation key/code not found"
      Just kc -> do
        activate brig kc !!! do
          const 200 === statusCode
          const (Just (userIdentity u, True)) === actualBody
        -- Note: This value must be larger than the option passed as `activation-timeout`
        awaitExpiry (round timeout + 5) kc
        activate brig kc !!! const 404 === statusCode
    where
      actualBody :: (HasCallStack) => ResponseLBS -> Maybe (Maybe UserIdentity, Bool)
      actualBody rs = do
        a <- responseJsonMaybe rs
        Just (Just (activatedIdentity a), activatedFirst a)
      awaitExpiry :: (HasCallStack) => Int -> ActivationPair -> Http ()
      awaitExpiry n kc = do
        liftIO $ threadDelay 1000000
        r <- activate brig kc
        when (statusCode r == 204 && n > 0) $
          awaitExpiry (n - 1) kc
  
  testNonExistingUserUnqualified :: Brig -> Http ()
  testNonExistingUserUnqualified brig = do
    findingOne <- liftIO $ Id <$> UUID.nextRandom
    foundOne <- liftIO $ Id <$> UUID.nextRandom
    get (apiVersion "v1" . brig . paths ["users", pack $ show foundOne] . zUser findingOne)
      !!! do
        const 404 === statusCode
        const (Just "not-found") === fmap Error.label . responseJsonMaybe
    get (apiVersion "v1" . brig . paths ["users", pack $ show foundOne] . zUser foundOne)
      !!! do
        const 404 === statusCode
        const (Just "not-found") === fmap Error.label . responseJsonMaybe
  
  testNonExistingUser :: Brig -> Http ()
  testNonExistingUser brig = do
    qself <- userQualifiedId <$> randomUser brig
    uid1 <- liftIO $ Id <$> UUID.nextRandom
    uid2 <- liftIO $ Id <$> UUID.nextRandom
    let uid = qUnqualified qself
        domain = qDomain qself
    get (apiVersion "v1" . brig . paths ["users", toByteString' domain, toByteString' uid1] . zUser uid)
      !!! do
        const 404 === statusCode
        const (Just "not-found") === fmap Error.label . responseJsonMaybe
    get (apiVersion "v1" . brig . paths ["users", toByteString' domain, toByteString' uid2] . zUser uid)
      !!! do
        const 404 === statusCode
        const (Just "not-found") === fmap Error.label . responseJsonMaybe
  
  testUserInvalidDomain :: Brig -> Http ()
  testUserInvalidDomain brig = do
    qself <- userQualifiedId <$> randomUser brig
    let uid = qUnqualified qself
    get (brig . paths ["users", "invalid.example.com", toByteString' uid] . zUser uid)
      !!! do
        const 422 === statusCode
        const (Just "/federation/api-version")
          === preview (ix "data" . ix "path") . responseJsonUnsafe @Value
        const (Just "invalid.example.com")
          === preview (ix "data" . ix "domain") . responseJsonUnsafe @Value
  
  testExistingUserUnqualified :: Brig -> Http ()
  testExistingUserUnqualified brig = do
    uid <- userId <$> randomUser brig
    get (apiVersion "v1" . brig . paths ["users", pack $ show uid] . zUser uid) !!! do
      const 200 === statusCode
      const (Just uid)
        === ( \r -> do
                b <- responseBody r
                b ^? key "id" >>= maybeFromJSON
            )
  
  testExistingUser :: Brig -> Http ()
  testExistingUser brig = do
    quser <- userQualifiedId <$> randomUser brig
    let uid = qUnqualified quser
        domain = qDomain quser
    get
      ( apiVersion "v1"
          . brig
          . zUser uid
          . paths
            [ "users",
              toByteString' domain,
              toByteString' uid
            ]
      )
      !!! do
        const 200 === statusCode
        const (Just uid)
          === ( \r -> do
                  b <- responseBody r
                  b ^? key "id" >>= maybeFromJSON
              )
  
  testUserExistsUnqualified :: Brig -> Http ()
  testUserExistsUnqualified brig = do
    qself <- userQualifiedId <$> randomUser brig
    quser <- userQualifiedId <$> randomUser brig
    head
      ( apiVersion "v1"
          . brig
          . paths ["users", toByteString' (qUnqualified quser)]
          . zUser (qUnqualified qself)
      )
      !!! do
        const 200 === statusCode
        const mempty === responseBody
  
  testUserDoesNotExistUnqualified :: Brig -> Http ()
  testUserDoesNotExistUnqualified brig = do
    qself <- userQualifiedId <$> randomUser brig
    uid <- liftIO $ Id <$> UUID.nextRandom
    head
      ( brig
          . paths ["users", toByteString' uid]
          . zUser (qUnqualified qself)
      )
      !!! do
        const 404 === statusCode
        const mempty === responseBody
  
  testUserExists :: Brig -> Http ()
  testUserExists brig = do
    qself <- userQualifiedId <$> randomUser brig
    quser <- userQualifiedId <$> randomUser brig
    head
      ( brig
          . paths ["users", toByteString' (qDomain quser), toByteString' (qUnqualified quser)]
          . zUser (qUnqualified qself)
      )
      !!! do
        const 200 === statusCode
        const mempty === responseBody
  
  testUserDoesNotExist :: Brig -> Http ()
  testUserDoesNotExist brig = do
    qself <- userQualifiedId <$> randomUser brig
    uid <- liftIO $ Id <$> UUID.nextRandom
    head
      ( brig
          . paths ["users", toByteString' (qDomain qself), toByteString' uid]
          . zUser (qUnqualified qself)
      )
      !!! do
        const 404 === statusCode
        const mempty === responseBody
  
  testMultipleUsersUnqualified :: Brig -> Http ()
  testMultipleUsersUnqualified brig = do
    u1 <- randomUser brig
    u2 <- randomUser brig
    u3 <- createAnonUser "a" brig
    let uids = C8.intercalate "," $ map (toByteString' . userId) [u1, u2, u3]
        -- n.b. email addresses and phone numbers are never returned
        -- on this endpoint, only from the self profile (/self).
        expected =
          Set.fromList
            [ (Just $ userDisplayName u1, Nothing :: Maybe EmailAddress),
              (Just $ userDisplayName u2, Nothing),
              (Just $ userDisplayName u3, Nothing)
            ]
    get
      ( apiVersion "v1"
          . brig
          . zUser (userId u1)
          . contentJson
          . path "users"
          . queryItem "ids" uids
      )
      !!! do
        const 200 === statusCode
        const (Just expected) === result
    where
      result r =
        Set.fromList
          . map (field "name" &&& field "email")
          <$> responseJsonMaybe r
      field :: (FromJSON a) => Key -> Value -> Maybe a
      field f u = u ^? key f >>= maybeFromJSON
  
  testMultipleUsersV3 :: Brig -> Http ()
  testMultipleUsersV3 brig = do
    u1 <- randomUser brig
    u2 <- randomUser brig
    u3 <- createAnonUser "a" brig
    let users = [u1, u2, u3]
        q = ListUsersByIds (map userQualifiedId users)
        expected =
          Set.fromList
            [ (Just $ userDisplayName u1, Nothing :: Maybe EmailAddress),
              (Just $ userDisplayName u2, Nothing),
              (Just $ userDisplayName u3, Nothing)
            ]
    post
      ( apiVersion "v3"
          . brig
          . zUser (userId u1)
          . contentJson
          . path "list-users"
          . body (RequestBodyLBS (Aeson.encode q))
      )
      !!! do
        const 200 === statusCode
        const (Just expected) === result
    where
      result r =
        Set.fromList
          . map (field "name" &&& field "email")
          <$> responseJsonMaybe r
      field :: (FromJSON a) => Key -> Value -> Maybe a
      field f u = u ^? key f >>= maybeFromJSON
  
  testMultipleUsers :: Opt.Opts -> Brig -> Http ()
  testMultipleUsers opts brig = do
    u1 <- randomUser brig
    u2 <- randomUser brig
    u3 <- createAnonUser "a" brig
    -- A remote user that can't be listed
    u4 <- Qualified <$> randomId <*> pure (Domain "far-away.example.com")
    -- A remote user that can be listed
    let evenFurtherAway = Domain "even-further-away.example.com"
    u5 <- Qualified <$> randomId <*> pure evenFurtherAway
    let u5Profile =
          UserProfile
            { profileQualifiedId = u5,
              profileName = Name "u5",
              profileTextStatus = Nothing,
              profilePict = Pict [],
              profileAssets = [],
              profileAccentId = ColourId 0,
              profileDeleted = False,
              profileService = Nothing,
              profileHandle = Nothing,
              profileExpire = Nothing,
              profileTeam = Nothing,
              profileEmail = Nothing,
              profileLegalholdStatus = UserLegalHoldDisabled,
              profileSupportedProtocols = defSupportedProtocols,
              profileType = UserTypeRegular
            }
        users = [u1, u2, u3]
        q = ListUsersByIds $ u5 : u4 : map userQualifiedId users
        expected =
          Set.fromList
            [ (Just $ userDisplayName u1, Nothing :: Maybe EmailAddress),
              (Just $ userDisplayName u2, Nothing),
              (Just $ userDisplayName u3, Nothing),
              (Just $ profileName u5Profile, profileEmail u5Profile)
            ]
        expectedFailed = Set.fromList [u4]
  
    let fedMockResponse req = do
          -- Check that our allowed remote user is being asked for
          if frTargetDomain req == evenFurtherAway
            then -- Return the data for u5
              pure $ encode [u5Profile]
            else -- Otherwise mock an unavailable federation server
              throw $ MockErrorResponse Http.status500 "Down for maintenance"
        -- Galley isn't needed, but this is what mock federators are available.
        galleyHandler _ = error "not mocked"
    (response, _rpcCalls, _galleyCalls) <- liftIO $
      withMockedFederatorAndGalley opts (Domain "example.com") fedMockResponse galleyHandler $ do
        post
          ( brig
              . zUser (userId u1)
              . contentJson
              . path "list-users"
              . body (RequestBodyLBS (Aeson.encode q))
          )
  
    pure response !!! do
      const 200 === statusCode
      const (Just expected) === result
      const (pure $ pure expectedFailed) === resultFailed
    where
      result r =
        Set.fromList
          . map (\u -> (pure $ profileName u, profileEmail u))
          . listUsersByIdFound
          <$> responseJsonMaybe r
      resultFailed r = fmap (Set.fromList . NonEmpty.toList) . listUsersByIdFailed <$> responseJsonMaybe r
  
  testCreateUserAnonExpiry :: Brig -> Http ()
  testCreateUserAnonExpiry b = do
    u1 <- randomUser b
    alice <- randomUser b
    bob <- createAnonUserExpiry (Just 5 {- 2 was flaky, so it's 5 now; make sure to re-align with 'awaitExpiry' below! -}) "bob" b
    liftIO $ assertBool "expiry not set on regular creation" (isNothing (userExpire alice))
    ensureExpiry (fromUTCTimeMillis <$> userExpire bob) "bob/register"
    resAlice <- getProfile (userId u1) (userId alice)
    resBob <- getProfile (userId u1) (userId bob)
    selfBob <- get (b . zUser (userId bob) . path "self") <!! const 200 === statusCode
    liftIO $ assertBool "Bob must not be in a deleted state initially" (maybe True not (deleted selfBob))
    liftIO $ assertBool "Regular user should not have any expiry" (null $ expire resAlice)
    ensureExpiry (expire resBob) "bob/public"
    ensureExpiry (expire selfBob) "bob/self"
    awaitExpiry 10 (userId u1) (userId bob)
    resBob' <- getProfile (userId u1) (userId bob)
    liftIO $ assertBool "Bob must be in deleted state" (fromMaybe False $ deleted resBob')
    where
      getProfile :: UserId -> UserId -> Http ResponseLBS
      getProfile zusr uid = get (apiVersion "v1" . b . zUser zusr . paths ["users", toByteString' uid]) <!! const 200 === statusCode
  
      awaitExpiry :: Int -> UserId -> UserId -> Http ()
      awaitExpiry n zusr uid = do
        -- after expiration, a profile lookup should trigger garbage collection of ephemeral users
        r <- getProfile zusr uid
        when (statusCode r == 200 && isNothing (deleted r) && n > 0) $ do
          liftIO $ threadDelay 1000000
          awaitExpiry (n - 1) zusr uid
  
      ensureExpiry :: Maybe UTCTime -> String -> Http ()
      ensureExpiry expiry s = do
        now <- liftIO getCurrentTime
        case expiry of
          Nothing -> liftIO $ assertFailure ("user must have an expiry" <> s)
          Just a -> do
            let diff = diffUTCTime a now
                minExp = 1 :: Integer -- 1 second
                maxExp = 60 * 60 * 24 * 10 :: Integer -- 10 days
            liftIO $ assertBool "expiry must be in the future" (diff >= fromIntegral minExp)
            liftIO $ assertBool "expiry must be less than 10 days" (diff < fromIntegral maxExp)
  
      expire :: ResponseLBS -> Maybe UTCTime
      expire r = field "expires_at" =<< responseJsonMaybe r
  
      deleted :: ResponseLBS -> Maybe Bool
      deleted r = field "deleted" =<< responseJsonMaybe r
  
      field :: (FromJSON a) => Key -> Value -> Maybe a
      field f u = u ^? key f >>= maybeFromJSON
  
  testUserUpdate :: (HasCallStack) => Brig -> Cannon -> UserJournalWatcher -> Http ()
  testUserUpdate brig cannon userJournalWatcher = do
    aliceUser <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher aliceUser "user create alice"
    let alice = userId aliceUser
        aliceQ = userQualifiedId aliceUser
    bobUser <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher bobUser "user create bob"
    let bob = userId bobUser
    aliceNewName <- randomName
    connectUsers brig alice (singleton bob)
    let newColId = Just 5
        newAssets =
          Just
            [ ImageAsset
                (AssetKeyV3 (Id (fromJust (UUID.fromString "5cd81cc4-c643-4e9c-849c-c596a88c27fd"))) AssetExpiring)
                (Just AssetComplete)
            ]
        mNewName = Just $ aliceNewName
        mNewTextStatus = rightToMaybe $ mkTextStatus "fun status"
        newPic = Nothing -- Legacy
        userUpdate = UserUpdate mNewName mNewTextStatus newPic newAssets newColId
        update = RequestBodyLBS . encode $ userUpdate
    -- Update profile & receive notification
    WS.bracketRN cannon [alice, bob] $ \[aliceWS, bobWS] -> do
      put (brig . path "/self" . contentJson . zUser alice . zConn "c" . body update)
        !!! const 200 === statusCode
      liftIO $ mapConcurrently_ (\ws -> assertUpdateNotification ws alice userUpdate) [aliceWS, bobWS]
      -- Should generate a user update journaled event with the new name
      Util.assertNameUpdateJournaled userJournalWatcher alice aliceNewName "alice name update"
    -- get the updated profile
    get (brig . path "/self" . zUser alice) !!! do
      const 200 === statusCode
      const (mNewName, mNewTextStatus, newColId, newAssets)
        === ( \u ->
                ( fmap userDisplayName u,
                  userTextStatus =<< u,
                  fmap userAccentId u,
                  fmap userAssets u
                )
            )
          . responseJsonMaybe
    -- should appear in search by 'newName'
    suid <- userId <$> randomUser brig
    Search.refreshIndex brig
    Search.assertCanFind brig suid aliceQ (fromName aliceNewName)
  
  -- This tests the behavior of `/i/self/email` instead of `/self/email` or
  -- `/access/self/email`.  tests for session token handling under `/access/self/email` are in
  -- `services/brig/test/integration/API/User/Auth.hs`.
  testEmailUpdate :: Brig -> UserJournalWatcher -> Http ()
  testEmailUpdate brig userJournalWatcher = do
    usr <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher usr "user create random"
    let uid = userId usr
    eml <- randomEmail
    -- update email
    let Just oldeml = userEmail usr
    initiateEmailUpdateLogin brig eml (emailLogin oldeml defPassword Nothing) uid !!! const 202 === statusCode
    -- activate
    activateEmail brig eml
    checkEmail brig uid eml
    Util.assertEmailUpdateJournaled userJournalWatcher uid eml "user update"
    -- update email, which is exactly the same as before (idempotency)
    initiateEmailUpdateLogin brig eml (emailLogin eml defPassword Nothing) uid !!! const 204 === statusCode
    -- ensure no other user has "test+<uuid>@example.com"
    -- if there is such a user, let's delete it first.  otherwise
    -- this test fails since there can be only one user with "test+...@example.com"
    ensureNoOtherUserWithEmail (unsafeEmailAddress "test" "example.com")
    -- we want to use a non-trusted domain in order to verify profile changes
    initiateUpdateAndActivate uid =<< mkEmailRandomLocalSuffix "test@example.com"
  
    -- adding a clean-up step seems to avoid the subsequent failures.
    -- If subsequent runs start failing, it's possible that the aggressive setting
    -- for `setSuspendInactiveUsers` is triggering before we can clean that user up.
    -- In that case, you might need to manually delete the user from the test DB. @elland
    deleteUserInternal uid brig !!! const 202 === statusCode
    where
      ensureNoOtherUserWithEmail :: EmailAddress -> Http ()
      ensureNoOtherUserWithEmail eml = do
        tk :: Maybe AccessToken <-
          responseJsonMaybe <$> login brig (defEmailLogin eml) SessionCookie
        for_ tk $ \t -> do
          deleteUser (Auth.user t) (Just defPassword) brig !!! const 200 === statusCode
          Util.assertDeleteJournaled userJournalWatcher (Auth.user t) "user deletion"
  
      initiateUpdateAndActivate :: UserId -> EmailAddress -> Http ()
      initiateUpdateAndActivate uid eml = do
        _ <- initiateEmailUpdate brig eml uid
        activateEmail brig eml
        checkEmail brig uid eml
        Util.assertEmailUpdateJournaled userJournalWatcher uid eml "user update"
        -- Ensure login work both with the full email and the "short" version
        login brig (defEmailLogin eml) SessionCookie !!! const 200 === statusCode
        login brig (defEmailLogin (unsafeEmailAddress "test" "example.com")) SessionCookie !!! const 200 === statusCode
  
  testUserLocaleUpdate :: Brig -> UserJournalWatcher -> Http ()
  testUserLocaleUpdate brig userJournalWatcher = do
    usr <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher usr "user create random"
    let uid = userId usr
    -- update locale info with locale supported in templates
    let locEN = fromMaybe (error "Failed to parse locale") $ parseLocale "en-US"
    put (brig . path "/self/locale" . contentJson . zUser uid . zConn "c" . locale locEN)
      !!! const 200 === statusCode
    get (brig . path "/self" . contentJson . zUser uid . zConn "c")
      !!! do
        const 200 === statusCode
        const (Just locEN) === (Just . userLocale . selfUser <=< responseJsonMaybe)
    Util.assertLocaleUpdateJournaled userJournalWatcher uid locEN "user update"
    -- update locale info with locale NOT supported in templates
    let locPT = fromMaybe (error "Failed to parse locale") $ parseLocale "pt-PT"
    put (brig . path "/self/locale" . contentJson . zUser uid . zConn "c" . locale locPT)
      !!! const 200 === statusCode
    Util.assertLocaleUpdateJournaled userJournalWatcher uid locPT "user update"
    -- get the updated locale
    get (brig . path "/self" . zUser uid) !!! do
      const 200 === statusCode
      const (parseLocale "pt-PT") === (Just . userLocale . selfUser <=< responseJsonMaybe)
    where
      locale l = body . RequestBodyLBS . encode $ object ["locale" .= l]
  
  testSuspendUser :: Brig -> Http ()
  testSuspendUser brig = do
    u <- randomUser brig
    let uid = userId u
        quid = userQualifiedId u
        Just email = userEmail u
    setStatus brig uid Suspended
    -- login fails
    login brig (defEmailLogin email) PersistentCookie !!! do
      const 403 === statusCode
      const (Just "suspended") === fmap Error.label . responseJsonMaybe
    -- check status
    chkStatus brig uid Suspended
    -- should not appear in search
    suid <- userId <$> randomUser brig
    Search.refreshIndex brig
    Search.assertCan'tFind brig suid quid (fromName (userDisplayName u))
    -- re-activate
    setStatus brig uid Active
    chkStatus brig uid Active
    -- should appear in search again
    Search.refreshIndex brig
    Search.assertCanFind brig suid quid (fromName (userDisplayName u))
  
  testGetByIdentity :: Brig -> Http ()
  testGetByIdentity brig = do
    e <- randomEmail
    let emailBs = T.encodeUtf8 $ fromEmail e
        newUser =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("Alice" :: Text),
                "email" .= fromEmail e
              ]
    rs <-
      post (brig . path "/i/users" . contentJson . body newUser)
        <!! const 201 === statusCode
    let Just uid = userId <$> responseJsonMaybe rs
    get (brig . zUser uid . path "i/users" . queryItem "email" emailBs) !!! do
      const 200 === statusCode
      const (Just [uid]) === getUids
    where
      getUids r = fmap userId <$> responseJsonMaybe r
  
  testPasswordSet :: Brig -> Http ()
  testPasswordSet brig = do
    e <- randomEmail
    let newUser =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("Alice" :: Text),
                "email" .= fromEmail e
              ]
    rs <-
      post (brig . path "/i/users" . contentJson . body newUser)
        <!! const 201 === statusCode
    let Just uid = userId <$> responseJsonMaybe rs
    -- No password set yet
    Bilge.head (brig . path "/self/password" . zUser uid)
      !!! const 404 === statusCode
    -- Since there is no password set, we can just set one
    put (brig . path "/self/password" . contentJson . zUser uid . body pwSet)
      !!! const 200 === statusCode
    -- Now we should have a password
    Bilge.head (brig . path "/self/password" . zUser uid)
      !!! const 200 === statusCode
    where
      pwSet =
        RequestBodyLBS . encode $
          object
            [ "new_password" .= ("a_very_long_password" :: Text)
            ]
  
  testPasswordSetInvalidPasswordLength :: Brig -> Http ()
  testPasswordSetInvalidPasswordLength brig = do
    e <- randomEmail
    let newUser =
          RequestBodyLBS . encode $
            object
              [ "name" .= ("Alice" :: Text),
                "email" .= fromEmail e
              ]
    rs <-
      post (brig . path "/i/users" . contentJson . body newUser)
        <!! const 201 === statusCode
    let Just uid = userId <$> responseJsonMaybe rs
    put (brig . path "/self/password" . contentJson . zUser uid . body shortPassword)
      !!! const 400 === statusCode
    where
      shortPassword =
        RequestBodyLBS . encode $
          object
            [ "new_password" .= ("secret" :: Text)
            ]
  
  testPasswordChangeAnonUser :: Brig -> Http ()
  testPasswordChangeAnonUser brig = do
    uid2 <- userId <$> createAnonUser "foo2" brig
    put (brig . path "/self/password" . contentJson . zUser uid2 . body pwSet)
      !!! (const 403 === statusCode)
    where
      newPass = plainTextPassword6Unsafe "topsecret"
      pwSet =
        RequestBodyLBS . encode $
          object
            [ "new_password" .= newPass
            ]
  
  testSendActivationCode :: Opt.Opts -> Brig -> Http ()
  testSendActivationCode opts brig = do
    -- Code for phone pre-verification
    requestActivationCode brig 400 . Right =<< randomPhone
    -- Code for email pre-verification
    requestActivationCode brig 200 . Left =<< randomEmail
    -- Standard email registration flow
    if opts.settings.restrictUserCreation == Just True
      then do
        registerUser "Alice" brig !!! const 403 === statusCode
      else do
        r <- registerUser "Alice" brig <!! const 201 === statusCode
        let Just email = userEmail =<< responseJsonMaybe r
        -- Re-request existing activation code
        requestActivationCode brig 200 (Left email)
  
  testSendActivationCodeInvalidEmailOrPhone :: Brig -> Http ()
  testSendActivationCodeInvalidEmailOrPhone brig = do
    let invalidEmail = unsafeEmailAddress "?" "?"
    -- Code for email pre-verification
    requestActivationCode brig 400 (Left invalidEmail)
  
  testDeleteUserByPassword :: Brig -> Cannon -> UserJournalWatcher -> Http ()
  testDeleteUserByPassword brig cannon userJournalWatcher = do
    u <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher u "user activate"
    let uid1 = userId u
    let email = fromMaybe (error "Missing email") (userEmail u)
    -- Establish some connections
    usr2 <- randomUser brig
    let uid2 = userId usr2
    Util.assertUserActivateJournaled userJournalWatcher usr2 "user activate"
    usr3 <- randomUser brig
    let uid3 = userId usr3
    Util.assertUserActivateJournaled userJournalWatcher usr3 "user activate"
    postConnection brig uid1 uid2 !!! const 201 === statusCode
    postConnection brig uid1 uid3 !!! const 201 === statusCode
    putConnection brig uid2 uid1 Accepted !!! const 200 === statusCode
    putConnection brig uid3 uid1 Accepted !!! const 200 === statusCode
    postConnection brig uid2 uid3 !!! const 201 === statusCode
    con32 <- putConnection brig uid3 uid2 Accepted <!! const 200 === statusCode
    con23 <- getConnection brig uid2 uid3 <!! const 200 === statusCode
    -- Register a client
    addClient brig uid1 (defNewClient PermanentClientType [Imports.head somePrekeys] (Imports.head someLastPrekeys))
      !!! const 201 === statusCode
    -- Initial login
    login brig (defEmailLogin email) PersistentCookie
      !!! const 200 === statusCode
    n1 <- countCookies brig uid1 defCookieLabel
    liftIO $ Just 1 @=? n1
    -- Initiate a change of email address, to verify that activation
    -- does not work after the account has been deleted.
    eml <- randomEmail
    let Just oldeml = userEmail u
    initiateEmailUpdateLogin brig eml (emailLogin oldeml defPassword Nothing) uid1 !!! (const 202 === statusCode)
    setHandleAndDeleteUser brig cannon u [uid2, uid3] userJournalWatcher $
      \uid -> deleteUser uid (Just defPassword) brig !!! const 200 === statusCode
    -- Activating the new email address now should not work
    act <- getActivationCode brig (Left eml)
    case act of
      Nothing -> liftIO $ assertFailure "missing activation key/code"
      Just kc ->
        activate brig kc !!! do
          const 404 === statusCode
          const (Just "invalid-code") === fmap Error.label . responseJsonMaybe
    -- Connections involving uid1 are gone (uid2 <-> uid3 remains)
    let u1Conns = UserConnectionList [] False
    let u2Conns = UserConnectionList (maybeToList (responseJsonMaybe con23)) False
    let u3Conns = UserConnectionList (maybeToList (responseJsonMaybe con32)) False
    listConnections brig uid1 !!! do
      const 200 === statusCode
      const (Just u1Conns) === responseJsonMaybe
    listConnections brig uid2 !!! do
      const 200 === statusCode
      const (Just u2Conns) === responseJsonMaybe
    listConnections brig uid3 !!! do
      const 200 === statusCode
      const (Just u3Conns) === responseJsonMaybe
  
  testDeleteUserWithLegalHold :: Brig -> Cannon -> UserJournalWatcher -> Http ()
  testDeleteUserWithLegalHold brig cannon userJournalWatcher = do
    user <- randomUser brig
    let uid = userId user
    -- Register a legalhold client
    addClientInternal brig uid (defNewClient LegalHoldClientType [Imports.head somePrekeys] (Imports.head someLastPrekeys))
      !!! const 201 === statusCode
    Util.assertUserActivateJournaled userJournalWatcher user "user activate testDeleteInternal1: "
    setHandleAndDeleteUser brig cannon user [] userJournalWatcher $
      \uid' -> deleteUser uid' (Just defPassword) brig !!! const 200 === statusCode
  
  testDeleteUserByCode :: Brig -> Http ()
  testDeleteUserByCode brig = do
    u <- randomUser brig
    deleteUser (userId u) Nothing brig
      !!! const 202 === statusCode
    -- (Syntactically) invalid key / code
    let _key = "" :: Text
    let _code = "123" :: Text
    send _key _code !!! do
      const 400 === statusCode
      const (Just "bad-request") === fmap Error.label . responseJsonMaybe
    -- (Semantically) invalid key / code
    let _key = T.replicate 20 "x"
    let _code = "idontknow" :: Text
    send _key _code !!! do
      const 403 === statusCode
      const (Just "invalid-code") === fmap Error.label . responseJsonMaybe
    where
      send k c = post (brig . path "/delete" . contentJson . body (payload k c))
      payload k c =
        RequestBodyLBS . encode $
          object
            ["key" .= k, "code" .= c]
  
  testDeleteAnonUser :: Brig -> Http ()
  testDeleteAnonUser brig = do
    uid <- userId <$> createAnonUser "anon" brig
    deleteUser uid Nothing brig
      !!! const 200 === statusCode
  
  testDeleteWithProfilePic :: Brig -> CargoHold -> Http ()
  testDeleteWithProfilePic brig cargohold = do
    email <- randomEmail
    -- Users need to be verified if they want to upload assets, so email it is!
    uid <- userId <$> createUserWithEmail "anon" email brig
    ast <- responseJsonError =<< uploadAsset cargohold uid Asset.defAssetSettings "this is my profile pic"
    -- Ensure that the asset is there
    downloadAsset cargohold uid (ast ^. Asset.assetKey) !!! const 200 === statusCode
    let newAssets =
          Just
            [ ImageAsset
                (qUnqualified $ ast ^. Asset.assetKey)
                (Just AssetComplete)
            ]
        userUpdate = UserUpdate Nothing Nothing Nothing newAssets Nothing
        update = RequestBodyLBS . encode $ userUpdate
    -- Update profile with the uploaded asset
    put (brig . path "/self" . contentJson . zUser uid . zConn "c" . body update)
      !!! const 200 === statusCode
    deleteUser uid (pure defPassword) brig !!! const 200 === statusCode
    -- Check that the asset gets deleted
    downloadAsset cargohold uid (ast ^. Asset.assetKey) !!! const 404 === statusCode
  
  testUpdateSSOId :: Brig -> Galley -> Http ()
  testUpdateSSOId brig galley = do
    noSuchUserId <- Id <$> liftIO UUID.nextRandom
    put
      ( brig
          . paths ["i", "users", toByteString' noSuchUserId, "sso-id"]
          . Bilge.json (UserSSOId (mkSampleUref "1" "1"))
      )
      !!! const 404 === statusCode
    let go :: (HasCallStack) => User -> UserSSOId -> Http ()
        go user ssoid = do
          let uid = userId user
          put
            ( brig
                . paths ["i", "users", toByteString' uid, "sso-id"]
                . Bilge.json ssoid
            )
            !!! const 200 === statusCode
          profile :: SelfProfile <- responseJsonError =<< get (brig . path "/self" . zUser uid)
          let Just (SSOIdentity ssoid' mEmail) = userIdentity . selfUser $ profile
          liftIO $ do
            assertEqual "updateSSOId/ssoid" ssoid ssoid'
            assertEqual "updateSSOId/email" (userEmail user) mEmail
    (owner, teamid) <- createUserWithTeam brig
    let mkMember :: Bool -> Http User
        mkMember hasEmail = do
          member <- createTeamMember brig galley owner teamid noPermissions
          unless hasEmail $ do
            error "not implemented"
          selfUser <$> (responseJsonError =<< get (brig . path "/self" . zUser (userId member)))
    let ssoids1 = [UserSSOId (mkSampleUref "1" "1"), UserSSOId (mkSampleUref "1" "2")]
        ssoids2 = [UserSSOId (mkSampleUref "2" "1"), UserSSOId (mkSampleUref "2" "2")]
    users <-
      sequence
        [ mkMember True
        -- the following two could be implemented by creating the user implicitly via SSO login.
        -- , mkMember False  False
        ]
    zipWithM_ go users ssoids1
    zipWithM_ go users ssoids2
  
  -- | FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the
  -- first thing that we check on the /register endpoint. Other tests that make use of @setRestrictUserCreation@
  -- can probably be removed and simplified. It's probably a good candidate for Quickcheck.
  testRestrictedUserCreation :: Opt.Opts -> Brig -> Http ()
  testRestrictedUserCreation opts brig = do
    -- We create a team before to help in other tests
    (teamOwner, createdTeam) <- createUserWithTeam brig
  
    let opts' = opts {Opt.settings = opts.settings {Opt.restrictUserCreation = Just True}}
    withSettingsOverrides opts' $ do
      e <- randomEmail
  
      let Object regularUser =
            object
              [ "name" .= Name "Alice",
                "email" .= fromEmail e,
                "email_code" .= ("123456" :: Text),
                "password" .= plainTextPassword6Unsafe "123123123"
              ]
      postUserRegister' regularUser brig !!! do
        const 403 === statusCode
        const (Just "user-creation-restricted") === (^? AesonL.key "label" . AesonL._String) . (responseJsonUnsafe @Value)
  
      let Object regularUserNotPreActivated =
            object
              [ "name" .= Name "Alice",
                "email" .= fromEmail e,
                "password" .= plainTextPassword6Unsafe "123123123"
              ]
      postUserRegister' regularUserNotPreActivated brig !!! do
        const 403 === statusCode
        const (Just "user-creation-restricted") === (^? AesonL.key "label" . AesonL._String) . (responseJsonUnsafe @Value)
  
      let Object teamCreator =
            object
              [ "name" .= Name "Alice",
                "email" .= fromEmail e,
                "email_code" .= ("123456" :: Text),
                "team" .= object ["name" .= ("Alice team" :: Text), "icon" .= ("default" :: Text), "binding" .= True],
                "password" .= plainTextPassword6Unsafe "123123123"
              ]
      postUserRegister' teamCreator brig !!! do
        const 403 === statusCode
        const (Just "user-creation-restricted") === (^? AesonL.key "label" . AesonL._String) . (responseJsonUnsafe @Value)
  
      -- Ensure you can invite team users
      void $ inviteAndRegisterUser teamOwner createdTeam brig
  
      -- Ephemeral users can always be created (expires_in is OPTIONAL)
      let Object ephemeralUser =
            object
              [ "name" .= Name "Alice",
                "expires_in" .= (600000 :: Int)
              ]
      postUserRegister' ephemeralUser brig !!! const 201 === statusCode
  
      -- Ephemeral users can always be created (expires_in is OPTIONAL and
      -- used for instance when creating guestrooms
      let Object ephemeralUserWithoutExpires =
            object
              [ "name" .= Name "Alice"
              ]
      postUserRegister' ephemeralUserWithoutExpires brig !!! const 201 === statusCode
  
      -- NOTE: SSO users are anyway not allowed on the `/register` endpoint
      teamid <- Id <$> liftIO UUID.nextRandom
      let ssoid = UserSSOId mkSimpleSampleUref
      let Object ssoUser =
            object
              [ "name" .= Name "Alice",
                "sso_id" .= Just ssoid,
                "team_id" .= Just teamid
              ]
      postUserRegister' ssoUser brig !!! const 400 === statusCode
  
  -- | FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the
  -- first thing that we check on the /register endpoint. Other tests that make use of @setRestrictUserCreation@
  -- can probably be removed and simplified. It's probably a good candidate for Quickcheck.
  testTooManyMembersForLegalhold :: Opt.Opts -> Brig -> Http ()
  testTooManyMembersForLegalhold opts brig = do
    (owner, tid) <- createUserWithTeam brig
  
    -- Invite a user with mocked galley which tells us that the user cannot be
    -- added. We cannot use real galley here as the real galley has legalhold set
    -- to "whitelist-teams-and-implicit-consent". In this mode this error is not
    -- thrown, so in order to emulate other modes, we just emulate what galley
    -- would return in that case.
    inviteeEmail <- randomEmail
    let invite = stdInvitationRequest inviteeEmail
    inv :: Invitation <-
      responseJsonError
        =<< postInvitation brig tid owner invite
          <!! statusCode === const 201
    Just inviteeCode <- getInvitationCode brig tid inv.invitationId
    let mockGalley (ReceivedRequest mth pth _body)
          | mth == "GET" && pth == ["i", "teams", Text.pack (show tid), "members", "check"] =
              pure . Wai.responseLBS HTTP.status403 mempty $
                encode
                  ( Wai.mkError
                      HTTP.status403
                      "too-many-members-for-legalhold"
                      "cannot add more members to team when legalhold service is enabled."
                  )
          | mth == "GET"
              && pth == ["i", "teams", Text.pack (show tid), "features", "exposeInvitationURLsToTeamAdmin"] =
              pure . Wai.responseLBS HTTP.status200 mempty $
                encode
                  ( LockableFeature
                      FeatureStatusDisabled
                      LockStatusLocked
                      ExposeInvitationURLsToTeamAdminConfig
                  )
          | otherwise = pure $ Wai.responseLBS HTTP.status500 mempty "Unexpected request to mocked galley"
  
    void . withMockedGalley opts mockGalley $ do
      post
        ( brig
            . path "/register"
            . contentJson
            . body (accept inviteeEmail inviteeCode)
            . header "X-Forwarded-For" "127.0.0.42"
        )
        !!! do
          const 403 === statusCode
          const (Right "too-many-members-for-legalhold") === fmap Wai.label . responseJsonEither
  
  testDeleteUserWithCompletelyDeletedUser :: Brig -> Cannon -> UserJournalWatcher -> Http ()
  testDeleteUserWithCompletelyDeletedUser brig cannon userJournalWatcher = do
    u <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher u "user activate testDeleteUserWithCompletelyDeletedUser"
    setHandleAndDeleteUser brig cannon u [] userJournalWatcher $
      \uid -> deleteUserInternal uid brig !!! const 202 === statusCode
    do
      let uid = userId u
      deleteUserInternal uid brig
        !!! do
          const 200 === statusCode
  
  testDeleteUserWithNoUser :: Brig -> Http ()
  testDeleteUserWithNoUser brig = do
    nonExistingUid :: UserId <- liftIO $ generate arbitrary
    deleteUserInternal nonExistingUid brig
      !!! do
        const 404 === statusCode
  
  testDeleteUserWithNotDeletedUser :: (HasCallStack) => Brig -> Cannon -> UserJournalWatcher -> Http ()
  testDeleteUserWithNotDeletedUser brig cannon userJournalWatcher = do
    u <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher u "user activate testDeleteUserWithNotDeletedUser"
    do
      setHandleAndDeleteUser brig cannon u [] userJournalWatcher $
        ( \uid' ->
            deleteUserInternal uid' brig
              !!! do
                const 202 === statusCode
        )
  
  testDeleteUserWithDanglingProperty :: Brig -> Cannon -> UserJournalWatcher -> Http ()
  testDeleteUserWithDanglingProperty brig cannon userJournalWatcher = do
    u <- randomUser brig
    Util.assertUserActivateJournaled userJournalWatcher u "user activate testDeleteUserWithDanglingProperty"
  
    let uid = userId u
    -- First set a unique handle (to verify freeing of the handle)
    hdl <- randomHandle
    let update = RequestBodyLBS . encode $ HandleUpdate hdl
    put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update)
      !!! const 200 === statusCode
  
    deleteUserInternal uid brig !!! const 202 === statusCode
    Util.assertDeleteJournaled userJournalWatcher uid "user deletion testDeleteUserWithDanglingProperty"
  
    setProperty brig (userId u) "foo" objectProp
      !!! const 200 === statusCode
    getProperty brig (userId u) "foo" !!! do
      const 200 === statusCode
      const (Just objectProp) === responseJsonMaybe
  
    execAndAssertUserDeletion brig cannon u (fromJust (parseHandle hdl)) [] userJournalWatcher $ \uid' -> do
      deleteUserInternal uid' brig
        !!! do
          const 202 === statusCode
  
    getProperty brig (userId u) "foo" !!! do
      const 404 === statusCode
    where
      objectProp =
        object
          [ "key.1" .= ("val1" :: Text),
            "key.2" .= ("val2" :: Text)
          ]
  
  -- helpers
  
  setHandleAndDeleteUser :: Brig -> Cannon -> User -> [UserId] -> UserJournalWatcher -> (UserId -> HttpT IO ()) -> Http ()
  setHandleAndDeleteUser brig cannon u others userJournalWatcher execDelete = do
    let uid = userId u
    -- First set a unique handle (to verify freeing of the handle)
    hdl <- randomHandle
    let update = RequestBodyLBS . encode $ HandleUpdate hdl
    put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update)
      !!! const 200 === statusCode
  
    execAndAssertUserDeletion brig cannon u (fromJust (parseHandle hdl)) others userJournalWatcher execDelete
  
  execAndAssertUserDeletion :: Brig -> Cannon -> User -> Handle -> [UserId] -> UserJournalWatcher -> (UserId -> HttpT IO ()) -> Http ()
  execAndAssertUserDeletion brig cannon u hdl others userJournalWatcher execDelete = do
    let uid = userId u
        quid = userQualifiedId u
        email = fromMaybe (error "Must have an email set") (userEmail u)
  
    -- Delete the user
    WS.bracketRN cannon (uid : others) $ \wss -> do
      execDelete uid
      void . liftIO . WS.assertMatchN (5 # Second) wss $ matchDeleteUserNotification quid
      Util.assertDeleteJournaled userJournalWatcher uid "user deletion, setHandleAndDeleteUser: "
    -- Cookies are gone
    n2 <- countCookies brig uid defCookieLabel
    liftIO $ Just 0 @=? n2
    -- Clients are gone
    get (brig . path "clients" . zUser (userId u)) !!! do
      const 200 === statusCode
      const (Just [] :: Maybe [Client]) === responseJsonMaybe
    -- Can no longer log in
    login brig (defEmailLogin email) PersistentCookie !!! do
      const 403 === statusCode
      const (Just "invalid-credentials") === fmap Error.label . responseJsonMaybe
    -- Deleted flag appears in self profile; email, handle and picture are gone
    get (brig . path "/self" . zUser uid) !!! assertDeletedProfileSelf
    Search.refreshIndex brig
    -- Does not appear in search; public profile shows the user as deleted
    forM_ others $ \usr -> do
      get (apiVersion "v1" . brig . paths ["users", toByteString' uid] . zUser usr) !!! assertDeletedProfilePublic
      Search.assertCan'tFind brig usr quid (fromName (userDisplayName u))
      Search.assertCan'tFind brig usr quid (fromHandle hdl)
    -- Email address is available again
    let Object o =
          object
            [ "name" .= ("Someone Else" :: Text),
              "email" .= fromEmail email,
              "password" .= defPassword
            ]
    -- This will generate a new event, we need to consume it here
    usr <- postUserInternal o brig
    Util.assertUserActivateJournaled userJournalWatcher usr "user activate execAndAssertUserDeletion"
    -- Handle is available again
    Bilge.head (brig . paths ["handles", toByteString' hdl] . zUser uid)
      !!! const 404 === statusCode
    where
      assertDeletedProfileSelf = do
        const 200 === statusCode
        const (Just noPict, Just Nothing, Just True, Just [], Nothing)
          === ( \u' ->
                  ( fmap userPict u',
                    fmap userEmail u',
                    fmap userDeleted u',
                    fmap userAssets u',
                    userHandle =<< u'
                  )
              )
            . responseJsonMaybe
      assertDeletedProfilePublic = do
        const 200 === statusCode
        const (Just noPict, Just True, Nothing)
          === ( \u' ->
                  ( fmap profilePict u',
                    fmap profileDeleted u',
                    profileHandle =<< u'
                  )
              )
            . responseJsonMaybe
  