From ee47bbc8ffeb3c1725b3f33e6ebf20a345c3f498 Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Wed, 9 Sep 2020 13:57:51 +0200
Subject: [PATCH 01/11] Allow SCIM without saml (#1200)

documentation

Before this PR, scim tokens could only be added to teams that already had exactly one SAML IdP. Now, we also allow SAML-less teams to have SCIM provisioning. This is an alternative to onboarding via team-settings and produces user accounts that are authenticated with email and password. (Phone may or may not work, but is not officially supported.)

The way this works is different from team-settings: we don't send invites, but we create active users immediately the moment the SCIM user post is processed. The new thing is that the created user has neither email nor phone nor a SAML identity, nor a password.

How does this work?

email: If no SAML IdP is present, SCIM user posts must contain an externalId that is an email address. This email address is not added to the newly created user, because it has not been validated. Instead, the flow for changing an email address is triggered in brig: an email is sent to the address containing a validation key, and once the user completes the flow, brig will add the email address to the user. We had to add very little code for this in this PR, it's all an old feature.

When SCIM user gets are processed, in order to reconstruct the externalId from the user spar is retrieving from brig, we introduce a new json object for the sso_id field that looks like this: {'scim_external_id': 'me@example.com'}.

In order to find users that have email addresses pending validation, we introduce a new table in spar's cassandra called scim_external_ids, in analogy to user. We have tried to use brig's internal GET /i/user&email=..., but that also finds pending email addresses, and there are corner cases when changing email addresses and waiting for the new address to be validated and the old to be removed... that made this approach seem infeasible.

password: once the user has validated their email address, they need to trigger the "forgot password" flow -- also old code.

That's the gist of it!

* New brig internal end-points.
* Support for email/password-authenticated scim users.
* Fix: spar's notion of brig's api.
- use internal end-points
- return 'UserAccount' (contains status) instead of 'User'.
- more transparent error handling.
* Fix: allow UserSSOId in brig to carry scim external ids.
* Fix: UserSSOId parsing in spar.
* Fix: store RichInfo in brig if it changes.
* Fix: do not support setting passwords in SCIM
* Fix: update sso_id in brig correctly.
* Fix: do not pull users with email pending validation.
* Refactor: functions for handler-, email-based scim user lookup.
* Give externalIds that are emails their own lookup table in spar.
* Fix: check if email address is available (even without idp).
* Fix: scim-delete if there is no saml idp.
* Refactor: reduce integration test setup time.
* Fix: do not use email address as saml subject if no uref is found.
* Add at least a few lines of docs.
* Assert that deleteUser returns 204


Co-authored-by: Arian van Putten <arian.vanputten@gmail.com>
---
 docs/reference/spar-braindump.md              |  19 +
 libs/brig-types/src/Brig/Types/Intra.hs       |   2 +-
 libs/wire-api/src/Wire/API/User.hs            |  10 +-
 libs/wire-api/src/Wire/API/User/Identity.hs   |  34 +-
 services/brig/src/Brig/API/Internal.hs        |  69 ++-
 services/brig/src/Brig/API/Public.hs          |   4 +-
 services/brig/src/Brig/API/User.hs            |  12 +-
 services/brig/src/Brig/Data/User.hs           |   4 +-
 services/brig/src/Brig/Team/API.hs            |   2 +-
 services/spar/package.yaml                    |   1 +
 services/spar/schema/src/Main.hs              |   4 +-
 services/spar/schema/src/V10.hs               |  37 ++
 services/spar/spar.cabal                      |   5 +-
 services/spar/src/Spar/App.hs                 |  71 +--
 services/spar/src/Spar/Data.hs                |  33 +-
 services/spar/src/Spar/Error.hs               |   5 +-
 services/spar/src/Spar/Intra/Brig.hs          | 388 +++++++++-------
 services/spar/src/Spar/Intra/Galley.hs        |  10 +-
 services/spar/src/Spar/Scim/Auth.hs           |  51 +-
 services/spar/src/Spar/Scim/Types.hs          |  38 +-
 services/spar/src/Spar/Scim/User.hs           | 438 +++++++++---------
 services/spar/src/Spar/Types.hs               |   2 +-
 .../test-integration/Test/Spar/APISpec.hs     |   5 +-
 .../test-integration/Test/Spar/DataSpec.hs    |  23 +-
 .../Test/Spar/Intra/BrigSpec.hs               |  26 +-
 .../Test/Spar/Scim/AuthSpec.hs                |  37 +-
 .../Test/Spar/Scim/UserSpec.hs                | 378 ++++++++++-----
 services/spar/test-integration/Util.hs        |   1 +
 services/spar/test-integration/Util/Core.hs   |  12 +-
 services/spar/test-integration/Util/Email.hs  |  75 +++
 services/spar/test-integration/Util/Scim.hs   |  63 ++-
 .../spar/test/Test/Spar/Intra/BrigSpec.hs     |  47 +-
 32 files changed, 1227 insertions(+), 679 deletions(-)
 create mode 100644 services/spar/schema/src/V10.hs
 create mode 100644 services/spar/test-integration/Util/Email.hs

diff --git a/docs/reference/spar-braindump.md b/docs/reference/spar-braindump.md
index 8d249c274a4..e54eec13f98 100644
--- a/docs/reference/spar-braindump.md
+++ b/docs/reference/spar-braindump.md
@@ -21,6 +21,25 @@ documentation answering your questions, look here!
 - if you want to work on our saml/scim implementation and do not have access to [https://github.com/zinfra/backend-issues/issues?q=is%3Aissue+is%3Aopen+label%3Aspar] and [https://github.com/wireapp/design-specs/tree/master/Single%20Sign%20On], please get in touch with us.
 
 
+## design considerations
+
+### SCIM without SAML.
+
+Before https://github.com/wireapp/wire-server/pull/1200, scim tokens could only be added to teams that already had exactly one SAML IdP.  Now, we also allow SAML-less teams to have SCIM provisioning.  This is an alternative to onboarding via team-settings and produces user accounts that are authenticated with email and password.  (Phone may or may not work, but is not officially supported.)
+
+The way this works is different from team-settings: we don't send invites, but we create active users immediately the moment the SCIM user post is processed.  The new thing is that the created user has neither email nor phone nor a SAML identity, nor a password.
+
+How does this work?
+
+**email:** If no SAML IdP is present, SCIM user posts must contain an externalId that is an email address.  This email address is not added to the newly created user, because it has not been validated.  Instead, the flow for changing an email address is triggered in brig: an email is sent to the address containing a validation key, and once the user completes the flow, brig will add the email address to the user.  We had to add very little code for this in this PR, it's all an old feature.
+
+When SCIM user gets are processed, in order to reconstruct the externalId from the user spar is retrieving from brig, we introduce a new json object for the `sso_id` field that looks like this: `{'scim_external_id': 'me@example.com'}`.
+
+In order to find users that have email addresses pending validation, we introduce a new table in spar's cassandra called `scim_external_ids`, in analogy to `user`.  We have tried to use brig's internal `GET /i/user&email=...`, but that also finds pending email addresses, and there are corner cases when changing email addresses and waiting for the new address to be validated and the old to be removed...  that made this approach seem infeasible.
+
+**password:** once the user has validated their email address, they need to trigger the "forgot password" flow -- also old code.
+
+
 ## operations
 
 ### enabling / disabling the sso feature for a team
diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs
index 5faddf2bf6a..6a103642f86 100644
--- a/libs/brig-types/src/Brig/Types/Intra.hs
+++ b/libs/brig-types/src/Brig/Types/Intra.hs
@@ -64,7 +64,7 @@ instance ToJSON AccountStatus where
   toJSON Deleted = String "deleted"
   toJSON Ephemeral = String "ephemeral"
 
-data AccountStatusResp = AccountStatusResp AccountStatus
+data AccountStatusResp = AccountStatusResp {fromAccountStatusResp :: AccountStatus}
 
 instance ToJSON AccountStatusResp where
   toJSON (AccountStatusResp s) = object ["status" .= s]
diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs
index 5afbd6d6bf7..68f66c0b34e 100644
--- a/libs/wire-api/src/Wire/API/User.hs
+++ b/libs/wire-api/src/Wire/API/User.hs
@@ -694,10 +694,9 @@ parseNewUserOrigin pass uid ssoid o = do
     (Nothing, Nothing, Just a, Nothing, Nothing) -> return . Just . NewUserOriginTeamUser $ NewTeamCreator a
     (Nothing, Nothing, Nothing, Just _, Just t) -> return . Just . NewUserOriginTeamUser $ NewTeamMemberSSO t
     (Nothing, Nothing, Nothing, Nothing, Nothing) -> return Nothing
-    (_, _, _, _, _) ->
-      fail $
-        "team_code, team, invitation_code, sso_id are mutually exclusive\
-        \ and sso_id, team_id must be either both present or both absent."
+    (_, _, _, Just _, Nothing) -> fail "sso_id, team_id must be either both present or both absent."
+    (_, _, _, Nothing, Just _) -> fail "sso_id, team_id must be either both present or both absent."
+    _ -> fail "team_code, team, invitation_code, sso_id, and the pair (sso_id, team_id) are mutually exclusive"
   case (result, pass, uid) of
     (_, _, Just SSOIdentity {}) -> pure result
     (Just (NewUserOriginTeamUser _), Nothing, _) -> fail "all team users must set a password on creation"
@@ -729,7 +728,8 @@ data NewTeamUser
   = -- | requires email address
     NewTeamMember InvitationCode
   | NewTeamCreator BindingNewTeamUser
-  | NewTeamMemberSSO TeamId
+  | -- | sso: users with saml credentials and/or created via scim
+    NewTeamMemberSSO TeamId
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewTeamUser)
 
diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs
index 92acc22a824..e727088dcd9 100644
--- a/libs/wire-api/src/Wire/API/User/Identity.hs
+++ b/libs/wire-api/src/Wire/API/User/Identity.hs
@@ -247,24 +247,34 @@ isValidPhone = either (const False) (const True) . parseOnly e164
 -- Morally this is the same thing as 'SAML.UserRef', but we forget the
 -- structure -- i.e. we just store XML-encoded SAML blobs. If the structure
 -- of those blobs changes, Brig won't have to deal with it, only Spar will.
-data UserSSOId = UserSSOId
-  { -- | An XML blob pointing to the identity provider that can confirm
-    -- user's identity.
-    userSSOIdTenant :: Text,
-    -- | An XML blob specifying the user's ID on the identity provider's side.
-    userSSOIdSubject :: Text
-  }
+--
+-- FUTUREWORK: rename the data type to @UserSparId@ (not the two constructors, those are ok).
+data UserSSOId
+  = UserSSOId
+      -- An XML blob pointing to the identity provider that can confirm
+      -- user's identity.
+      Text
+      -- An XML blob specifying the user's ID on the identity provider's side.
+      Text
+  | UserScimExternalId
+      Text
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserSSOId)
 
 instance ToJSON UserSSOId where
-  toJSON (UserSSOId tenant subject) = object ["tenant" .= tenant, "subject" .= subject]
+  toJSON = \case
+    UserSSOId tenant subject -> object ["tenant" .= tenant, "subject" .= subject]
+    UserScimExternalId eid -> object ["scim_external_id" .= eid]
 
 instance FromJSON UserSSOId where
-  parseJSON = withObject "UserSSOId" $ \obj ->
-    UserSSOId
-      <$> obj .: "tenant"
-      <*> obj .: "subject"
+  parseJSON = withObject "UserSSOId" $ \obj -> do
+    mtenant <- obj .:? "tenant"
+    msubject <- obj .:? "subject"
+    meid <- obj .:? "scim_external_id"
+    case (mtenant, msubject, meid) of
+      (Just tenant, Just subject, Nothing) -> pure $ UserSSOId tenant subject
+      (Nothing, Nothing, Just eid) -> pure $ UserScimExternalId eid
+      _ -> fail "either need tenant and subject, or scim_external_id, but not both"
 
 -- | If the budget for SMS and voice calls for a phone number
 -- has been exhausted within a certain time frame, this timeout
diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs
index 9fe36ce232a..4c5a296ae69 100644
--- a/services/brig/src/Brig/API/Internal.hs
+++ b/services/brig/src/Brig/API/Internal.hs
@@ -29,6 +29,7 @@ import Brig.API.Handler
 import qualified Brig.API.IdMapping as IdMapping
 import Brig.API.Types
 import qualified Brig.API.User as API
+import Brig.API.Util (validateHandle)
 import Brig.App
 import qualified Brig.Data.User as Data
 import Brig.Options hiding (internalEvents, sesQueue)
@@ -58,6 +59,7 @@ import Network.Wai.Routing
 import Network.Wai.Utilities as Utilities
 import Network.Wai.Utilities.Response (json)
 import Network.Wai.Utilities.ZAuth (zauthConnId, zauthUserId)
+import Wire.API.User
 import Wire.API.User.RichInfo
 
 ---------------------------------------------------------------------------
@@ -173,6 +175,10 @@ sitemap = do
       .&. accept "application" "json"
       .&. jsonRequest @UserSSOId
 
+  delete "/i/users/:uid/sso-id" (continue deleteSSOIdH) $
+    capture "uid"
+      .&. accept "application" "json"
+
   put "/i/users/:uid/managed-by" (continue updateManagedByH) $
     capture "uid"
       .&. accept "application" "json"
@@ -183,6 +189,22 @@ sitemap = do
       .&. accept "application" "json"
       .&. jsonRequest @RichInfoUpdate
 
+  put "/i/users/:uid/handle" (continue updateHandleH) $
+    capture "uid"
+      .&. accept "application" "json"
+      .&. jsonRequest @HandleUpdate
+
+  put "/i/users/:uid/name" (continue updateUserNameH) $
+    capture "uid"
+      .&. accept "application" "json"
+      .&. jsonRequest @NameUpdate
+
+  get "/i/users/:uid/rich-info" (continue getRichInfoH) $
+    capture "uid"
+
+  head "/i/users/handles/:handle" (continue checkHandleInternalH) $
+    capture "handle"
+
   post "/i/clients" (continue internalListClientsH) $
     accept "application" "json"
       .&. jsonRequest @UserSet
@@ -433,7 +455,14 @@ addPhonePrefixH (_ ::: req) = do
 updateSSOIdH :: UserId ::: JSON ::: JsonRequest UserSSOId -> Handler Response
 updateSSOIdH (uid ::: _ ::: req) = do
   ssoid :: UserSSOId <- parseJsonBody req
-  success <- lift $ Data.updateSSOId uid ssoid
+  success <- lift $ Data.updateSSOId uid (Just ssoid)
+  if success
+    then return empty
+    else return . setStatus status404 $ plain "User does not exist or has no team."
+
+deleteSSOIdH :: UserId ::: JSON -> Handler Response
+deleteSSOIdH (uid ::: _) = do
+  success <- lift $ Data.updateSSOId uid Nothing
   if success
     then return empty
     else return . setStatus status404 $ plain "User does not exist or has no team."
@@ -457,6 +486,44 @@ updateRichInfo uid rup = do
   -- Intra.onUserEvent uid (Just conn) (richInfoUpdate uid ri)
   lift $ Data.updateRichInfo uid (RichInfoAssocList richInfo)
 
+getRichInfoH :: UserId -> Handler Response
+getRichInfoH uid = json <$> getRichInfo uid
+
+getRichInfo :: UserId -> Handler RichInfo
+getRichInfo uid = RichInfo . fromMaybe emptyRichInfoAssocList <$> lift (API.lookupRichInfo uid)
+
+updateHandleH :: UserId ::: JSON ::: JsonRequest HandleUpdate -> Handler Response
+updateHandleH (uid ::: _ ::: body) = empty <$ (updateHandle uid =<< parseJsonBody body)
+
+updateHandle :: UserId -> HandleUpdate -> Handler ()
+updateHandle uid (HandleUpdate handleUpd) = do
+  handle <- validateHandle handleUpd
+  API.changeHandle uid Nothing handle !>> changeHandleError
+
+updateUserNameH :: UserId ::: JSON ::: JsonRequest NameUpdate -> Handler Response
+updateUserNameH (uid ::: _ ::: body) = empty <$ (updateUserName uid =<< parseJsonBody body)
+
+updateUserName :: UserId -> NameUpdate -> Handler ()
+updateUserName uid (NameUpdate nameUpd) = do
+  name <- either (const $ throwStd invalidUser) pure $ mkName nameUpd
+  let uu =
+        UserUpdate
+          { uupName = Just name,
+            uupPict = Nothing,
+            uupAssets = Nothing,
+            uupAccentId = Nothing
+          }
+  lift (Data.lookupUser uid) >>= \case
+    Just _ -> lift $ API.updateUser uid Nothing uu
+    Nothing -> throwStd invalidUser
+
+checkHandleInternalH :: Text -> Handler Response
+checkHandleInternalH =
+  API.checkHandle >=> \case
+    API.CheckHandleInvalid -> throwE (StdError invalidHandle)
+    API.CheckHandleFound -> pure $ setStatus status200 empty
+    API.CheckHandleNotFound -> pure $ setStatus status404 empty
+
 getContactListH :: JSON ::: UserId -> Handler Response
 getContactListH (_ ::: uid) = do
   contacts <- lift $ API.lookupContactList uid
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index ef9158eff73..f40c5b03c81 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -1096,7 +1096,7 @@ instance ToJSON GetActivationCodeResp where
 updateUserH :: UserId ::: ConnId ::: JsonRequest Public.UserUpdate -> Handler Response
 updateUserH (uid ::: conn ::: req) = do
   uu <- parseJsonBody req
-  lift $ API.updateUser uid conn uu
+  lift $ API.updateUser uid (Just conn) uu
   return empty
 
 changePhoneH :: UserId ::: ConnId ::: JsonRequest Public.PhoneUpdate -> Handler Response
@@ -1177,7 +1177,7 @@ changeHandleH (u ::: conn ::: req) = do
 changeHandle :: UserId -> ConnId -> Public.HandleUpdate -> Handler ()
 changeHandle u conn (Public.HandleUpdate h) = do
   handle <- API.validateHandle h
-  API.changeHandle u conn handle !>> changeHandleError
+  API.changeHandle u (Just conn) handle !>> changeHandleError
 
 beginPasswordResetH :: JSON ::: JsonRequest Public.NewPasswordReset -> Handler Response
 beginPasswordResetH (_ ::: req) = do
diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs
index 5c0fa7b9964..a861304e37b 100644
--- a/services/brig/src/Brig/API/User.hs
+++ b/services/brig/src/Brig/API/User.hs
@@ -335,10 +335,10 @@ checkRestrictedUserCreation new = do
 -- FUTUREWORK: this and other functions should refuse to modify a ManagedByScim user. See
 -- {#SparBrainDump}  https://github.com/zinfra/backend-issues/issues/1632
 
-updateUser :: UserId -> ConnId -> UserUpdate -> AppIO ()
-updateUser uid conn uu = do
+updateUser :: UserId -> Maybe ConnId -> UserUpdate -> AppIO ()
+updateUser uid mconn uu = do
   Data.updateUser uid uu
-  Intra.onUserEvent uid (Just conn) (profileUpdated uid uu)
+  Intra.onUserEvent uid mconn (profileUpdated uid uu)
 
 -------------------------------------------------------------------------------
 -- Update Locale
@@ -359,8 +359,8 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do
 --------------------------------------------------------------------------------
 -- Change Handle
 
-changeHandle :: UserId -> ConnId -> Handle -> ExceptT ChangeHandleError AppIO ()
-changeHandle uid conn hdl = do
+changeHandle :: UserId -> Maybe ConnId -> Handle -> ExceptT ChangeHandleError AppIO ()
+changeHandle uid mconn hdl = do
   when (isBlacklistedHandle hdl) $
     throwE ChangeHandleInvalid
   usr <- lift $ Data.lookupUser uid
@@ -374,7 +374,7 @@ changeHandle uid conn hdl = do
       claimed <- lift $ claimHandle (userId u) (userHandle u) hdl
       unless claimed $
         throwE ChangeHandleExists
-      lift $ Intra.onUserEvent uid (Just conn) (handleUpdated uid hdl)
+      lift $ Intra.onUserEvent uid mconn (handleUpdated uid hdl)
 
 --------------------------------------------------------------------------------
 -- Check Handle
diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs
index 6387da78ba8..b192b8fd8f8 100644
--- a/services/brig/src/Brig/Data/User.hs
+++ b/services/brig/src/Brig/Data/User.hs
@@ -238,7 +238,7 @@ updateEmail u e = retry x5 $ write userEmailUpdate (params Quorum (e, u))
 updatePhone :: UserId -> Phone -> AppIO ()
 updatePhone u p = retry x5 $ write userPhoneUpdate (params Quorum (p, u))
 
-updateSSOId :: UserId -> UserSSOId -> AppIO Bool
+updateSSOId :: UserId -> Maybe UserSSOId -> AppIO Bool
 updateSSOId u ssoid = do
   mteamid <- lookupUserTeam u
   case mteamid of
@@ -549,7 +549,7 @@ userEmailUpdate = "UPDATE user SET email = ? WHERE id = ?"
 userPhoneUpdate :: PrepQuery W (Phone, UserId) ()
 userPhoneUpdate = "UPDATE user SET phone = ? WHERE id = ?"
 
-userSSOIdUpdate :: PrepQuery W (UserSSOId, UserId) ()
+userSSOIdUpdate :: PrepQuery W (Maybe UserSSOId, UserId) ()
 userSSOIdUpdate = "UPDATE user SET sso_id = ? WHERE id = ?"
 
 userManagedByUpdate :: PrepQuery W (ManagedBy, UserId) ()
diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs
index ee5d7366761..9aff2cb2759 100644
--- a/services/brig/src/Brig/Team/API.hs
+++ b/services/brig/src/Brig/Team/API.hs
@@ -283,7 +283,7 @@ deleteInvitationH (_ ::: uid ::: tid ::: iid) = do
 deleteInvitation :: UserId -> TeamId -> InvitationId -> Handler ()
 deleteInvitation uid tid iid = do
   ensurePermissions uid tid [Team.AddTeamMember]
-  lift $ DB.deleteInvitation tid iid
+  DB.deleteInvitation tid iid
 
 listInvitationsH :: JSON ::: UserId ::: TeamId ::: Maybe InvitationId ::: Range 1 500 Int32 -> Handler Response
 listInvitationsH (_ ::: uid ::: tid ::: start ::: size) = do
diff --git a/services/spar/package.yaml b/services/spar/package.yaml
index 89625edfd06..d641be5ff25 100644
--- a/services/spar/package.yaml
+++ b/services/spar/package.yaml
@@ -143,6 +143,7 @@ executables:
       - silently
       - spar
       - stm
+      - tasty-hunit
       - tinylog
       - wai
       - wai-extra
diff --git a/services/spar/schema/src/Main.hs b/services/spar/schema/src/Main.hs
index 50dd4e4997a..0cd5e61423e 100644
--- a/services/spar/schema/src/Main.hs
+++ b/services/spar/schema/src/Main.hs
@@ -24,6 +24,7 @@ import qualified System.Logger.Extended as Log
 import Util.Options
 import qualified V0
 import qualified V1
+import qualified V10
 import qualified V2
 import qualified V3
 import qualified V4
@@ -51,7 +52,8 @@ main = do
       V6.migration,
       V7.migration,
       V8.migration,
-      V9.migration
+      V9.migration,
+      V10.migration
       -- When adding migrations here, don't forget to update
       -- 'schemaVersion' in Spar.Data
 
diff --git a/services/spar/schema/src/V10.hs b/services/spar/schema/src/V10.hs
new file mode 100644
index 00000000000..07d0a25b3de
--- /dev/null
+++ b/services/spar/schema/src/V10.hs
@@ -0,0 +1,37 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 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 V10
+  ( migration,
+  )
+where
+
+import Cassandra.Schema
+import Imports
+import Text.RawString.QQ
+
+migration :: Migration
+migration = Migration 10 "Add table for mapping scim external ids to brig user ids" $ do
+  void $
+    schema'
+      [r|
+        CREATE TABLE if not exists scim_external_ids
+          ( external  text
+          , user      uuid
+          , primary key (external)
+          ) with compaction = {'class': 'LeveledCompactionStrategy'};
+      |]
diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal
index ade51ff3871..bae725a5dd5 100644
--- a/services/spar/spar.cabal
+++ b/services/spar/spar.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: c4215bccf7e235dad19c5eb68954faf664f92ff0b3d7aeacdfb6ac21b448503b
+-- hash: 88a250ccd05fb0ad0b42a8b133068a52e559f6b5e00efb0df3098445c92f2a45
 
 name:           spar
 version:        0.1
@@ -207,6 +207,7 @@ executable spar-integration
       Test.Spar.Scim.UserSpec
       Util
       Util.Core
+      Util.Email
       Util.Scim
       Util.Types
       Paths_spar
@@ -277,6 +278,7 @@ executable spar-integration
     , stm
     , string-conversions
     , swagger2
+    , tasty-hunit
     , text
     , text-latin1
     , time
@@ -306,6 +308,7 @@ executable spar-schema
   other-modules:
       V0
       V1
+      V10
       V2
       V3
       V4
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index d7f041c6794..56778246e97 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -54,7 +54,7 @@ import Imports hiding (log)
 import qualified Network.HTTP.Types.Status as Http
 import qualified Network.Wai.Utilities.Error as Wai
 import SAML2.Util (renderURI)
-import SAML2.WebSSO hiding (UserRef (..))
+import SAML2.WebSSO hiding (Email (..), UserRef (..))
 import qualified SAML2.WebSSO as SAML
 import Servant
 import qualified Servant.Multipart as Multipart
@@ -65,13 +65,12 @@ import Spar.Error
 import qualified Spar.Intra.Brig as Intra
 import qualified Spar.Intra.Galley as Intra
 import Spar.Orphans ()
+import Spar.Scim.Types (ValidExternalId (..), runValidExternalId)
 import Spar.Types
 import qualified System.Logger as Log
 import System.Logger.Class (MonadLogger (log))
-import Text.Email.Parser (domainPart, localPart)
 import URI.ByteString as URI
 import Web.Cookie (SetCookie, renderSetCookie)
-import qualified Wire.API.User.Identity as WireEmail
 
 newtype Spar a = Spar {fromSpar :: ReaderT Env (ExceptT SparError IO) a}
   deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env, MonadError SparError)
@@ -154,8 +153,9 @@ wrapMonadClient action = do
 insertUser :: SAML.UserRef -> UserId -> Spar ()
 insertUser uref uid = wrapMonadClient $ Data.insertSAMLUser uref uid
 
--- | Look up user locally, then in brig, then return the 'UserId'.  If either lookup fails, or
--- user is not in a team, return 'Nothing'.  See also: 'Spar.App.createUser'.
+-- | Look up user locally in table @spar.user@, then in brig, then return the 'UserId'.  If
+-- either lookup fails, or user is not in a team, return 'Nothing'.  See also:
+-- 'Spar.App.createUser'.
 --
 -- It makes sense to require that users are required to be team members: the idp is created in
 -- the context of a team, and the only way for users to be created is as team members.  If a
@@ -163,9 +163,9 @@ insertUser uref uid = wrapMonadClient $ Data.insertSAMLUser uref uid
 --
 -- ASSUMPTIONS: User creation on brig/galley is idempotent.  Any incomplete creation (because of
 -- brig or galley crashing) will cause the lookup here to yield invalid user.
-getUser :: SAML.UserRef -> Spar (Maybe UserId)
-getUser uref = do
-  muid <- wrapMonadClient $ Data.getSAMLUser uref
+getUser :: ValidExternalId -> Spar (Maybe UserId)
+getUser veid = do
+  muid <- wrapMonadClient $ runValidExternalId Data.getSAMLUser Data.lookupScimExternalId veid
   case muid of
     Nothing -> pure Nothing
     Just uid -> do
@@ -191,8 +191,8 @@ getUser uref = do
 createSamlUserWithId :: UserId -> SAML.UserRef -> ManagedBy -> Spar ()
 createSamlUserWithId buid suid managedBy = do
   teamid <- (^. idpExtraInfo . wiTeam) <$> getIdPConfigByIssuer (suid ^. uidTenant)
-  uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing suid
-  buid' <- Intra.createBrigUser suid buid teamid uname managedBy
+  uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid)
+  buid' <- Intra.createBrigUser (UrefOnly suid) buid teamid uname managedBy
   assert (buid == buid') $ pure ()
   insertUser suid buid
 
@@ -215,37 +215,44 @@ autoprovisionSamlUserWithId buid suid managedBy = do
   if null scimtoks
     then do
       createSamlUserWithId buid suid managedBy
-      validateEmailIfExists buid suid
+      validateEmailIfExists buid (UrefOnly suid)
     else
       throwError . SAML.Forbidden $
         "bad credentials (note that your team uses SCIM, "
           <> "which disables saml auto-provisioning)"
 
--- | If user's 'NameID' is an email address and the team has email validation for SSO enabled,
--- make brig send a validation email to the address the user registered under.  If the
--- traditional validation procedure succeeds, the user will have an email address.
-validateEmailIfExists :: UserId -> SAML.UserRef -> Spar ()
-validateEmailIfExists uid (SAML.UserRef _ nameid) = case nameid ^. SAML.nameID of
-  UNameIDEmail email -> do
-    Intra.isEmailValidationEnabledUser uid >>= \case
-      True -> Intra.updateEmail uid (castEmail email)
-      False -> pure ()
-  _ -> pure ()
+-- | If (a) user's 'NameID' is an email address and the team has email validation for SSO
+-- enabled, or (b) user's SCIM externalId is an email address and there is no SAML involved:
+-- make brig initiate the email validate procedure.
+validateEmailIfExists :: UserId -> ValidExternalId -> Spar ()
+validateEmailIfExists uid =
+  runValidExternalId
+    ( \case
+        (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate False email
+        _ -> pure ()
+    )
+    (doValidate True . Intra.emailToSAML)
   where
-    castEmail :: Email -> WireEmail.Email
-    castEmail (Email adr) = WireEmail.Email (cs $ localPart adr) (cs $ domainPart adr)
+    doValidate :: Bool -> SAML.Email -> Spar ()
+    doValidate always email = do
+      enabled <- do
+        tid <- Intra.getBrigUserTeam uid
+        maybe (pure False) Intra.isEmailValidationEnabledTeam tid
+      case enabled || always of
+        True -> Intra.updateEmail uid (Intra.emailFromSAML email)
+        False -> pure ()
 
 -- | Check if 'UserId' is in the team that hosts the idp that owns the 'UserRef'.  If so, write the
 -- 'UserRef' into the 'UserIdentity'.  Otherwise, throw an error.
 bindUser :: UserId -> SAML.UserRef -> Spar UserId
 bindUser buid userref = do
-  teamid <- (^. idpExtraInfo . wiTeam) <$> getIdPConfigByIssuer (userref ^. uidTenant)
-  uteamid <- Intra.getBrigUserTeam buid
-  unless
-    (uteamid == Just teamid)
-    (throwSpar . SparBindFromWrongOrNoTeam . cs . show $ uteamid)
+  do
+    teamid <- (^. idpExtraInfo . wiTeam) <$> getIdPConfigByIssuer (userref ^. uidTenant)
+    mteamid' <- Intra.getBrigUserTeam buid
+    unless (mteamid' == Just teamid) $ do
+      throwSpar . SparBindFromWrongOrNoTeam . cs . show $ buid
   insertUser userref buid
-  buid <$ Intra.setBrigUserUserRef buid userref
+  buid <$ Intra.setBrigUserVeid buid (UrefOnly userref)
 
 instance SPHandler SparError Spar where
   type NTCTX Spar = Env
@@ -332,7 +339,7 @@ findUserWithOldIssuer (SAML.UserRef issuer subject) = do
   idp <- getIdPConfigByIssuer issuer
   let tryFind :: Maybe (SAML.UserRef, UserId) -> Issuer -> Spar (Maybe (SAML.UserRef, UserId))
       tryFind found@(Just _) _ = pure found
-      tryFind Nothing oldIssuer = (uref,) <$$> getUser uref
+      tryFind Nothing oldIssuer = (uref,) <$$> getUser (UrefOnly uref)
         where
           uref = SAML.UserRef oldIssuer subject
   foldM tryFind Nothing (idp ^. idpExtraInfo . wiOldIssuers)
@@ -342,7 +349,7 @@ findUserWithOldIssuer (SAML.UserRef issuer subject) = do
 moveUserToNewIssuer :: SAML.UserRef -> SAML.UserRef -> UserId -> Spar ()
 moveUserToNewIssuer oldUserRef newUserRef uid = do
   wrapMonadClient $ Data.insertSAMLUser newUserRef uid
-  Intra.setBrigUserUserRef uid newUserRef
+  Intra.setBrigUserVeid uid (UrefOnly newUserRef)
   wrapMonadClient $ Data.deleteSAMLUser oldUserRef
 
 verdictHandlerResultCore :: HasCallStack => Maybe BindCookie -> SAML.AccessVerdict -> Spar VerdictHandlerResult
@@ -352,7 +359,7 @@ verdictHandlerResultCore bindCky = \case
   SAML.AccessGranted userref -> do
     uid :: UserId <- do
       viaBindCookie <- maybe (pure Nothing) (wrapMonadClient . Data.lookupBindCookie) bindCky
-      viaSparCassandra <- getUser userref
+      viaSparCassandra <- getUser (UrefOnly userref)
       -- race conditions: if the user has been created on spar, but not on brig, 'getUser'
       -- returns 'Nothing'.  this is ok assuming 'createUser', 'bindUser' (called below) are
       -- idempotent.
diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs
index 8eb46193db0..d31bfecf97f 100644
--- a/services/spar/src/Spar/Data.hs
+++ b/services/spar/src/Spar/Data.hs
@@ -75,13 +75,17 @@ module Spar.Data
     deleteScimToken,
     deleteTeamScimTokens,
 
-    -- * SCIM user timestampes
+    -- * SCIM externalids, user timestamps
     writeScimUserTimes,
     readScimUserTimes,
     deleteScimUserTimes,
+    insertScimExternalId,
+    lookupScimExternalId,
+    deleteScimExternalId,
   )
 where
 
+import Brig.Types.Common (Email, fromEmail)
 import Cassandra as Cas
 import Control.Lens
 import Control.Monad.Except
@@ -105,7 +109,7 @@ import Web.Scim.Schema.Meta (Meta (..), WithMeta (..))
 
 -- | A lower bound: @schemaVersion <= whatWeFoundOnCassandra@, not @==@.
 schemaVersion :: Int32
-schemaVersion = 9
+schemaVersion = 10
 
 ----------------------------------------------------------------------
 -- helpers
@@ -735,3 +739,28 @@ deleteScimUserTimes uid = retry x5 . write del $ params Quorum (Identity uid)
   where
     del :: PrepQuery W (Identity UserId) ()
     del = "DELETE FROM scim_user_times WHERE uid = ?"
+
+-- | If a scim externalId does not have an associated saml idp issuer, it cannot be stored in
+-- table @spar.user@.  In those cases, and only in those cases, we store the mapping to
+-- 'UserId' here.  (Note that since there is no associated IdP, the externalId is required to
+-- be an email address, so we enforce that in the type signature, even though we only use it
+-- as a 'Text'.)
+insertScimExternalId :: (HasCallStack, MonadClient m) => Email -> UserId -> m ()
+insertScimExternalId (fromEmail -> email) uid = retry x5 . write ins $ params Quorum (email, uid)
+  where
+    ins :: PrepQuery W (Text, UserId) ()
+    ins = "INSERT INTO scim_external_ids (external, user) VALUES (?, ?)"
+
+-- | The inverse of 'insertScimExternalId'.
+lookupScimExternalId :: (HasCallStack, MonadClient m) => Email -> m (Maybe UserId)
+lookupScimExternalId (fromEmail -> email) = runIdentity <$$> (retry x1 . query1 sel $ params Quorum (Identity email))
+  where
+    sel :: PrepQuery R (Identity Text) (Identity UserId)
+    sel = "SELECT user FROM scim_external_ids WHERE external = ?"
+
+-- | The other inverse of 'insertScimExternalId' :).
+deleteScimExternalId :: (HasCallStack, MonadClient m) => Email -> m ()
+deleteScimExternalId (fromEmail -> email) = retry x5 . write del $ params Quorum (Identity email)
+  where
+    del :: PrepQuery W (Identity Text) ()
+    del = "DELETE FROM scim_external_ids WHERE external = ?"
diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs
index cc9f7273c79..2074f29407b 100644
--- a/services/spar/src/Spar/Error.hs
+++ b/services/spar/src/Spar/Error.hs
@@ -32,6 +32,7 @@ module Spar.Error
     renderSparErrorWithLogging,
     -- FUTUREWORK: we really shouldn't export this, but that requires that we can use our
     -- custom servant monad in the 'MakeCustomError' instances.
+    servantToWaiError,
     sparToServerError,
     renderSparError,
     waiToServant,
@@ -94,7 +95,7 @@ data SparCustomError
   | SparNewIdPWantHttps LT
   | SparIdPHasBoundUsers
   | SparIdPIssuerInUse
-  | SparProvisioningNoSingleIdP LT
+  | SparProvisioningMoreThanOneIdP LT
   | SparProvisioningTokenLimitReached
   | -- | All errors returned from SCIM handlers are wrapped into 'SparScimError'
     SparScimError Scim.ScimError
@@ -179,7 +180,7 @@ renderSparError (SAML.CustomError (SparNewIdPWantHttps msg)) = Right $ Wai.Error
 renderSparError (SAML.CustomError SparIdPHasBoundUsers) = Right $ Wai.Error status412 "idp-has-bound-users" "an idp can only be deleted if it is empty"
 renderSparError (SAML.CustomError SparIdPIssuerInUse) = Right $ Wai.Error status400 "idp-issuer-in-use" "The issuer of your IdP is already in use.  Remove the entry in the team that uses it, or construct a new IdP issuer."
 -- Errors related to provisioning
-renderSparError (SAML.CustomError (SparProvisioningNoSingleIdP msg)) = Right $ Wai.Error status400 "no-single-idp" ("Team should have exactly one IdP configured: " <> msg)
+renderSparError (SAML.CustomError (SparProvisioningMoreThanOneIdP msg)) = Right $ Wai.Error status400 "more-than-one-idp" ("Team can have at most one IdP configured: " <> msg)
 renderSparError (SAML.CustomError SparProvisioningTokenLimitReached) = Right $ Wai.Error status403 "token-limit-reached" "The limit of provisioning tokens per team has been reached"
 -- SCIM errors
 renderSparError (SAML.CustomError (SparScimError err)) = Left $ Scim.scimToServerError err
diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs
index 1f2e579e707..3f22161a401 100644
--- a/services/spar/src/Spar/Intra/Brig.hs
+++ b/services/spar/src/Spar/Intra/Brig.hs
@@ -19,19 +19,28 @@
 
 -- | Client functions for interacting with the Brig API.
 module Spar.Intra.Brig
-  ( toUserSSOId,
-    fromUserSSOId,
-    toExternalId,
+  ( veidToUserSSOId,
+    veidFromUserSSOId,
+    urefToExternalId,
+    urefToEmail,
+    userToExternalId,
+    veidFromBrigUser,
     mkUserName,
+    renderValidExternalId,
+    emailFromSAML,
+    emailToSAML,
+    emailToSAMLNameID,
+    emailFromSAMLNameID,
     getBrigUser,
+    getBrigUserAccount,
     getBrigUserTeam,
-    getBrigUsers,
     getBrigUserByHandle,
+    getBrigUserByEmail,
     getBrigUserRichInfo,
     setBrigUserName,
     setBrigUserHandle,
     setBrigUserManagedBy,
-    setBrigUserUserRef,
+    setBrigUserVeid,
     setBrigUserRichInfo,
     checkHandleAvailable,
     deleteBrigUser,
@@ -42,70 +51,110 @@ module Spar.Intra.Brig
     ssoLogin,
     parseResponse,
     MonadSparToBrig (..),
-    isEmailValidationEnabledUser,
     getStatus,
+    getStatusMaybe,
     setStatus,
     giveDefaultHandle,
   )
 where
 
--- TODO: when creating user, we need to be able to provide more
--- master data (first name, last name, ...)
-
 import Bilge
 import Brig.Types.Intra
 import Brig.Types.User
 import Brig.Types.User.Auth (SsoLogin (..))
 import Control.Lens
 import Control.Monad.Except
-import Data.Aeson (FromJSON, eitherDecode')
 import Data.ByteString.Conversion
 import Data.Handle (Handle (Handle, fromHandle))
 import Data.Id (Id (Id), TeamId, UserId)
 import Data.Ix
-import Data.Misc (PlainTextPassword)
+import Data.Misc (PlainTextPassword, (<$$>))
 import Data.String.Conversions
+import Data.String.Conversions (cs)
 import Imports
 import Network.HTTP.Types.Method
+import qualified Network.Wai.Utilities.Error as Wai
 import qualified SAML2.WebSSO as SAML
-import qualified Servant.Server as Servant
 import Spar.Error
-import Spar.Intra.Galley as Galley (MonadSparToGalley, assertIsTeamOwner, isEmailValidationEnabledTeam)
+import Spar.Intra.Galley (parseResponse)
+import Spar.Intra.Galley as Galley (MonadSparToGalley, assertIsTeamOwner)
+import Spar.Scim.Types (ValidExternalId (..), runValidExternalId)
+import qualified Text.Email.Parser
 import Web.Cookie
 import Wire.API.User
 import Wire.API.User.RichInfo as RichInfo
 
 ----------------------------------------------------------------------
 
-toUserSSOId :: SAML.UserRef -> UserSSOId
-toUserSSOId (SAML.UserRef tenant subject) =
-  UserSSOId (cs $ SAML.encodeElem tenant) (cs $ SAML.encodeElem subject)
-
-fromUserSSOId :: MonadError String m => UserSSOId -> m SAML.UserRef
-fromUserSSOId (UserSSOId (cs -> tenant) (cs -> subject)) =
-  case (SAML.decodeElem tenant, SAML.decodeElem subject) of
-    (Right t, Right s) -> pure $ SAML.UserRef t s
-    (Left msg, _) -> throwError msg
-    (_, Left msg) -> throwError msg
-
--- | Converts a brig User SSO Id into an external id
-toExternalId :: MonadError SparError m => UserSSOId -> m Text
-toExternalId ssoid = do
-  uref <- either (throwSpar . SparCouldNotParseBrigResponse . cs) pure $ fromUserSSOId ssoid
-  let subj = uref ^. SAML.uidSubject
-  pure $ SAML.nameIDToST subj
+veidToUserSSOId :: ValidExternalId -> UserSSOId
+veidToUserSSOId =
+  runValidExternalId
+    (\(SAML.UserRef t s) -> UserSSOId (cs $ SAML.encodeElem t) (cs $ SAML.encodeElem s))
+    (UserScimExternalId . fromEmail)
+
+veidFromUserSSOId :: MonadError String m => UserSSOId -> m ValidExternalId
+veidFromUserSSOId = \case
+  UserSSOId tenant subject ->
+    case (SAML.decodeElem $ cs tenant, SAML.decodeElem $ cs subject) of
+      (Right t, Right s) -> do
+        let uref = SAML.UserRef t s
+        case urefToEmail uref of
+          Nothing -> pure $ UrefOnly uref
+          Just email -> pure $ EmailAndUref email uref
+      (Left msg, _) -> throwError msg
+      (_, Left msg) -> throwError msg
+  UserScimExternalId email ->
+    maybe
+      (throwError "externalId not an email and no issuer")
+      (pure . EmailOnly)
+      (parseEmail email)
+
+urefToExternalId :: SAML.UserRef -> Maybe Text
+urefToExternalId = SAML.shortShowNameID . view SAML.uidSubject
+
+urefToEmail :: SAML.UserRef -> Maybe Email
+urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of
+  SAML.UNameIDEmail email -> Just $ emailFromSAML email
+  _ -> Nothing
+
+userToExternalId :: MonadError String m => User -> m Text
+userToExternalId usr =
+  case veidFromUserSSOId <$> userSSOId usr of
+    Nothing -> throwError "brig user without sso_id"
+    Just (Left err) -> throwError err
+    Just (Right veid) ->
+      runValidExternalId
+        (\(SAML.UserRef _ subj) -> maybe (throwError "bad uref from brig") pure $ SAML.shortShowNameID subj)
+        (pure . fromEmail)
+        veid
+
+-- | If the brig user has a 'UserSSOId', transform that into a 'ValidExternalId' (this is a
+-- total function as long as brig obeys the api).  Otherwise, if the user has an email, we can
+-- construct a return value from that (and an optional saml issuer).  If a user only has a
+-- phone number, or no identity at all, throw an error.
+--
+-- Note: the saml issuer is only needed in the case where a user has been invited via team
+-- settings and is now onboarded to saml/scim.  If this case can safely be ruled out, it's ok
+-- to just set it to 'Nothing'.
+veidFromBrigUser :: MonadError String m => User -> Maybe SAML.Issuer -> m ValidExternalId
+veidFromBrigUser usr mIssuer = case (userSSOId usr, userEmail usr, mIssuer) of
+  (Just ssoid, _, _) -> veidFromUserSSOId ssoid
+  (Nothing, Just email, Just issuer) -> pure $ EmailAndUref email (SAML.UserRef issuer (emailToSAMLNameID email))
+  (Nothing, Just email, Nothing) -> pure $ EmailOnly email
+  (Nothing, Nothing, _) -> throwError "user has neither ssoIdentity nor userEmail"
 
 -- | Take a maybe text, construct a 'Name' from what we have in a scim user.  If the text
--- isn't present, use the saml subject (usually an email address).  If both are 'Nothing',
--- fail.
-mkUserName :: Maybe Text -> SAML.UserRef -> Either String Name
-mkUserName (Just n) _ = mkName n
-mkUserName Nothing uref = mkName (SAML.unsafeShowNameID $ uref ^. SAML.uidSubject)
-
-parseResponse :: (FromJSON a, MonadError SparError m) => Response (Maybe LBS) -> m a
-parseResponse resp = do
-  bdy <- maybe (throwSpar SparNoBodyInBrigResponse) pure $ responseBody resp
-  either (throwSpar . SparCouldNotParseBrigResponse . cs) pure $ eitherDecode' bdy
+-- isn't present, use an email address or a saml subject (usually also an email address).  If
+-- both are 'Nothing', fail.
+mkUserName :: Maybe Text -> ValidExternalId -> Either String Name
+mkUserName (Just n) = const $ mkName n
+mkUserName Nothing =
+  runValidExternalId
+    (\uref -> mkName (SAML.unsafeShowNameID $ uref ^. SAML.uidSubject))
+    (\email -> mkName (fromEmail email))
+
+renderValidExternalId :: ValidExternalId -> Maybe Text
+renderValidExternalId = runValidExternalId urefToExternalId (Just . fromEmail)
 
 -- | Similar to 'Network.Wire.Client.API.Auth.tokenResponse', but easier: we just need to set the
 -- cookie in the response, and the redirect will make the client negotiate a fresh auth token.
@@ -118,6 +167,29 @@ respToCookie resp = do
   unless (statusCode resp == 200) crash
   maybe crash (pure . parseSetCookie) $ getHeader "Set-Cookie" resp
 
+emailFromSAML :: HasCallStack => SAML.Email -> Email
+emailFromSAML =
+  fromJust . parseEmail . cs
+    . Text.Email.Parser.toByteString
+    . SAML.fromEmail
+
+emailToSAML :: HasCallStack => Email -> SAML.Email
+emailToSAML brigEmail =
+  SAML.Email $
+    Text.Email.Parser.unsafeEmailAddress
+      (cs $ emailLocal brigEmail)
+      (cs $ emailDomain brigEmail)
+
+-- | FUTUREWORK(fisx): if saml2-web-sso exported the 'NameID' constructor, we could make this
+-- function total without all that praying and hoping.
+emailToSAMLNameID :: HasCallStack => Email -> SAML.NameID
+emailToSAMLNameID = fromRight (error "impossible") . SAML.emailNameID . fromEmail
+
+emailFromSAMLNameID :: HasCallStack => SAML.NameID -> Maybe Email
+emailFromSAMLNameID nid = case nid ^. SAML.nameID of
+  SAML.UNameIDEmail email -> Just $ emailFromSAML email
+  _ -> Nothing
+
 ----------------------------------------------------------------------
 
 class MonadError SparError m => MonadSparToBrig m where
@@ -130,7 +202,7 @@ instance MonadSparToBrig m => MonadSparToBrig (ReaderT r m) where
 createBrigUser ::
   (HasCallStack, MonadSparToBrig m) =>
   -- | SSO identity
-  SAML.UserRef ->
+  ValidExternalId ->
   UserId ->
   TeamId ->
   -- | User name
@@ -138,12 +210,12 @@ createBrigUser ::
   -- | Who should have control over the user
   ManagedBy ->
   m UserId
-createBrigUser suid (Id buid) teamid uname managedBy = do
+createBrigUser veid (Id buid) teamid uname managedBy = do
   let newUser :: NewUser
       newUser =
         (emptyNewUser uname)
           { newUserUUID = Just buid,
-            newUserIdentity = Just $ SSOIdentity (toUserSSOId suid) Nothing Nothing,
+            newUserIdentity = Just $ SSOIdentity (veidToUserSSOId veid) Nothing Nothing,
             newUserOrigin = Just . NewUserOriginTeamUser . NewTeamMemberSSO $ teamid,
             newUserManagedBy = Just managedBy
           }
@@ -152,14 +224,9 @@ createBrigUser suid (Id buid) teamid uname managedBy = do
       method POST
         . path "/i/users"
         . json newUser
-  let sCode = statusCode resp
-  if
-      | sCode < 300 ->
-        userId . selfUser <$> parseResponse @SelfProfile resp
-      | inRange (400, 499) sCode ->
-        throwSpar . SparBrigErrorWith (responseStatus resp) $ "create user failed"
-      | otherwise ->
-        throwSpar . SparBrigError . cs $ "create user failed with status " <> show sCode
+  if statusCode resp `elem` [200, 201]
+    then userId . selfUser <$> parseResponse @SelfProfile resp
+    else rethrow resp
 
 updateEmail :: (HasCallStack, MonadSparToBrig m) => UserId -> Email -> m ()
 updateEmail buid email = do
@@ -177,69 +244,69 @@ updateEmail buid email = do
     -- Wai.Error, it's ok to crash with a 500 here, so we use the unsafe parser.
     _ -> throwError . SAML.CustomServant . waiToServant . responseJsonUnsafe $ resp
 
--- | Get a user; returns 'Nothing' if the user was not found or has been deleted.
 getBrigUser :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe User)
-getBrigUser buid = do
-  resp :: Response (Maybe LBS) <-
+getBrigUser = (accountUser <$$>) . getBrigUserAccount
+
+-- | Get a user; returns 'Nothing' if the user was not found or has been deleted.
+getBrigUserAccount :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe UserAccount)
+getBrigUserAccount buid = do
+  resp :: ResponseLBS <-
     call $
       method GET
-        . path "/self"
-        . header "Z-User" (toByteString' buid)
+        . paths ["/i/users"]
+        . query [("ids", Just $ toByteString' buid)]
   case statusCode resp of
     200 -> do
-      user <- selfUser <$> parseResponse @SelfProfile resp
-      pure $
-        if (userDeleted user)
-          then Nothing
-          else Just user
+      parseResponse @[UserAccount] resp >>= \case
+        [account] ->
+          pure $
+            if userDeleted $ accountUser account
+              then Nothing
+              else Just account
+        _ -> pure Nothing
     404 -> pure Nothing
-    _ -> throwSpar (SparBrigError "Could not retrieve user")
-
--- | Get a list of users; returns a shorter list if some 'UserId's come up empty (no errors).
---
--- TODO: implement an internal end-point on brig that makes this possible with one request.
--- TODO(arianvp): This endpoint exists!
-getBrigUsers :: (HasCallStack, MonadSparToBrig m) => [UserId] -> m [User]
-getBrigUsers = fmap catMaybes . mapM getBrigUser
+    _ -> rethrow resp
 
 -- | Get a user; returns 'Nothing' if the user was not found.
 --
 -- TODO: currently this is not used, but it might be useful later when/if
 -- @hscim@ stops doing checks during user creation.
-getBrigUserByHandle :: (HasCallStack, MonadSparToBrig m) => Handle -> m (Maybe User)
+getBrigUserByHandle :: (HasCallStack, MonadSparToBrig m) => Handle -> m (Maybe UserAccount)
 getBrigUserByHandle handle = do
   resp :: Response (Maybe LBS) <-
     call $
       method GET
         . path "/i/users"
         . queryItem "handles" (toByteString' handle)
-  -- This returns [UserAccount]
   case statusCode resp of
-    200 -> parse <$> parseResponse @[UserAccount] resp
+    200 -> listToMaybe <$> parseResponse @[UserAccount] resp
+    _ -> rethrow resp
+
+getBrigUserByEmail :: (HasCallStack, MonadSparToBrig m) => Email -> m (Maybe UserAccount)
+getBrigUserByEmail email = do
+  resp :: ResponseLBS <-
+    call $
+      method GET
+        . path "/i/users"
+        . queryItem "email" (toByteString' email)
+  case statusCode resp of
+    200 -> do
+      macc <- listToMaybe <$> parseResponse @[UserAccount] resp
+      case userEmail . accountUser =<< macc of
+        Just email' | email' == email -> pure macc
+        _ -> pure Nothing
     404 -> pure Nothing
-    _ -> throwSpar (SparBrigError "Could not retrieve user")
-  where
-    parse :: [UserAccount] -> Maybe User
-    parse (x : []) = Just $ accountUser x
-    parse _ = Nothing -- TODO: What if more accounts get returned?
+    _ -> rethrow resp
 
 -- | Set user' name.  Fails with status <500 if brig fails with <500, and with 500 if brig
 -- fails with >= 500.
 setBrigUserName :: (HasCallStack, MonadSparToBrig m) => UserId -> Name -> m ()
-setBrigUserName buid name = do
+setBrigUserName buid (Name name) = do
   resp <-
     call $
       method PUT
-        . path "/self"
-        . header "Z-User" (toByteString' buid)
-        . header "Z-Connection" ""
-        . json
-          UserUpdate
-            { uupName = Just name,
-              uupPict = Nothing,
-              uupAssets = Nothing,
-              uupAccentId = Nothing
-            }
+        . paths ["/i/users", toByteString' buid, "name"]
+        . json (NameUpdate name)
   let sCode = statusCode resp
   if
       | sCode < 300 ->
@@ -251,23 +318,22 @@ setBrigUserName buid name = do
 
 -- | Set user's handle.  Fails with status <500 if brig fails with <500, and with 500 if brig fails
 -- with >= 500.
-setBrigUserHandle :: (HasCallStack, MonadSparToBrig m) => UserId -> Handle -> m ()
+--
+-- NB: that this doesn't take a 'HandleUpdate', since we already construct a valid handle in
+-- 'validateScimUser' to increase the odds that user creation doesn't fail half-way through
+-- the many database write operations.
+setBrigUserHandle :: (HasCallStack, MonadSparToBrig m) => UserId -> Handle {- not 'HandleUpdate'! -} -> m ()
 setBrigUserHandle buid handle = do
   resp <-
     call $
       method PUT
-        . path "/self/handle"
-        . header "Z-User" (toByteString' buid)
-        . header "Z-Connection" ""
+        . paths ["/i/users", toByteString' buid, "handle"]
         . json (HandleUpdate (fromHandle handle))
-  let sCode = statusCode resp
-  if
-      | sCode < 300 ->
-        pure ()
-      | inRange (400, 499) sCode ->
-        throwSpar . SparBrigErrorWith (responseStatus resp) $ "set handle failed"
-      | otherwise ->
-        throwSpar . SparBrigError . cs $ "set handle failed with status " <> show sCode
+  case (statusCode resp, Wai.label <$> responseJsonMaybe @Wai.Error resp) of
+    (200, Nothing) -> do
+      pure ()
+    _ -> do
+      rethrow resp
 
 -- | Set user's managedBy. Fails with status <500 if brig fails with <500, and with 500 if
 -- brig fails with >= 500.
@@ -276,7 +342,7 @@ setBrigUserManagedBy buid managedBy = do
   resp <-
     call $
       method PUT
-        . paths ["i", "users", toByteString' buid, "managed-by"]
+        . paths ["/i/users", toByteString' buid, "managed-by"]
         . json (ManagedByUpdate managedBy)
   let sCode = statusCode resp
   if
@@ -288,21 +354,16 @@ setBrigUserManagedBy buid managedBy = do
         throwSpar . SparBrigError . cs $ "set managedBy failed with status " <> show sCode
 
 -- | Set user's UserSSOId.
-setBrigUserUserRef :: (HasCallStack, MonadSparToBrig m) => UserId -> SAML.UserRef -> m ()
-setBrigUserUserRef buid uref = do
+setBrigUserVeid :: (HasCallStack, MonadSparToBrig m) => UserId -> ValidExternalId -> m ()
+setBrigUserVeid buid veid = do
   resp <-
     call $
       method PUT
         . paths ["i", "users", toByteString' buid, "sso-id"]
-        . json (toUserSSOId uref)
-  let sCode = statusCode resp
-  if
-      | sCode < 300 ->
-        pure ()
-      | inRange (400, 499) sCode ->
-        throwSpar . SparBrigErrorWith (responseStatus resp) $ "set UserSSOId failed"
-      | otherwise ->
-        throwSpar . SparBrigError . cs $ "set UserSSOId failed with status " <> show sCode
+        . json (veidToUserSSOId veid)
+  case statusCode resp of
+    200 -> pure ()
+    _ -> rethrow resp
 
 -- | Set user's richInfo. Fails with status <500 if brig fails with <500, and with 500 if
 -- brig fails with >= 500.
@@ -322,30 +383,22 @@ setBrigUserRichInfo buid richInfo = do
       | otherwise ->
         throwSpar . SparBrigError . cs $ "set richInfo failed with status " <> show sCode
 
--- TODO: We should add an internal endpoint for this instead
 getBrigUserRichInfo :: (HasCallStack, MonadSparToBrig m) => UserId -> m RichInfo
-getBrigUserRichInfo buid =
-  RichInfo.RichInfo <$> do
-    resp <-
-      call $
-        method GET
-          . paths ["users", toByteString' buid, "rich-info"]
-          . header "Z-User" (toByteString' buid)
-          . header "Z-Connection" ""
-    case statusCode resp of
-      200 -> parseResponse resp
-      _ -> throwSpar (SparBrigErrorWith (responseStatus resp) "Could not retrieve rich info")
-
--- | At the time of writing this, @HEAD /users/handles/:uid@ does not use the 'UserId' for
--- anything but authorization.
-checkHandleAvailable :: (HasCallStack, MonadSparToBrig m) => Handle -> UserId -> m Bool
-checkHandleAvailable hnd buid = do
+getBrigUserRichInfo buid = do
+  resp <-
+    call $
+      method GET
+        . paths ["/i/users", toByteString' buid, "rich-info"]
+  case statusCode resp of
+    200 -> parseResponse resp
+    _ -> rethrow resp
+
+checkHandleAvailable :: (HasCallStack, MonadSparToBrig m) => Handle -> m Bool
+checkHandleAvailable hnd = do
   resp <-
     call $
       method HEAD
-        . paths ["users", "handles", toByteString' hnd]
-        . header "Z-User" (toByteString' buid)
-        . header "Z-Connection" ""
+        . paths ["/i/users/handles", toByteString' hnd]
   let sCode = statusCode resp
   if
       | sCode == 200 -> -- handle exists
@@ -374,9 +427,7 @@ deleteBrigUser buid = do
 
 -- | Check that a user id exists on brig and has a team id.
 getBrigUserTeam :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe TeamId)
-getBrigUserTeam buid = do
-  usr <- getBrigUser buid
-  pure $ userTeam =<< usr
+getBrigUserTeam = fmap (userTeam =<<) . getBrigUser
 
 -- | Get the team that the user is an owner of.
 --
@@ -387,10 +438,10 @@ getZUsrOwnedTeam ::
   m TeamId
 getZUsrOwnedTeam Nothing = throwSpar SparMissingZUsr
 getZUsrOwnedTeam (Just uid) = do
-  usr <- getBrigUser uid
-  case userTeam =<< usr of
-    Nothing -> throwSpar SparNotInTeam
-    Just teamid -> teamid <$ Galley.assertIsTeamOwner teamid uid
+  getBrigUserTeam uid
+    >>= maybe
+      (throwSpar SparNotInTeam)
+      (\teamid -> teamid <$ Galley.assertIsTeamOwner teamid uid)
 
 -- | Verify user's password (needed for certain powerful operations).
 ensureReAuthorised ::
@@ -439,24 +490,25 @@ ssoLogin buid = do
       | otherwise ->
         throwSpar . SparBrigError . cs $ "sso-login failed with status " <> show sCode
 
--- | This is more of a brig thing, but we need to get the team for the user first, so it goes
--- here.  Perhaps we should merge "Spar.Intra.*" into "Spar.Intra"?
-isEmailValidationEnabledUser :: (HasCallStack, MonadSparToGalley m, MonadSparToBrig m) => UserId -> m Bool
-isEmailValidationEnabledUser uid = do
-  user <- getBrigUser uid
-  case user >>= userTeam of
-    Nothing -> pure False
-    Just tid -> isEmailValidationEnabledTeam tid
+getStatus' :: (HasCallStack, MonadSparToBrig m) => UserId -> m ResponseLBS
+getStatus' uid = call $ method GET . paths ["/i/users", toByteString' uid, "status"]
 
+-- | FUTUREWORK: this is probably unnecessary, and we can get the status info from 'UserAccount'.
 getStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> m AccountStatus
 getStatus uid = do
-  resp <-
-    call $
-      method GET
-        . paths ["/i/users", toByteString' uid, "status"]
+  resp <- getStatus' uid
   case statusCode resp of
-    200 -> (\(AccountStatusResp status) -> status) <$> parseResponse @AccountStatusResp resp
-    _ -> throwSpar (SparBrigErrorWith (responseStatus resp) "Could not retrieve account status")
+    200 -> fromAccountStatusResp <$> parseResponse @AccountStatusResp resp
+    _ -> rethrow resp
+
+-- | FUTUREWORK: this is probably unnecessary, and we can get the status info from 'UserAccount'.
+getStatusMaybe :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe AccountStatus)
+getStatusMaybe uid = do
+  resp <- getStatus' uid
+  case statusCode resp of
+    200 -> Just . fromAccountStatusResp <$> parseResponse @AccountStatusResp resp
+    404 -> pure Nothing
+    _ -> rethrow resp
 
 setStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> AccountStatus -> m ()
 setStatus uid status = do
@@ -487,27 +539,21 @@ giveDefaultHandle :: (HasCallStack, MonadSparToBrig m) => User -> m Handle
 giveDefaultHandle usr = case userHandle usr of
   Just handle -> pure handle
   Nothing -> do
-    let handle :: Handle = Handle . cs . toByteString' . userId $ usr
-    resp :: Response (Maybe LBS) <-
-      call $
-        method PUT
-          . path "/self/handle"
-          . header "Z-User" (toByteString' . userId $ usr)
-          . header "Z-Connection" ""
-          . (json . HandleUpdate . fromHandle $ handle)
-    if statusCode resp == 200
-      then pure handle
-      else rethrow resp
+    let handle = Handle . cs . toByteString' $ uid
+        uid = userId usr
+    setBrigUserHandle uid handle
+    pure handle
 
 -- | If a call to brig fails, we often just want to respond with whatever brig said.
 --
 -- FUTUREWORK: with servant, there will be a way for the type checker to confirm that we
 -- handle all exceptions that brig can legally throw!
-rethrow :: ResponseLBS -> (HasCallStack, MonadSparToBrig m) => m a
-rethrow resp = throwError $ SAML.CustomServant (withDefault mServantErr)
+rethrow :: (HasCallStack, MonadSparToBrig m) => ResponseLBS -> m a
+rethrow resp = throwError err
   where
-    withDefault :: Maybe Servant.ServerError -> Servant.ServerError
-    withDefault = fromMaybe (Servant.ServerError 500 "unexpected brig response" mempty mempty)
-    --
-    mServantErr :: Maybe Servant.ServerError
-    mServantErr = waiToServant <$> responseJsonMaybe resp
+    err :: SparError
+    err =
+      responseJsonMaybe resp
+        & maybe
+          (SAML.CustomError . SparBrigError . cs . show $ (statusCode resp, responseBody resp))
+          (SAML.CustomServant . waiToServant)
diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs
index 998e721f14c..d62e79cd6ab 100644
--- a/services/spar/src/Spar/Intra/Galley.hs
+++ b/services/spar/src/Spar/Intra/Galley.hs
@@ -27,6 +27,7 @@ import Data.Aeson (FromJSON, eitherDecode')
 import Data.ByteString.Conversion
 import Data.Id (TeamId, UserId)
 import Data.String.Conversions
+import Data.Typeable (typeRep)
 import Galley.Types.Teams
 import Imports
 import Network.HTTP.Types (status403)
@@ -36,10 +37,13 @@ import Wire.API.Team.Feature (TeamFeatureStatus (..), TeamFeatureStatusValue (..
 
 ----------------------------------------------------------------------
 
-parseResponse :: (FromJSON a, MonadError SparError m) => Response (Maybe LBS) -> m a
+parseResponse :: forall a m. (FromJSON a, MonadError SparError m, Typeable a) => ResponseLBS -> m a
 parseResponse resp = do
-  bdy <- maybe (throwSpar SparNoBodyInGalleyResponse) pure $ responseBody resp
-  either (throwSpar . SparCouldNotParseGalleyResponse . cs) pure $ eitherDecode' bdy
+  bdy <- maybe (throwSpar SparNoBodyInBrigResponse) pure $ responseBody resp
+  either err pure $ eitherDecode' bdy
+  where
+    err = throwSpar . SparCouldNotParseBrigResponse . (typeinfo <>) . cs
+    typeinfo = cs $ show (typeRep ([] @a)) <> ": "
 
 ----------------------------------------------------------------------
 
diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs
index 642196698d2..0079619f0ae 100644
--- a/services/spar/src/Spar/Scim/Auth.hs
+++ b/services/spar/src/Spar/Scim/Auth.hs
@@ -104,36 +104,33 @@ createScimToken zusr CreateScimToken {..} = do
   unless (tokenNumber < maxTokens) $
     E.throwSpar E.SparProvisioningTokenLimitReached
   idps <- wrapMonadClient $ Data.getIdPConfigsByTeam teamid
+
+  let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar CreateScimTokenResponse
+      caseOneOrNoIdP midpid = do
+        token <- ScimToken . cs . ES.encode <$> liftIO (randBytes 32)
+        tokenid <- randomId
+        now <- liftIO getCurrentTime
+        let info =
+              ScimTokenInfo
+                { stiId = tokenid,
+                  stiTeam = teamid,
+                  stiCreatedAt = now,
+                  stiIdP = midpid,
+                  stiDescr = descr
+                }
+        wrapMonadClient $ Data.insertScimToken token info
+        pure $ CreateScimTokenResponse token info
+
   case idps of
-    [idp] -> do
-      -- TODO: sign tokens. Also, we might want to use zauth, if we can / if
-      -- it makes sense semantically
-      token <- ScimToken . cs . ES.encode <$> liftIO (randBytes 32)
-      tokenid <- randomId
-      now <- liftIO getCurrentTime
-      let idpid = idp ^. SAML.idpId
-          info =
-            ScimTokenInfo
-              { stiId = tokenid,
-                stiTeam = teamid,
-                stiCreatedAt = now,
-                stiIdP = Just idpid,
-                stiDescr = descr
-              }
-      wrapMonadClient $ Data.insertScimToken token info
-      pure $ CreateScimTokenResponse token info
-    -- NB: if the two following cases do not result in errors, 'validateScimUser' needs to
-    -- be changed.  currently, it relies on the fact that there is always an IdP.
-    [] ->
-      E.throwSpar $
-        E.SparProvisioningNoSingleIdP
-          "SCIM tokens can only be created for a team with an IdP, \
-          \but none are found"
+    [idp] -> caseOneOrNoIdP . Just $ idp ^. SAML.idpId
+    [] -> caseOneOrNoIdP Nothing
+    -- NB: if the following case does not result in errors, 'validateScimUser' needs to
+    -- be changed.  currently, it relies on the fact that there is never more than one IdP.
+    -- https://github.com/zinfra/backend-issues/issues/1377
     _ ->
       E.throwSpar $
-        E.SparProvisioningNoSingleIdP
-          "SCIM tokens can only be created for a team with exactly one IdP, \
-          \but more are found"
+        E.SparProvisioningMoreThanOneIdP
+          "SCIM tokens can only be created for a team with at most one IdP"
 
 -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenDelete}
 --
diff --git a/services/spar/src/Spar/Scim/Types.hs b/services/spar/src/Spar/Scim/Types.hs
index eb450b3c57f..0f1e565286d 100644
--- a/services/spar/src/Spar/Scim/Types.hs
+++ b/services/spar/src/Spar/Scim/Types.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -40,9 +41,10 @@
 -- * Request and response types for SCIM-related endpoints.
 module Spar.Scim.Types where
 
+import Brig.Types.Common (Email)
 import Brig.Types.Intra (AccountStatus (Active, Deleted, Ephemeral, Suspended))
 import qualified Brig.Types.User as BT
-import Control.Lens (makeLenses)
+import Control.Lens (Prism', makeLenses, prism')
 import Control.Monad.Except (throwError)
 import qualified Data.Aeson as Aeson
 import qualified Data.CaseInsensitive as CI
@@ -52,6 +54,7 @@ import qualified Data.Map as Map
 import Data.Misc (PlainTextPassword)
 import Imports
 import qualified SAML2.WebSSO as SAML
+import SAML2.WebSSO.Test.Arbitrary ()
 import Servant (DeleteNoContent, Get, Header, JSON, NoContent, Post, QueryParam', ReqBody, Required, Strict, (:<|>), (:>))
 import Servant.API.Generic (ToServantApi, (:-))
 import Spar.API.Util (OmitDocs)
@@ -196,11 +199,8 @@ instance Scim.Patchable ScimUserExtra where
 -- [here](https://tools.ietf.org/html/rfc7644#section-3.3): "Since the server is free to alter
 -- and/or ignore POSTed content, returning the full representation can be useful to the
 -- client, enabling it to correlate the client's and server's views of the new resource."
---
--- FUTUREWORK: make '_vsuUserRef' a 'Maybe' and allow for SCIM users without a SAML SSO
--- identity.
 data ValidScimUser = ValidScimUser
-  { _vsuUserRef :: SAML.UserRef,
+  { _vsuExternalId :: ValidExternalId,
     _vsuHandle :: Handle,
     _vsuName :: BT.Name,
     _vsuRichInfo :: RI.RichInfo,
@@ -208,7 +208,35 @@ data ValidScimUser = ValidScimUser
   }
   deriving (Eq, Show)
 
+data ValidExternalId
+  = EmailAndUref Email SAML.UserRef
+  | UrefOnly SAML.UserRef
+  | EmailOnly Email
+  deriving (Eq, Show, Generic)
+
+-- | Take apart a 'ValidExternalId', using 'SAML.UserRef' if available, otehrwise 'Email'.
+runValidExternalId :: (SAML.UserRef -> a) -> (Email -> a) -> ValidExternalId -> a
+runValidExternalId doUref doEmail = \case
+  EmailAndUref _ uref -> doUref uref
+  UrefOnly uref -> doUref uref
+  EmailOnly email -> doEmail email
+
+veidUref :: Prism' ValidExternalId SAML.UserRef
+veidUref = prism' UrefOnly $
+  \case
+    EmailAndUref _ uref -> Just uref
+    UrefOnly uref -> Just uref
+    EmailOnly _ -> Nothing
+
+veidEmail :: Prism' ValidExternalId Email
+veidEmail = prism' EmailOnly $
+  \case
+    EmailAndUref email _ -> Just email
+    UrefOnly _ -> Nothing
+    EmailOnly email -> Just email
+
 makeLenses ''ValidScimUser
+makeLenses ''ValidExternalId
 
 scimActiveFlagFromAccountStatus :: AccountStatus -> Bool
 scimActiveFlagFromAccountStatus = \case
diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index dfa849eaefd..e602db7f501 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -33,27 +33,28 @@
 --
 -- Provides a 'Scim.Class.User.UserDB' instance.
 module Spar.Scim.User
-  ( -- * Internals (for testing)
-    validateScimUser',
+  ( validateScimUser',
     synthesizeScimUser,
     toScimStoredUser',
     mkUserRef,
+    scimFindUserByEmail,
   )
 where
 
-import Brig.Types.Intra (AccountStatus)
-import Brig.Types.User (ManagedBy (..), Name (..), User (..), ssoIdentity)
+import Brig.Types.Common (parseEmail)
+import Brig.Types.Intra (AccountStatus, UserAccount (accountStatus, accountUser))
+import Brig.Types.User (ManagedBy (..), Name (..), User (..))
 import qualified Brig.Types.User as BT
-import Control.Error ((!?), (??))
-import Control.Exception (assert)
-import Control.Lens ((^.))
+import qualified Control.Applicative as Applicative (empty)
+import Control.Lens (view, (^.), (^?))
 import Control.Monad.Except (MonadError, throwError)
 import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
 import Crypto.Hash (Digest, SHA256, hashlazy)
 import qualified Data.Aeson as Aeson
 import Data.Handle (Handle (Handle), parseHandle)
-import Data.Id (Id (Id), UserId, idToText)
+import Data.Id (Id (Id), TeamId, UserId, idToText)
 import Data.Json.Util (UTCTimeMillis, fromUTCTimeMillis, toUTCTimeMillis)
+import Data.Misc ((<$$>))
 import Data.String.Conversions (cs)
 import qualified Data.Text as Text
 import qualified Data.UUID.V4 as UUID
@@ -65,7 +66,7 @@ import qualified Spar.Data as Data
 import qualified Spar.Intra.Brig as Brig
 import Spar.Scim.Auth ()
 import qualified Spar.Scim.Types as ST
-import Spar.Types (IdP, ScimTokenInfo (..), derivedOpts, derivedOptsScimBaseURI, richInfoLimit, wiTeam)
+import Spar.Types (IdP, ScimTokenInfo (..), derivedOpts, derivedOptsScimBaseURI, richInfoLimit)
 import qualified System.Logger.Class as Log
 import qualified URI.ByteString as URIBS
 import qualified Web.Scim.Class.User as Scim
@@ -91,23 +92,13 @@ instance Scim.UserDB ST.SparTag Spar where
   getUsers _ Nothing = do
     throwError $ Scim.badRequest Scim.TooMany (Just "Please specify a filter when getting users.")
   getUsers ScimTokenInfo {stiTeam, stiIdP} (Just filter') = do
-    idp <- stiIdP ?? Scim.serverError "No IdP configured for the provisioning token"
-    idpConfig <- (wrapMonadClient . Data.getIdPConfig $ idp) !? Scim.serverError "No IdP configured for the provisioning token"
+    mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP
     case filter' of
       Scim.FilterAttrCompare (Scim.AttrPath schema attrName _subAttr) Scim.OpEq (Scim.ValString val)
         | Scim.isUserSchema schema -> do
           x <- runMaybeT $ case attrName of
-            "username" -> do
-              handle <- MaybeT . pure . parseHandle . Text.toLower $ val
-              brigUser <- MaybeT . lift . Brig.getBrigUserByHandle $ handle
-              guard $ userTeam brigUser == Just stiTeam
-              lift $ synthesizeStoredUser brigUser
-            "externalid" -> do
-              uref <- mkUserRef idpConfig (pure val)
-              uid <- MaybeT . lift . wrapMonadClient . Data.getSAMLUser $ uref
-              brigUser <- MaybeT . lift . Brig.getBrigUser $ uid
-              guard $ userTeam brigUser == Just stiTeam
-              lift $ synthesizeStoredUser brigUser
+            "username" -> scimFindUserByHandle mIdpConfig stiTeam val
+            "externalid" -> scimFindUserByEmail mIdpConfig stiTeam val
             _ -> throwError (Scim.badRequest Scim.InvalidFilter (Just "Unsupported attribute"))
           pure $ Scim.fromList (toList x)
         | otherwise -> throwError $ Scim.badRequest Scim.InvalidFilter (Just "Unsupported schema")
@@ -117,11 +108,14 @@ instance Scim.UserDB ST.SparTag Spar where
     ScimTokenInfo ->
     UserId ->
     Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag)
-  getUser ScimTokenInfo {stiTeam} uid = do
+  getUser ScimTokenInfo {stiTeam, stiIdP} uid = do
+    mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP
     let notfound = Scim.notFound "User" (idToText uid)
-    brigUser <- lift (Brig.getBrigUser uid) >>= maybe (throwError notfound) pure
-    unless (userTeam brigUser == Just stiTeam) (throwError notfound)
-    synthesizeStoredUser brigUser
+    brigUser <- lift (Brig.getBrigUserAccount uid) >>= maybe (throwError notfound) pure
+    unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound)
+    case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of
+      Right veid -> synthesizeStoredUser brigUser veid
+      Left _ -> throwError notfound
 
   postUser ::
     ScimTokenInfo ->
@@ -153,15 +147,13 @@ validateScimUser ::
   Scim.User ST.SparTag ->
   m ST.ValidScimUser
 validateScimUser tokinfo user = do
-  idpConfig <- tokenInfoToIdP tokinfo
+  mIdpConfig <- tokenInfoToIdP tokinfo
   richInfoLimit <- lift $ asks (richInfoLimit . sparCtxOpts)
-  validateScimUser' idpConfig richInfoLimit user
+  validateScimUser' mIdpConfig richInfoLimit user
 
-tokenInfoToIdP :: ScimTokenInfo -> Scim.ScimHandler Spar IdP
+tokenInfoToIdP :: ScimTokenInfo -> Scim.ScimHandler Spar (Maybe IdP)
 tokenInfoToIdP ScimTokenInfo {stiIdP} = do
-  iid <- stiIdP ?? Scim.serverError "No IdP configured for the provisioning token"
-  midp <- lift . wrapMonadClient . Data.getIdPConfig $ iid
-  midp ?? Scim.serverError "Unknown IdP configured for the provisioning token"
+  maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP
 
 -- | Validate a handle (@userName@).
 validateHandle :: MonadError Scim.ScimError m => Text -> m Handle
@@ -201,22 +193,27 @@ validateScimUser' ::
   forall m.
   (MonadError Scim.ScimError m) =>
   -- | IdP that the resulting user will be assigned to
-  IdP ->
+  Maybe IdP ->
   -- | Rich info limit
   Int ->
   Scim.User ST.SparTag ->
   m ST.ValidScimUser
-validateScimUser' idp richInfoLimit user = do
-  uref :: SAML.UserRef <- mkUserRef idp (Scim.externalId user)
+validateScimUser' midp richInfoLimit user = do
+  unless (isNothing $ Scim.password user) $
+    throwError $
+      Scim.badRequest
+        Scim.InvalidValue
+        (Just "Setting user passwords is not supported for security reasons.")
+  veid <- mkUserRef midp (Scim.externalId user)
   handl <- validateHandle . Text.toLower . Scim.userName $ user
   -- FUTUREWORK: 'Scim.userName' should be case insensitive; then the toLower here would
   -- be a little less brittle.
   uname <- do
     let err = throwError . Scim.badRequest Scim.InvalidValue . Just . cs
-    either err pure $ Brig.mkUserName (Scim.displayName user) uref
+    either err pure $ Brig.mkUserName (Scim.displayName user) veid
   richInfo <- validateRichInfo (Scim.extra user ^. ST.sueRichInfo)
   let active = Scim.active user
-  pure $ ST.ValidScimUser uref handl uname richInfo (fromMaybe True active)
+  pure $ ST.ValidScimUser veid handl uname richInfo (fromMaybe True active)
   where
     -- Validate rich info (@richInfo@). It must not exceed the rich info limit.
     validateRichInfo :: RI.RichInfo -> m RI.RichInfo
@@ -245,19 +242,27 @@ validateScimUser' idp richInfoLimit user = do
 mkUserRef ::
   forall m.
   (MonadError Scim.ScimError m) =>
-  IdP ->
+  Maybe IdP ->
   Maybe Text ->
-  m SAML.UserRef
-mkUserRef idp extid = case extid of
-  Just subjectTxt -> do
-    let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
-    subject <- validateSubject subjectTxt
-    pure $ SAML.UserRef issuer subject
-  Nothing ->
-    throwError $
-      Scim.badRequest
-        Scim.InvalidValue
-        (Just "externalId is required for SAML users")
+  m ST.ValidExternalId
+mkUserRef _ Nothing = do
+  throwError $
+    Scim.badRequest
+      Scim.InvalidValue
+      (Just "externalId is required for SAML users")
+mkUserRef Nothing (Just extid) = do
+  let err =
+        Scim.badRequest
+          Scim.InvalidValue
+          (Just "externalId must be a valid email address or (if there is a SAML IdP) a valid SAML NameID")
+  maybe (throwError err) (pure . ST.EmailOnly) $ parseEmail extid
+mkUserRef (Just idp) (Just extid) = do
+  let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
+  subject <- validateSubject extid
+  let uref = SAML.UserRef issuer subject
+  pure $ case parseEmail extid of
+    Just email -> ST.EmailAndUref email uref
+    Nothing -> ST.UrefOnly uref
   where
     -- Validate a subject ID (@externalId@).
     validateSubject :: Text -> m SAML.NameID
@@ -281,68 +286,67 @@ mkUserRef idp extid = case extid of
 -- Rationale: If brig user creation fails halfway, we don't have SCIM records that
 -- point to inactive users. This stops people from logging in into inactive users.
 --
--- We only allow SCIM users that authenticate via SAML. (This is by no means necessary,
--- though. It can be relaxed to allow creating users with password authentication if that is a
--- requirement.)
+-- TODO(fisx): weird corner case: what happens when users are created suspended, but are
+-- supposed to validate their email?  should emails still be validated?  will that work on
+-- suspended users?  (i think it won't, but i haven't checked.)  easy solution would be to
+-- disallow creation of suspended users.
+--
+-- FUTUREWORK(fisx): race conditions.  details in source commends marked with @{}@.
+--
+-- FUTUREWORK(arianvp): Get rid of manual lifting. Needs to be SCIM instances for ExceptT
+-- This is the pain and the price you pay for the horribleness called MTL
 createValidScimUser ::
   forall m.
   (m ~ Scim.ScimHandler Spar) =>
   ScimTokenInfo ->
   ST.ValidScimUser ->
   m (Scim.StoredUser ST.SparTag)
-createValidScimUser tokinfo vsu@(ST.ValidScimUser uref handl mbName richInfo active) = do
-  idpConfig <- tokenInfoToIdP tokinfo
-  -- sanity check: do tenant of the URef and the Issuer of the IdP match?  (this is mostly
-  -- here to make sure a refactoring we did in the past is sound: we removed a lookup by
-  -- tenant and had the idp config already in context from an earlier lookup.)
-  () <-
-    let inidp = idpConfig ^. SAML.idpMetadata . SAML.edIssuer
-        inuref = uref ^. SAML.uidTenant
-     in assert (inidp == inuref) $ pure ()
-  -- Generate a UserId will be used both for scim user in spar and for brig.
-  buid <- Id <$> liftIO UUID.nextRandom
+createValidScimUser ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid handl mbName richInfo active) = do
   -- ensure uniqueness constraints of all affected identifiers.
-  -- if we crash now, retry POST will just work
-  assertUserRefUnused uref
-  assertHandleUnused handl buid
-  -- if we crash now, retry POST will just work, or user gets told the handle
-  -- is already in use and stops POSTing
-
-  -- FUTUREWORK(arianvp): Get rid of manual lifting. Needs to be SCIM instances for ExceptT
-  -- This is the pain and the price you pay for the horribleness called MTL
-  storedUser <- lift . toScimStoredUser buid $ synthesizeScimUser vsu
-  let teamid = idpConfig ^. SAML.idpExtraInfo . wiTeam
-  buid' <- lift $ Brig.createBrigUser uref buid teamid mbName ManagedByScim
-  assert (buid == buid') $ pure ()
-  -- If we crash now, we have an active user that cannot login. And can not
-  -- be bound this will be a zombie user that needs to be manually cleaned
-  -- up.  We should consider making setUserHandle part of createUser and
-  -- making it transactional.  If the user redoes the POST A new standalone
-  -- user will be created
-  lift $ Brig.setBrigUserHandle buid handl
-  -- If we crash now,  a POST retry will fail with 409 user already exists.
+  -- {if we crash now, retry POST will just work}
+  assertExternalIdUnused veid
+  assertHandleUnused handl
+  -- {if we crash now, retry POST will just work, or user gets told the handle
+  -- is already in use and stops POSTing}
+
+  buid <- lift $ do
+    -- Generate a UserId will be used both for scim user in spar and for brig.
+    buid <- Id <$> liftIO UUID.nextRandom
+    _ <- Brig.createBrigUser veid buid stiTeam mbName ManagedByScim
+    -- {If we crash now, we have an active user that cannot login. And can not
+    -- be bound this will be a zombie user that needs to be manually cleaned
+    -- up.  We should consider making setUserHandle part of createUser and
+    -- making it transactional.  If the user redoes the POST A new standalone
+    -- user will be created.}
+    Brig.setBrigUserHandle buid handl
+    Brig.setBrigUserRichInfo buid richInfo
+    pure buid
+  -- {If we crash now,  a POST retry will fail with 409 user already exists.
   -- Azure at some point will retry with GET /Users?filter=userName eq handle
-  -- and then issue a PATCH containing the rich info and the externalId
-  lift $ Brig.setBrigUserRichInfo buid richInfo
-  -- If we crash now, same as above, but the PATCH will only contain externalId
-
-  -- FUTUREWORK(arianvp): these two actions we probably want to make transactional
-  lift . wrapMonadClient $ Data.writeScimUserTimes storedUser
-  lift . wrapMonadClient $ Data.insertSAMLUser uref buid
-
-  lift $ validateEmailIfExists buid uref
-
-  -- TODO(fisx): suspension has yet another race condition: if we don't reach the following
-  -- line, the user will be active.
-  -- TODO(fisx): what happens with suspended users that have emails?  should emails still be
-  -- validated?  will that work on suspended users?  (i think it won't, but i haven't
-  -- checked.)
-  lift $
-    Brig.getStatus buid >>= \old -> do
-      let new = ST.scimActiveFlagToAccountStatus old (Just active)
-      when (new /= old) $ Brig.setStatus buid new
+  -- and then issue a PATCH containing the rich info and the externalId.}
+
+  storedUser <- lift . toScimStoredUser buid $ synthesizeScimUser vsu
+
+  -- {(arianvp): these two actions we probably want to make transactional.}
+  lift . wrapMonadClient $ do
+    -- Store scim timestamps, saml credentials, scim externalId locally in spar.
+    Data.writeScimUserTimes storedUser
+    ST.runValidExternalId
+      (`Data.insertSAMLUser` buid)
+      (`Data.insertScimExternalId` buid)
+      veid
+
+  -- If applicable, trigger email validation procedure on brig.
+  lift $ validateEmailIfExists buid veid
+
+  -- {suspension via scim: if we don't reach the following line, the user will be active.}
+  lift $ do
+    old <- Brig.getStatus buid
+    let new = ST.scimActiveFlagToAccountStatus old (Just active)
+    when (new /= old) $ Brig.setStatus buid new
   pure storedUser
 
+-- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes?
 updateValidScimUser ::
   forall m.
   (m ~ Scim.ScimHandler Spar) =>
@@ -350,72 +354,63 @@ updateValidScimUser ::
   UserId ->
   ST.ValidScimUser ->
   m (Scim.StoredUser ST.SparTag)
-updateValidScimUser tokinfo uid newScimUser = do
-  -- TODO: currently the types in @hscim@ are constructed in such a way that
-  -- 'Scim.User.User' doesn't contain an ID, only 'Scim.StoredUser'
-  -- does. @fisx believes that this situation could be improved (see
-  -- <https://github.com/wireapp/wire-server/pull/559#discussion_r247392882>).
-  --
-  -- If 'Scim.User.User' and 'ValidScimUser' did contain the user ID, we wouldn't need
-  -- 'uidText' in this function -- or we could at least check in hscim that the ID in the
-  -- user object matches the ID in the path.
-
-  -- TODO: how do we get this safe w.r.t. race conditions / crashes?
-
-  -- construct old and new user values with metadata.
+updateValidScimUser tokinfo uid newValidScimUser = do
+  -- lookup updatee
   oldScimStoredUser :: Scim.StoredUser ST.SparTag <-
     Scim.getUser tokinfo uid
   oldValidScimUser :: ST.ValidScimUser <-
     validateScimUser tokinfo . Scim.value . Scim.thing $ oldScimStoredUser
-  assertUserRefNotUsedElsewhere (newScimUser ^. ST.vsuUserRef) uid
-  assertHandleNotUsedElsewhere (newScimUser ^. ST.vsuHandle) uid
-  if oldValidScimUser == newScimUser
+
+  -- assertions about new valid scim user that cannot be checked in 'validateScimUser' because
+  -- they differ from the ones in 'createValidScimUser'.
+  assertExternalIdNotUsedElsewhere (newValidScimUser ^. ST.vsuExternalId) uid
+  assertHandleNotUsedElsewhere uid (newValidScimUser ^. ST.vsuHandle)
+
+  if oldValidScimUser == newValidScimUser
     then pure oldScimStoredUser
-    else do
+    else lift $ do
       newScimStoredUser :: Scim.StoredUser ST.SparTag <-
-        lift $ updScimStoredUser (synthesizeScimUser newScimUser) oldScimStoredUser
-      -- update 'SAML.UserRef' on spar (also delete the old 'SAML.UserRef' if it exists and
-      -- is different from the new one)
-      let newuref = newScimUser ^. ST.vsuUserRef
-      olduref <- do
-        let extid :: Maybe Text
-            extid = Scim.externalId . Scim.value . Scim.thing $ oldScimStoredUser
-        idp <- tokenInfoToIdP tokinfo
-        mkUserRef idp extid
-      when (olduref /= newuref) $ do
-        lift . wrapMonadClient $ Data.deleteSAMLUser olduref
-        lift . wrapMonadClient $ Data.insertSAMLUser newuref uid
-      -- update 'SAML.UserRef' on brig
-      lift $ Brig.setBrigUserUserRef uid newuref
-
-      -- TODO: if the user has been suspended or unsuspended in brig since the last scim
-      -- write, we'll find the wrong information here.
-      -- [see also](https://github.com/zinfra/backend-issues/issues/1006)
-      oldScimUser :: ST.ValidScimUser <-
-        validateScimUser tokinfo . Scim.value . Scim.thing $ oldScimStoredUser
-      -- the old scim user from our db is already validated, but this also recovers
-      -- the extra details not stored in the DB that we need here.
-
-      lift $ do
-        when (newScimUser ^. ST.vsuName /= oldScimUser ^. ST.vsuName) $
-          Brig.setBrigUserName uid (newScimUser ^. ST.vsuName)
-        when (oldScimUser ^. ST.vsuHandle /= newScimUser ^. ST.vsuHandle) $
-          Brig.setBrigUserHandle uid $
-            newScimUser ^. ST.vsuHandle
-        when (oldScimUser ^. ST.vsuRichInfo /= newScimUser ^. ST.vsuRichInfo) $
-          Brig.setBrigUserRichInfo uid $
-            newScimUser ^. ST.vsuRichInfo
-
-      lift $
-        Brig.getStatus uid >>= \old -> do
-          let new = ST.scimActiveFlagToAccountStatus old (Just $ newScimUser ^. ST.vsuActive)
+        updScimStoredUser (synthesizeScimUser newValidScimUser) oldScimStoredUser
+
+      case ( oldValidScimUser ^. ST.vsuExternalId,
+             newValidScimUser ^. ST.vsuExternalId
+           ) of
+        (old, new) | old /= new -> updateVsuUref uid old new
+        _ -> pure ()
+
+      when (newValidScimUser ^. ST.vsuName /= oldValidScimUser ^. ST.vsuName) $ do
+        Brig.setBrigUserName uid (newValidScimUser ^. ST.vsuName)
+
+      when (oldValidScimUser ^. ST.vsuHandle /= newValidScimUser ^. ST.vsuHandle) $ do
+        Brig.setBrigUserHandle uid (newValidScimUser ^. ST.vsuHandle)
+
+      when (oldValidScimUser ^. ST.vsuRichInfo /= newValidScimUser ^. ST.vsuRichInfo) $ do
+        Brig.setBrigUserRichInfo uid (newValidScimUser ^. ST.vsuRichInfo)
+
+      Brig.getStatusMaybe uid >>= \case
+        Nothing -> pure ()
+        Just old -> do
+          let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive)
           when (new /= old) $ Brig.setStatus uid new
 
-      -- store new user value to scim_user table (spar). (this must happen last, so in case
-      -- of crash the client can repeat the operation and it won't be considered a noop.)
-      lift . wrapMonadClient $ Data.writeScimUserTimes newScimStoredUser
+      wrapMonadClient $ Data.writeScimUserTimes newScimStoredUser
       pure newScimStoredUser
 
+updateVsuUref ::
+  UserId ->
+  ST.ValidExternalId ->
+  ST.ValidExternalId ->
+  Spar ()
+updateVsuUref uid old new = do
+  when (old ^? ST.veidEmail /= new ^? ST.veidEmail) $ do
+    validateEmailIfExists uid new
+
+  wrapMonadClient $ do
+    old & ST.runValidExternalId Data.deleteSAMLUser Data.deleteScimExternalId
+    new & ST.runValidExternalId (`Data.insertSAMLUser` uid) (`Data.insertScimExternalId` uid)
+
+  Brig.setBrigUserVeid uid new
+
 toScimStoredUser ::
   UserId ->
   Scim.User ST.SparTag ->
@@ -496,20 +491,20 @@ deleteScimUser ScimTokenInfo {stiTeam} uid = do
         -- users from other teams get you a 404.
         throwError $
           Scim.notFound "user" (idToText uid)
-      ssoId <-
-        maybe
-          (logThenServerError $ "no userSSOId for user " <> cs (idToText uid))
-          pure
-          $ BT.userSSOId brigUser
-      uref <- either logThenServerError pure $ Brig.fromUserSSOId ssoId
-      lift . wrapMonadClient $ Data.deleteSAMLUser uref
+      for_ (BT.userSSOId brigUser) $ \ssoId -> do
+        veid <- either logThenServerError pure $ Brig.veidFromUserSSOId ssoId
+        lift . wrapMonadClient $
+          ST.runValidExternalId
+            Data.deleteSAMLUser
+            Data.deleteScimExternalId
+            veid
       lift . wrapMonadClient $ Data.deleteScimUserTimes uid
       lift $ Brig.deleteBrigUser uid
       return ()
   where
     logThenServerError :: String -> Scim.ScimHandler Spar b
     logThenServerError err = do
-      lift $ Log.err (Log.msg err)
+      lift $ Log.err (Log.msg $ "deleteScimUser: " <> err)
       throwError $ Scim.serverError "Server Error"
 
 ----------------------------------------------------------------------------
@@ -539,9 +534,9 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h))
 --
 -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds
 -- to a single `externalId`.
-assertUserRefUnused :: SAML.UserRef -> Scim.ScimHandler Spar ()
-assertUserRefUnused userRef = do
-  mExistingUserId <- lift $ getUser userRef
+assertExternalIdUnused :: ST.ValidExternalId -> Scim.ScimHandler Spar ()
+assertExternalIdUnused veid = do
+  mExistingUserId <- lift $ getUser veid
   unless (isNothing mExistingUserId) $
     throwError Scim.conflict {Scim.detail = Just "externalId is already taken"}
 
@@ -551,69 +546,75 @@ assertUserRefUnused userRef = do
 --
 -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds
 -- to a single `externalId`.
-assertUserRefNotUsedElsewhere :: SAML.UserRef -> UserId -> Scim.ScimHandler Spar ()
-assertUserRefNotUsedElsewhere userRef wireUserId = do
-  mExistingUserId <- lift $ getUser userRef
+assertExternalIdNotUsedElsewhere :: ST.ValidExternalId -> UserId -> Scim.ScimHandler Spar ()
+assertExternalIdNotUsedElsewhere veid wireUserId = do
+  mExistingUserId <- lift $ getUser veid
   unless (mExistingUserId `elem` [Nothing, Just wireUserId]) $ do
     throwError Scim.conflict {Scim.detail = Just "externalId does not match UserId"}
 
-assertHandleUnused :: Handle -> UserId -> Scim.ScimHandler Spar ()
+assertHandleUnused :: Handle -> Scim.ScimHandler Spar ()
 assertHandleUnused = assertHandleUnused' "userName is already taken"
 
-assertHandleUnused' :: Text -> Handle -> UserId -> Scim.ScimHandler Spar ()
-assertHandleUnused' msg hndl uid =
-  lift (Brig.checkHandleAvailable hndl uid) >>= \case
+assertHandleUnused' :: Text -> Handle -> Scim.ScimHandler Spar ()
+assertHandleUnused' msg hndl =
+  lift (Brig.checkHandleAvailable hndl) >>= \case
     True -> pure ()
     False -> throwError Scim.conflict {Scim.detail = Just msg}
 
-assertHandleNotUsedElsewhere :: Handle -> UserId -> Scim.ScimHandler Spar ()
-assertHandleNotUsedElsewhere hndl uid = do
+assertHandleNotUsedElsewhere :: UserId -> Handle -> Scim.ScimHandler Spar ()
+assertHandleNotUsedElsewhere uid hndl = do
   musr <- lift $ Brig.getBrigUser uid
   unless ((userHandle =<< musr) == Just hndl) $
-    assertHandleUnused' "userName does not match UserId" hndl uid
+    assertHandleUnused' "userName does not match UserId" hndl
 
 -- | Helper function that translates a given brig user into a 'Scim.StoredUser', with some
 -- effects like updating the 'ManagedBy' field in brig and storing creation and update time
 -- stamps.
-synthesizeStoredUser :: BT.User -> Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag)
-synthesizeStoredUser usr = do
-  let readState :: Spar (RI.RichInfo, AccountStatus, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI)
+synthesizeStoredUser :: UserAccount -> ST.ValidExternalId -> Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag)
+synthesizeStoredUser usr veid = do
+  let uid = userId (accountUser usr)
+      accStatus = accountStatus usr
+
+  let readState :: Spar (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI)
       readState = do
-        richInfo <- Brig.getBrigUserRichInfo (BT.userId usr)
-        accStatus <- Brig.getStatus (BT.userId usr)
-        accessTimes <- wrapMonadClient (Data.readScimUserTimes (BT.userId usr))
+        richInfo <- Brig.getBrigUserRichInfo uid
+        accessTimes <- wrapMonadClient (Data.readScimUserTimes uid)
         baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts
-        pure (richInfo, accStatus, accessTimes, baseuri)
+        pure (richInfo, accessTimes, baseuri)
 
-  let writeState :: UserId -> Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> Scim.StoredUser ST.SparTag -> Spar ()
-      writeState uid accessTimes managedBy storedUser = do
-        when (isNothing accessTimes) $ do
+  let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar ()
+      writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do
+        when (isNothing oldAccessTimes) $ do
           wrapMonadClient $ Data.writeScimUserTimes storedUser
-        when (managedBy /= ManagedByScim) $ do
+        when (oldManagedBy /= ManagedByScim) $ do
           Brig.setBrigUserManagedBy uid ManagedByScim
+        let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser
+        when (oldRichInfo /= newRichInfo) $ do
+          Brig.setBrigUserRichInfo uid newRichInfo
 
-  (richInfo, accStatus, accessTimes, baseuri) <- lift readState
+  (richInfo, accessTimes, baseuri) <- lift readState
   SAML.Time (toUTCTimeMillis -> now) <- lift SAML.getNow
   let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes
-  handle <- lift $ Brig.giveDefaultHandle usr
-  let uref = either (const Nothing) Just . Brig.fromUserSSOId
+
+  handle <- lift $ Brig.giveDefaultHandle (accountUser usr)
+
   storedUser <-
     synthesizeStoredUser'
-      (userId usr)
-      (userIdentity >=> ssoIdentity >=> uref $ usr)
-      (userDisplayName usr)
+      uid
+      veid
+      (userDisplayName (accountUser usr))
       handle
       richInfo
       accStatus
       createdAt
       lastUpdatedAt
       baseuri
-  lift $ writeState (BT.userId usr) accessTimes (BT.userManagedBy usr) storedUser
+  lift $ writeState accessTimes (userManagedBy (accountUser usr)) richInfo storedUser
   pure storedUser
 
 synthesizeStoredUser' ::
   UserId ->
-  Maybe SAML.UserRef ->
+  ST.ValidExternalId ->
   Name ->
   Handle ->
   RI.RichInfo ->
@@ -622,17 +623,15 @@ synthesizeStoredUser' ::
   UTCTimeMillis ->
   URIBS.URI ->
   MonadError Scim.ScimError m => m (Scim.StoredUser ST.SparTag)
-synthesizeStoredUser' uid ssoid dname handle richInfo accStatus createdAt lastUpdatedAt baseuri = do
-  sso <- do
-    let err = throwError $ Scim.notFound "User" (cs $ show uid) -- See https://github.com/zinfra/backend-issues/issues/1365
-    maybe err pure ssoid
-
+synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpdatedAt baseuri = do
   let scimUser :: Scim.User ST.SparTag
       scimUser =
         synthesizeScimUser
           ST.ValidScimUser
-            { ST._vsuUserRef = sso,
-              ST._vsuHandle = handle, -- 'Maybe' there is one in @usr@, but we want to type checker to make sure this exists.
+            { ST._vsuExternalId = veid,
+              ST._vsuHandle = handle {- 'Maybe' there is one in @usr@, but we want the type
+                                        checker to make sure this exists, so we add it here
+                                        redundantly, without the 'Maybe'. -},
               ST._vsuName = dname,
               ST._vsuRichInfo = richInfo,
               ST._vsuActive = ST.scimActiveFlagFromAccountStatus accStatus
@@ -643,14 +642,39 @@ synthesizeStoredUser' uid ssoid dname handle richInfo accStatus createdAt lastUp
 synthesizeScimUser :: ST.ValidScimUser -> Scim.User ST.SparTag
 synthesizeScimUser info =
   let Handle userName = info ^. ST.vsuHandle
-      toExternalId' :: SAML.UserRef -> Maybe Text
-      toExternalId' = either (const Nothing) Just . Brig.toExternalId . Brig.toUserSSOId
    in (Scim.empty ST.userSchemas userName (ST.ScimUserExtra (info ^. ST.vsuRichInfo)))
-        { Scim.externalId = toExternalId' $ info ^. ST.vsuUserRef,
+        { Scim.externalId = Brig.renderValidExternalId $ info ^. ST.vsuExternalId,
           Scim.displayName = Just $ fromName (info ^. ST.vsuName),
           Scim.active = Just $ info ^. ST.vsuActive
         }
 
+scimFindUserByHandle :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler Spar) (Scim.StoredUser ST.SparTag)
+scimFindUserByHandle mIdpConfig stiTeam hndl = do
+  handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl
+  brigUser <- MaybeT . lift . Brig.getBrigUserByHandle $ handle
+  guard $ userTeam (accountUser brigUser) == Just stiTeam
+  case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of
+    Right veid -> lift $ synthesizeStoredUser brigUser veid
+    Left _ -> Applicative.empty
+
+scimFindUserByEmail :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler Spar) (Scim.StoredUser ST.SparTag)
+scimFindUserByEmail mIdpConfig stiTeam email = do
+  veid <- mkUserRef mIdpConfig (pure email)
+  uid <- MaybeT . lift $ ST.runValidExternalId withUref withEmailOnly veid
+  brigUser <- MaybeT . lift . Brig.getBrigUserAccount $ uid
+  guard $ userTeam (accountUser brigUser) == Just stiTeam
+  lift $ synthesizeStoredUser brigUser veid
+  where
+    withUref :: SAML.UserRef -> Spar (Maybe UserId)
+    withUref = wrapMonadClient . Data.getSAMLUser
+
+    withEmailOnly :: BT.Email -> Spar (Maybe UserId)
+    withEmailOnly eml = maybe inbrig (pure . Just) =<< inspar
+      where
+        inspar, inbrig :: Spar (Maybe UserId)
+        inspar = wrapMonadClient $ Data.lookupScimExternalId eml
+        inbrig = userId . accountUser <$$> Brig.getBrigUserByEmail eml
+
 {- TODO: might be useful later.
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 
diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs
index 76999608a11..66425194635 100644
--- a/services/spar/src/Spar/Types.hs
+++ b/services/spar/src/Spar/Types.hs
@@ -173,7 +173,7 @@ instance FromJSON ScimTokenInfo where
     stiTeam <- o .: "team"
     stiId <- o .: "id"
     stiCreatedAt <- o .: "created_at"
-    stiIdP <- o .: "idp"
+    stiIdP <- o .:? "idp"
     stiDescr <- o .: "description"
     pure ScimTokenInfo {..}
 
diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs
index 30a95b1e4e1..f0c7dc2f0ae 100644
--- a/services/spar/test-integration/Test/Spar/APISpec.hs
+++ b/services/spar/test-integration/Test/Spar/APISpec.hs
@@ -48,6 +48,7 @@ import SAML2.WebSSO.Test.MockResponse
 import SAML2.WebSSO.Test.Util
 import Spar.API.Types
 import qualified Spar.Intra.Brig as Intra
+import Spar.Scim.Types
 import Spar.Types
 import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert)
 import URI.ByteString.QQ (uri)
@@ -394,7 +395,7 @@ specBindingUsers = describe "binding existing users to sso identities" $ do
         getSsoidViaAuthResp aresp = do
           parsed :: AuthnResponse <-
             either error pure . parseFromDocument $ fromSignedAuthnResponse aresp
-          either error (pure . Intra.toUserSSOId) $ getUserRef parsed
+          either error (pure . Intra.veidToUserSSOId . UrefOnly) $ getUserRef parsed
         initialBind :: HasCallStack => UserId -> IdP -> SignPrivCreds -> TestSpar (NameID, SignedAuthnResponse, ResponseLBS)
         initialBind = initialBind' Just
         initialBind' ::
@@ -1062,7 +1063,7 @@ specScimAndSAML = do
     userid' <- getUserIdViaRef' userref
     liftIO $ ('i', userid') `shouldBe` ('i', Just userid)
     userssoid <- getSsoidViaSelf' userid
-    liftIO $ ('r', Intra.fromUserSSOId <$> userssoid) `shouldBe` ('r', Just (Right userref))
+    liftIO $ ('r', preview veidUref <$$> (Intra.veidFromUserSSOId <$> userssoid)) `shouldBe` ('r', Just (Right (Just userref)))
     -- login a user for the first time with the scim-supplied credentials
     authnreq <- negotiateAuthnRequest idp
     spmeta <- getTestSPMetadata
diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs
index d451fd8252d..808e1d3f2e9 100644
--- a/services/spar/test-integration/Test/Spar/DataSpec.hs
+++ b/services/spar/test-integration/Test/Spar/DataSpec.hs
@@ -33,7 +33,8 @@ import Data.UUID.V4 as UUID
 import Imports
 import SAML2.WebSSO as SAML
 import Spar.Data as Data
-import Spar.Intra.Brig (fromUserSSOId)
+import Spar.Intra.Brig (veidFromUserSSOId)
+import Spar.Scim.Types
 import Spar.Types
 import Type.Reflection (typeRep)
 import URI.ByteString.QQ (uri)
@@ -274,12 +275,24 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do
     liftIO $ tokens `shouldBe` []
   -- The users from 'user':
   do
-    let Right uref1 = fromUserSSOId ssoid1
-    mbUser1 <- runSparCass $ Data.getSAMLUser uref1
+    mbUser1 <- case veidFromUserSSOId ssoid1 of
+      Right veid ->
+        runSparCass $
+          runValidExternalId
+            Data.getSAMLUser
+            undefined -- could be @Data.lookupScimExternalId@, but we don't hit that path.
+            veid
+      Left _email -> undefined -- runSparCass . Data.lookupScimExternalId . fromEmail $ _email
     liftIO $ mbUser1 `shouldBe` Nothing
   do
-    let Right uref2 = fromUserSSOId ssoid2
-    mbUser2 <- runSparCass $ Data.getSAMLUser uref2
+    mbUser2 <- case veidFromUserSSOId ssoid2 of
+      Right veid ->
+        runSparCass $
+          runValidExternalId
+            Data.getSAMLUser
+            undefined
+            veid
+      Left _email -> undefined
     liftIO $ mbUser2 `shouldBe` Nothing
   -- The config from 'idp':
   do
diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs
index 215c5570b83..ff729f7b427 100644
--- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs
@@ -20,13 +20,37 @@ module Test.Spar.Intra.BrigSpec
   )
 where
 
+import Brig.Types.Common (fromEmail)
+import Control.Lens ((^.))
+import Data.Id (Id (Id))
+import qualified Data.UUID as UUID
 import Imports hiding (head)
+import qualified Spar.Intra.Brig as Intra
 import Util
+import qualified Web.Scim.Schema.User as Scim.User
 
 spec :: SpecWith TestEnv
 spec = do
   describe "user deletion between brig and spar" $ do
     it "if a user gets deleted on brig, it will be deleted on spar as well." $ do
       pending
-    it "if a user gets deleted on spar, it will be deleted on spar as well." $ do
+    it "if a user gets deleted on spar, it will be deleted on brig as well." $ do
       pendingWith "or deactivated?  we should decide what we want here."
+
+  describe "getBrigUser" $ do
+    it "return Nothing if n/a" $ do
+      musr <- runSpar $ Intra.getBrigUser (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030")
+      liftIO $ musr `shouldSatisfy` isNothing
+
+    it "return Just if /a" $ do
+      let setup = do
+            env <- ask
+            email <- randomEmail
+            scimUser <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email}
+            (_, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+            tok <- registerScimToken tid Nothing
+            scimUserId <$> createUser tok scimUser
+
+      uid <- setup
+      musr <- runSpar $ Intra.getBrigUser uid
+      liftIO $ musr `shouldSatisfy` isJust
diff --git a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs
index f4326721243..9052e34ff84 100644
--- a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs
@@ -31,6 +31,7 @@ import Control.Lens
 import Data.Misc (PlainTextPassword (..))
 import qualified Galley.Types.Teams as Galley
 import Imports
+import qualified SAML2.WebSSO.Test.Util as SAML
 import Spar.Scim
 import Spar.Types (ScimTokenInfo (..))
 import Util
@@ -52,7 +53,7 @@ specCreateToken :: SpecWith TestEnv
 specCreateToken = describe "POST /auth-tokens" $ do
   it "works" $ testCreateToken
   it "respects the token limit" $ testTokenLimit
-  it "requires the team to have an IdP" $ testIdPIsNeeded
+  it "requires the team to have no more than one IdP" $ testNumIdPs
   it "authorizes only team owner" $ testCreateTokenAuthorizesOnlyTeamOwner
   it "requires a password" $ testCreateTokenRequiresPassword
 
@@ -114,25 +115,27 @@ testTokenLimit = do
     (env ^. teSpar)
     !!! checkErr 403 (Just "token-limit-reached")
 
--- | Test that a token can't be created for a team without an IdP.
---
--- (We don't support SCIM without SSO.)
-testIdPIsNeeded :: TestSpar ()
-testIdPIsNeeded = do
+testNumIdPs :: TestSpar ()
+testNumIdPs = do
   env <- ask
-  -- Create a new team and don't associate an IdP with it
-  (userid, _teamid) <-
+  (owner, _) <-
     runHttpT (env ^. teMgr) $
       createUserWithTeam (env ^. teBrig) (env ^. teGalley)
-  -- Creating a token should fail now
-  createToken_
-    userid
-    CreateScimToken
-      { createScimTokenDescr = "testIdPIsNeeded",
-        createScimTokenPassword = Just defPassword
-      }
-    (env ^. teSpar)
-    !!! checkErr 400 (Just "no-single-idp")
+
+  let addSomeIdP :: TestSpar ()
+      addSomeIdP = do
+        spar <- asks (view teSpar)
+        SAML.SampleIdP metadata _ _ _ <- SAML.makeSampleIdPMetadata
+        void $ call $ Util.callIdpCreate spar (Just owner) metadata
+
+  createToken owner (CreateScimToken "eins" (Just defPassword))
+    >>= deleteToken owner . stiId . createScimTokenResponseInfo
+  addSomeIdP
+  createToken owner (CreateScimToken "zwei" (Just defPassword))
+    >>= deleteToken owner . stiId . createScimTokenResponseInfo
+  addSomeIdP
+  createToken_ owner (CreateScimToken "drei" (Just defPassword)) (env ^. teSpar)
+    !!! checkErr 400 (Just "more-than-one-idp")
 
 -- | Test that a token can only be created as a team owner
 testCreateTokenAuthorizesOnlyTeamOwner :: TestSpar ()
diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
index 3ac97e9a351..28ef7e55134 100644
--- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- This file is part of the Wire Server implementation.
@@ -31,10 +32,10 @@ import Bilge.Assert
 import Brig.Types.Intra (AccountStatus (Active, Suspended))
 import Brig.Types.User as Brig
 import Control.Lens
-import Control.Monad.Catch (MonadCatch)
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Maybe
 import Control.Retry (exponentialBackoff, limitRetries, recovering)
 import qualified Data.Aeson as Aeson
-import Data.Aeson.Lens (key, _String)
 import Data.Aeson.QQ (aesonQQ)
 import Data.Aeson.Types (fromJSON, toJSON)
 import Data.ByteString.Conversion
@@ -42,13 +43,13 @@ import Data.Handle (Handle (Handle), fromHandle)
 import Data.Id (TeamId, UserId, randomId)
 import Data.Ix (inRange)
 import Data.String.Conversions (cs)
-import qualified Data.Text.Ascii as Ascii
 import Imports
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
 import qualified SAML2.WebSSO.Types as SAML
 import qualified Spar.Data as Data
 import qualified Spar.Intra.Brig as Intra
 import Spar.Scim
+import qualified Spar.Scim.User as SU
 import Spar.Types (IdP)
 import qualified Spar.Types
 import qualified Text.XML.DSig as SAML
@@ -60,7 +61,6 @@ import qualified Web.Scim.Schema.Meta as Scim
 import qualified Web.Scim.Schema.PatchOp as PatchOp
 import qualified Web.Scim.Schema.User as Scim.User
 import qualified Wire.API.Team.Feature as Feature
-import qualified Wire.API.User.Activation as Activation
 import Wire.API.User.RichInfo
 
 -- | Tests for @\/scim\/v2\/Users@.
@@ -89,7 +89,7 @@ specSuspend = do
         checkPreExistingUser isActive = do
           (_, teamid, idp, (_, privCreds)) <- registerTestIdPWithMeta
           member <- loginSsoUserFirstTime idp privCreds
-          -- NOTE: once SCIM is enabled SSO Auto-provisioning is disabled
+          -- NOTE: once SCIM is enabled, SSO Auto-provisioning is disabled
           tok <- registerScimToken teamid (Just (idp ^. SAML.idpId))
           handle'@(Handle handle) <- nextHandle
           runSpar $ Intra.setBrigUserHandle member handle'
@@ -175,12 +175,22 @@ specSuspend = do
 -- | Tests for @POST /Users@.
 specCreateUser :: SpecWith TestEnv
 specCreateUser = describe "POST /Users" $ do
-  it "creates a user in an existing team" $ testCreateUser
+  it "rejects attempts at setting a password" $ do
+    testCreateUserWithPass
+  context "team has no SAML IdP" $ do
+    it "creates an active user without an email, and triggers email validation" $ do
+      testCreateUserNoIdP
+    it "fails if no email can be extraced from externalId" $ do
+      testCreateUserNoIdPNoEmail
+  context "team has one SAML IdP" $ do
+    it "creates a user in an existing team" $ do
+      testCreateUserWithSamlIdP
   it "adds a Wire scheme to the user record" $ testSchemaIsAdded
   it "requires externalId to be present" $ testExternalIdIsRequired
   it "rejects invalid handle" $ testCreateRejectsInvalidHandle
   it "rejects occupied handle" $ testCreateRejectsTakenHandle
-  it "rejects occupied externalId" $ testCreateRejectsTakenExternalId
+  it "rejects occupied externalId (uref)" $ testCreateRejectsTakenExternalId True
+  it "rejects occupied externalId (email)" $ testCreateRejectsTakenExternalId False
   it "allows an occupied externalId when the IdP is different" $
     testCreateSameExternalIds
   it "provides a correct location in the 'meta' field" $ testLocation
@@ -190,9 +200,75 @@ specCreateUser = describe "POST /Users" $ do
   it "writes all the stuff to all the places" $
     pendingWith "factor this out of the PUT tests we already wrote."
 
--- | Test that a user can be created via SCIM and that it also appears on the Brig side.
-testCreateUser :: TestSpar ()
-testCreateUser = do
+testCreateUserWithPass :: TestSpar ()
+testCreateUserWithPass = do
+  env <- ask
+  tok <- do
+    (_, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+    registerScimToken tid Nothing
+  user <- randomScimUser <&> \u -> u {Scim.User.password = Just "geheim"}
+  createUser_ (Just tok) user (env ^. teSpar) !!! do
+    const 400 === statusCode
+    -- TODO: write a FAQ entry in wire-docs, reference it in the error description.
+    -- TODO: yes, we should just test for error labels consistently, i know...
+    const (Just "Setting user passwords is not supported for security reasons.") =~= responseBody
+
+testCreateUserNoIdP :: TestSpar ()
+testCreateUserNoIdP = do
+  env <- ask
+  email <- randomEmail
+  scimUser <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email}
+  (_, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+  tok <- registerScimToken tid Nothing
+  scimStoredUser <- createUser tok scimUser
+  let userid = scimUserId scimStoredUser
+      handle = Handle . Scim.User.userName . Scim.value . Scim.thing $ scimStoredUser
+  brigUser <-
+    aFewTimes (runSpar $ Intra.getBrigUser userid) isJust
+      >>= maybe (error "could not find user in brig") pure
+  brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser
+  liftIO $ userEmail brigUser `shouldBe` Nothing
+  accStatus <- runSpar $ Intra.getStatusMaybe userid
+  liftIO $ accStatus `shouldBe` Just Active
+  liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim
+
+  let checkGet :: TestSpar ()
+      checkGet = do
+        susr <- getUser tok userid
+        WrappedScimStoredUser susr `userShouldMatch` WrappedScimStoredUser scimStoredUser
+        let usr = Scim.value . Scim.thing $ susr
+        liftIO $ Scim.User.active usr `shouldBe` Just True
+        liftIO $ Scim.User.externalId usr `shouldBe` Just (fromEmail email)
+
+      checkSearch :: TestSpar ()
+      checkSearch = do
+        listUsers tok (Just (filterBy "userName" $ fromHandle handle)) >>= \users ->
+          liftIO $ users `shouldBe` [scimStoredUser]
+        listUsers tok (Just (filterBy "externalId" $ fromEmail email)) >>= \users ->
+          liftIO $ users `shouldBe` [scimStoredUser]
+
+  checkGet
+  checkSearch
+  call $ do
+    activateEmail (env ^. teBrig) email
+    checkEmail (env ^. teBrig) userid email
+  checkGet
+  checkSearch
+
+testCreateUserNoIdPNoEmail :: TestSpar ()
+testCreateUserNoIdPNoEmail = do
+  env <- ask
+  tok <- do
+    (_, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+    registerScimToken tid Nothing
+  user <- randomScimUser <&> \u -> u {Scim.User.externalId = Just "notanemail"}
+  createUser_ (Just tok) user (env ^. teSpar) !!! do
+    const 400 === statusCode
+    -- TODO(fisx): test for error labels consistently...
+    const (Just "externalId must be a valid email address or (if there is a SAML IdP) a valid SAML NameID") =~= responseBody
+
+testCreateUserWithSamlIdP :: TestSpar ()
+testCreateUserWithSamlIdP = do
   env <- ask
   -- Create a user via SCIM
   user <- randomScimUser
@@ -209,6 +285,9 @@ testCreateUser = do
           . expect2xx
       )
   brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser
+  accStatus <- aFewTimes (runSpar $ Intra.getStatus (userId brigUser)) (== Active)
+  liftIO $ accStatus `shouldBe` Active
+  liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim
 
 -- | Test that Wire-specific schemas are added to the SCIM user record, even if the schemas
 -- were not present in the original record during creation.
@@ -263,12 +342,22 @@ testCreateRejectsTakenHandle = do
     !!! const 409 === statusCode
 
 -- | Test that user creation fails if the @externalId@ is already in use for given IdP.
-testCreateRejectsTakenExternalId :: TestSpar ()
-testCreateRejectsTakenExternalId = do
+testCreateRejectsTakenExternalId :: Bool -> TestSpar ()
+testCreateRejectsTakenExternalId withidp = do
   env <- ask
-  (tok, _) <- registerIdPAndScimToken
+
+  tok <-
+    if withidp
+      then do
+        (tok, _) <- registerIdPAndScimToken
+        pure tok
+      else do
+        (_owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+        registerScimToken tid Nothing
+
   -- Create and add a first user: success!
-  user1 <- randomScimUser
+  email <- randomEmail
+  user1 <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email}
   _ <- createUser tok user1
   -- Try to create different user with same @externalId@ in same team, and fail.
   user2 <- randomScimUser
@@ -473,8 +562,12 @@ testScimCreateVsUserRef = do
 specListUsers :: SpecWith TestEnv
 specListUsers = describe "GET /Users" $ do
   it "lists all SCIM users in a team" $ testListProvisionedUsers
-  it "finds a SCIM-provisioned user by userName or externalId" $ testFindProvisionedUser
-  it "finds a non-SCIM-provisioned user by userName or externalId" $ testFindNonProvisionedUser
+  context "1 SAML IdP" $ do
+    it "finds a SCIM-provisioned user by userName or externalId" $ testFindProvisionedUser
+    it "finds a non-SCIM-provisioned user by userName or externalId" $ testFindNonProvisionedUser
+  context "0 SAML IdP" $ do
+    it "finds a SCIM-provisioned user by userName or externalId" $ testFindProvisionedUserNoIdP
+    it "finds a non-SCIM-provisioned user by userName or externalId" $ testFindNonProvisionedUserNoIdP
   it "doesn't list deleted users" $ testListNoDeletedUsers
   it "doesnt't find deleted users by userName or externalId" $ testFindNoDeletedUsers
   it "doesn't list users from other teams" $ testUserListFailsWithNotFoundIfOutsideTeam
@@ -502,40 +595,66 @@ testFindProvisionedUser = do
   liftIO $ users' `shouldBe` [storedUser]
 
 -- When explicitly filtering, we should be able to find non-SCIM-provisioned users
-testFindNonProvisionedUser :: TestSpar ()
+testFindNonProvisionedUser :: HasCallStack => TestSpar ()
 testFindNonProvisionedUser = do
   (_, teamid, idp, (_, privCreds)) <- registerTestIdPWithMeta
   member <- loginSsoUserFirstTime idp privCreds
   -- NOTE: once SCIM is enabled SSO Auto-provisioning is disabled
   tok <- registerScimToken teamid (Just (idp ^. SAML.idpId))
-  handle'@(Handle handle) <- nextHandle
-  runSpar $ Intra.setBrigUserHandle member handle'
+  handle <- nextHandle
+  runSpar $ Intra.setBrigUserHandle member handle
   Just brigUser <- runSpar $ Intra.getBrigUser member
   liftIO $ userManagedBy brigUser `shouldBe` ManagedByWire
-  users <- listUsers tok (Just (filterBy "userName" handle))
+  users <- listUsers tok (Just (filterBy "userName" (fromHandle handle)))
   liftIO $ (scimUserId <$> users) `shouldContain` [member]
   Just brigUser' <- runSpar $ Intra.getBrigUser member
   liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim
-  -- a scim record should've been inserted too
   _ <- getUser tok member
-  let Just ssoIdentity' = userIdentity >=> ssoIdentity $ brigUser'
-  let Right externalId = Intra.toExternalId ssoIdentity'
+  let externalId = either error id $ Intra.userToExternalId brigUser'
   users' <- listUsers tok (Just (filterBy "externalId" externalId))
   liftIO $ (scimUserId <$> users') `shouldContain` [member]
 
+testFindProvisionedUserNoIdP :: TestSpar ()
+testFindProvisionedUserNoIdP = do
+  -- covered in 'testCreateUserNoIdP' (as of Mon 31 Aug 2020 08:37:05 PM CEST)
+  pure ()
+
+testFindNonProvisionedUserNoIdP :: TestSpar ()
+testFindNonProvisionedUserNoIdP = do
+  env <- ask
+  (owner, teamid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+  tok <- registerScimToken teamid Nothing
+
+  uid <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner teamid)
+  handle <- nextHandle
+  runSpar $ Intra.setBrigUserHandle uid handle
+  Just brigUser <- runSpar $ Intra.getBrigUser uid
+  let Just email = userEmail brigUser
+
+  do
+    -- inspect brig user
+    liftIO $ userManagedBy brigUser `shouldBe` ManagedByWire
+    liftIO $ userEmail brigUser `shouldSatisfy` isJust
+
+  byHandle <- listUsers tok (Just (filterBy "userName" (fromHandle handle)))
+  byExternalId <- listUsers tok (Just (filterBy "externalId" (fromEmail email)))
+
+  for_ [byHandle, byExternalId] $ \users -> do
+    liftIO $ (scimUserId <$> users) `shouldBe` [uid]
+    Just brigUser' <- runSpar $ Intra.getBrigUser uid
+    liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim
+    liftIO $ brigUser' `shouldBe` brigUser {userManagedBy = ManagedByScim}
+
 -- | Test that deleted users are not listed.
 testListNoDeletedUsers :: TestSpar ()
 testListNoDeletedUsers = do
-  env <- ask
   -- Create a user via SCIM
   user <- randomScimUser
   (tok, _) <- registerIdPAndScimToken
   storedUser <- createUser tok user
   let userid = scimUserId storedUser
   -- Delete the user
-  -- TODO(fisx): use 'Util.Scim.deleteUser' instead of 'Util.Core.deleteUserOnBrig' (in fact,
-  -- we should probably do both)
-  call $ deleteUserOnBrig (env ^. teBrig) userid
+  _ <- deleteUser tok userid
   -- Get all users
   users <- listUsers tok (Just (filterForStoredUser storedUser))
   -- Check that the user is absent
@@ -583,8 +702,12 @@ testUserFindFailsWithNotFoundIfOutsideTeam = do
 -- | Tests for @GET \/Users\/:id@.
 specGetUser :: SpecWith TestEnv
 specGetUser = describe "GET /Users/:id" $ do
-  it "finds a SCIM-provisioned user" testGetUser
-  it "does not find a user invited old-school via team-settings" testGetNonScimInviteUser
+  context "1 SAML IdP" $ do
+    it "finds a SCIM-provisioned user" testGetUser
+    it "finds a user invited old-school via team-settings and gives her saml credentials" testGetNonScimInviteUser
+  context "0 SAML IdP" $ do
+    it "finds a SCIM-provisioned user" testGetUserNoIdP
+    it "finds a user invited old-school via team-settings" testGetNonScimInviteUserNoIdP
   it "finds a user auto-provisioned via SAML and puts it under SCIM management" testGetNonScimSAMLUser
   it "finds a user that has no handle, and gives it a default handle before responding with it" testGetUserWithNoHandle
   it "doesn't find a deleted user" testGetNoDeletedUsers
@@ -623,11 +746,31 @@ testGetNonScimSAMLUser = do
 
 testGetNonScimInviteUser :: TestSpar ()
 testGetNonScimInviteUser = do
-  brig <- asks (^. teBrig)
+  env <- ask
   (tok, (owner, tid, _)) <- registerIdPAndScimToken
 
-  uidNoSso <- userId <$> call (inviteAndRegisterUser brig owner tid)
-  getUser_ (Just tok) uidNoSso brig !!! const 404 === statusCode
+  uidNoSso <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner tid)
+
+  shouldBeManagedBy uidNoSso ManagedByWire
+  getUser_ (Just tok) uidNoSso (env ^. teSpar) !!! const 200 === statusCode
+  shouldBeManagedBy uidNoSso ManagedByScim
+
+testGetUserNoIdP :: TestSpar ()
+testGetUserNoIdP = do
+  -- covered in 'testCreateUserNoIdP' (as of Mon 31 Aug 2020 08:41:27 PM CEST)
+  pure ()
+
+testGetNonScimInviteUserNoIdP :: TestSpar ()
+testGetNonScimInviteUserNoIdP = do
+  env <- ask
+  (owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+  tok <- registerScimToken tid Nothing
+
+  uidNoSso <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner tid)
+
+  shouldBeManagedBy uidNoSso ManagedByWire
+  getUser_ (Just tok) uidNoSso (env ^. teSpar) !!! const 200 === statusCode
+  shouldBeManagedBy uidNoSso ManagedByScim
 
 testGetUserWithNoHandle :: TestSpar ()
 testGetUserWithNoHandle = do
@@ -698,11 +841,10 @@ specUpdateUser = describe "PUT /Users/:id" $ do
   it "requires a user ID" $ testUpdateRequiresUserId
   it "updates user attributes in scim_user" $ testScimSideIsUpdated
   it "works fine when neither name nor handle are changed" $ testUpdateSameHandle
-  it "updates the 'SAML.UserRef' index in Spar" $ testUpdateUserRefIndex
+  it "updates the 'SAML.UserRef' index in Spar" $ testUpdateExternalId True
+  it "updates the 'Email' index in Brig" $ testUpdateExternalId False
   it "updates the matching Brig user" $ testBrigSideIsUpdated
-  it
-    "cannot update user to match another user's externalId"
-    testUpdateToExistingExternalIdFails
+  it "cannot update user to match another user's externalId" $ testUpdateToExistingExternalIdFails
   it "cannot remove display name" $ testCannotRemoveDisplayName
   context "user is from different team" $ do
     it "fails to update user with 404" testUserUpdateFailsWithNotFoundIfOutsideTeam
@@ -735,18 +877,17 @@ testCannotRemoveDisplayName = do
   --  However; I don't think this is currently blocking us on Azure.
   --  We should however fix this behaviour in the future TODO(arianvp)
   pendingWith
+    {-
+    env <- ask
+    user <- randomScimUser
+    (tok, _) <- registerIdPAndScimToken
+    storedUser <- createUser tok user
+    let userid = scimUserId storedUser
+    let user' = user { Scim.User.displayName = Nothing }
+    updateUser_ (Just tok) (Just userid) user'  (env ^. teSpar) !!! const 409 === statusCode
+    -}
     "We default to the externalId when displayName is removed. lets keep that for now"
 
-{-
-env <- ask
-user <- randomScimUser
-(tok, _) <- registerIdPAndScimToken
-storedUser <- createUser tok user
-let userid = scimUserId storedUser
-let user' = user { Scim.User.displayName = Nothing }
-updateUser_ (Just tok) (Just userid) user'  (env ^. teSpar) !!! const 409 === statusCode
--}
-
 -- | Test that when you're not changing any fields, then that update should not
 -- change anything (Including version field)
 testSameUpdateNoChange :: TestSpar ()
@@ -865,36 +1006,69 @@ testUpdateSameHandle = do
     Scim.created meta `shouldBe` Scim.created meta'
     Scim.location meta `shouldBe` Scim.location meta'
 
--- | Test that when a user's 'UserRef' is updated, the relevant index is also updated and Spar
--- can find the user by the 'UserRef'.
-testUpdateUserRefIndex :: TestSpar ()
-testUpdateUserRefIndex = do
-  (tok, (_, _, idp)) <- registerIdPAndScimToken
-  let checkUpdateUserRef :: Bool -> TestSpar ()
-      checkUpdateUserRef changeUserRef = do
+-- | Test that when a user's external id is updated, the relevant indices are also updated in
+-- brig and spar, and spar can find the user by that external id.
+testUpdateExternalId :: Bool -> TestSpar ()
+testUpdateExternalId withidp = do
+  env <- ask
+  (tok, midp, tid) <-
+    if withidp
+      then do
+        (tok, (_, tid, idp)) <- registerIdPAndScimToken
+        pure (tok, Just idp, tid)
+      else do
+        (_owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
+        (,Nothing,tid) <$> registerScimToken tid Nothing
+
+  let checkUpdate :: HasCallStack => Bool -> TestSpar ()
+      checkUpdate hasChanged {- is externalId updated with a different value, or with itself? -} = do
         -- Create a user via SCIM
-        user <- randomScimUser
+        email <- randomEmail
+        user <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email}
         storedUser <- createUser tok user
         let userid = scimUserId storedUser
-        uref <- either (error . show) pure $ mkUserRef idp (Scim.User.externalId user)
-        -- Overwrite the user with another randomly-generated user
-        user' <-
+        veid :: ValidExternalId <-
+          either (error . show) pure $ mkUserRef midp (Scim.User.externalId user)
+        -- Overwrite the user with another randomly-generated user (only controlling externalId)
+        user' <- do
+          otherEmail <- randomEmail
           let upd u =
-                if changeUserRef
-                  then u
-                  else u {Scim.User.externalId = Scim.User.externalId user}
-           in randomScimUser <&> upd
+                u
+                  { Scim.User.externalId =
+                      if hasChanged
+                        then Just $ fromEmail otherEmail
+                        else Scim.User.externalId user
+                  }
+          randomScimUser <&> upd
+        let veid' = either (error . show) id $ mkUserRef midp (Scim.User.externalId user')
+
         _ <- updateUser tok userid user'
-        uref' <- either (error . show) pure $ mkUserRef idp (Scim.User.externalId user')
-        muserid <- runSparCass $ Data.getSAMLUser uref
-        muserid' <- runSparCass $ Data.getSAMLUser uref'
+
+        muserid <- lookupByValidExternalId veid
+        muserid' <- lookupByValidExternalId veid'
         liftIO $ do
-          (changeUserRef, muserid)
-            `shouldBe` (changeUserRef, if changeUserRef then Nothing else Just userid)
-          (changeUserRef, muserid')
-            `shouldBe` (changeUserRef, Just userid)
-  checkUpdateUserRef True
-  checkUpdateUserRef False
+          if hasChanged
+            then do
+              (hasChanged, muserid) `shouldBe` (hasChanged, Nothing)
+              (hasChanged, muserid') `shouldBe` (hasChanged, Just userid)
+            else do
+              (hasChanged, veid') `shouldBe` (hasChanged, veid)
+              (hasChanged, muserid') `shouldBe` (hasChanged, Just userid)
+
+      lookupByValidExternalId :: ValidExternalId -> TestSpar (Maybe UserId)
+      lookupByValidExternalId =
+        runValidExternalId
+          (runSparCass . Data.getSAMLUser)
+          ( \email -> do
+              let action = SU.scimFindUserByEmail midp tid $ fromEmail email
+              result <- runSpar . runExceptT . runMaybeT $ action
+              case result of
+                Right muser -> pure $ Scim.id . Scim.thing <$> muser
+                Left err -> error $ show err
+          )
+
+  checkUpdate True
+  checkUpdate False
 
 -- | Test that when the user is updated via SCIM, the data in Brig is also updated.
 testBrigSideIsUpdated :: TestSpar ()
@@ -907,7 +1081,7 @@ testBrigSideIsUpdated = do
   _ <- updateUser tok userid user'
   validScimUser <-
     either (error . show) pure $
-      validateScimUser' idp 999999 user'
+      validateScimUser' (Just idp) 999999 user'
   brigUser <- maybe (error "no brig user") pure =<< runSpar (Intra.getBrigUser userid)
   brigUser `userShouldMatch` validScimUser
 
@@ -1091,7 +1265,10 @@ specDeleteUser = do
       let uid :: UserId = scimUserId storedUser
       uref :: SAML.UserRef <- do
         usr <- runSpar $ Intra.getBrigUser uid
-        maybe (error "no UserRef from brig") pure $ urefFromBrig =<< usr
+        let err = error . ("brig user without UserRef: " <>) . show
+        case (`Intra.veidFromBrigUser` Nothing) <$> usr of
+          bad@(Just (Right veid)) -> runValidExternalId pure (const $ err bad) veid
+          bad -> err bad
       spar <- view teSpar
       deleteUser_ (Just tok) (Just uid) spar
         !!! const 204 === statusCode
@@ -1190,6 +1367,7 @@ specEmailValidation = do
               p = ["/i/teams", toByteString' tid, "features", "validate-saml-emails"]
           call req !!! const 204 === statusCode
 
+        -- (This may be the same as 'Util.Email.checkEmail'.)
         assertEmail :: HasCallStack => UserId -> Maybe Email -> TestSpar ()
         assertEmail uid expectedEmail = do
           brig <- asks (^. teBrig)
@@ -1207,55 +1385,19 @@ specEmailValidation = do
           when enabled $ enableSamlEmailValidation teamid
           (user, email) <- randomScimUserWithEmail
           scimStoredUser <- createUser tok user
-          let Right uref = mkUserRef idp . Scim.User.externalId . Scim.value . Scim.thing $ scimStoredUser
-          uid <- getUserIdViaRef uref
+          uref :: SAML.UserRef <-
+            either (error . show) (pure . (^?! veidUref)) $
+              mkUserRef (Just idp) (Scim.User.externalId . Scim.value . Scim.thing $ scimStoredUser)
+          uid :: UserId <-
+            getUserIdViaRef uref
           brig <- asks (^. teBrig)
-          call $ activateEmail brig email
+          -- we intentionally activate the email even if it's not set up to work, to make sure
+          -- it doesn't if the feature is disabled.
+          if enabled
+            then call $ activateEmail brig email
+            else call $ failActivatingEmail brig email
           pure (uid, email)
 
-        -- copied from brig integration tests.
-        activateEmail ::
-          HasCallStack =>
-          BrigReq ->
-          Email ->
-          (MonadIO m, MonadCatch m, MonadHttp m) => m ()
-        activateEmail brig email = do
-          act <- getActivationCode brig (Left email)
-          case act of
-            Nothing -> pure () -- missing activation key/code; this happens if the feature is
-            -- disabled (second test case below)
-            Just kc ->
-              activate brig kc !!! do
-                const 200 === statusCode
-                const (Just False) === fmap Activation.activatedFirst . responseJsonMaybe
-
-        -- copied from brig integration tests.
-        getActivationCode ::
-          HasCallStack =>
-          BrigReq ->
-          Either Email Phone ->
-          (MonadIO m, MonadCatch m, MonadHttp m) => m (Maybe (Activation.ActivationKey, Activation.ActivationCode))
-        getActivationCode brig ep = do
-          let qry = either (queryItem "email" . toByteString') (queryItem "phone" . toByteString') ep
-          r <- get $ brig . path "/i/users/activation-code" . qry
-          let lbs = fromMaybe "" $ responseBody r
-          let akey = Activation.ActivationKey . Ascii.unsafeFromText <$> (lbs ^? key "key" . _String)
-          let acode = Activation.ActivationCode . Ascii.unsafeFromText <$> (lbs ^? key "code" . _String)
-          return $ (,) <$> akey <*> acode
-
-        -- copied from brig integration tests.
-        activate ::
-          HasCallStack =>
-          BrigReq ->
-          (Activation.ActivationKey, Activation.ActivationCode) ->
-          (MonadIO m, MonadCatch m, MonadHttp m) => m ResponseLBS
-        activate brig (k, c) =
-          get $
-            brig
-              . path "activate"
-              . queryItem "key" (toByteString' k)
-              . queryItem "code" (toByteString' c)
-
     context "enabled in team" . it "gives user email" $ do
       (uid, email) <- setup True
       eventually $ assertEmail uid (Just email)
diff --git a/services/spar/test-integration/Util.hs b/services/spar/test-integration/Util.hs
index c9846b9de8d..499edd743ad 100644
--- a/services/spar/test-integration/Util.hs
+++ b/services/spar/test-integration/Util.hs
@@ -21,5 +21,6 @@ module Util
 where
 
 import Util.Core as U
+import Util.Email as U
 import Util.Scim as U
 import Util.Types as U
diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs
index e3669d33953..2f49c730e60 100644
--- a/services/spar/test-integration/Util/Core.hs
+++ b/services/spar/test-integration/Util/Core.hs
@@ -47,6 +47,7 @@ module Util.Core
     endpointToURL,
 
     -- * Other
+    randomEmail,
     defPassword,
     getUserBrig,
     createUserWithTeam,
@@ -173,6 +174,7 @@ import qualified Spar.Data as Data
 import qualified Spar.Intra.Brig as Intra
 import qualified Spar.Options
 import Spar.Run
+import Spar.Scim.Types (runValidExternalId)
 import Spar.Types
 import qualified System.Logger.Extended as Log
 import System.Random (randomRIO)
@@ -741,7 +743,7 @@ registerTestIdPWithMeta ::
   (HasCallStack, MonadRandom m, MonadIO m, MonadReader TestEnv m) =>
   m (UserId, TeamId, IdP, (IdPMetadataInfo, SAML.SignPrivCreds))
 registerTestIdPWithMeta = do
-  (SampleIdP idpmeta privkey _ _) <- makeSampleIdPMetadata
+  SampleIdP idpmeta privkey _ _ <- makeSampleIdPMetadata
   env <- ask
   (uid, tid, idp) <- registerTestIdPFrom idpmeta (env ^. teMgr) (env ^. teBrig) (env ^. teGalley) (env ^. teSpar)
   pure (uid, tid, idp, (IdPMetadataValue (cs $ SAML.encode idpmeta) idpmeta, privkey))
@@ -1103,8 +1105,12 @@ callDeleteDefaultSsoCode sparreq_ = do
 -- | Look up 'UserId' under 'UserSSOId' on spar's cassandra directly.
 ssoToUidSpar :: (HasCallStack, MonadIO m, MonadReader TestEnv m) => Brig.UserSSOId -> m (Maybe UserId)
 ssoToUidSpar ssoid = do
-  ssoref <- either (error . ("could not parse UserRef: " <>)) pure $ Intra.fromUserSSOId ssoid
-  runSparCass @Client $ Data.getSAMLUser ssoref
+  veid <- either (error . ("could not parse brig sso_id: " <>)) pure $ Intra.veidFromUserSSOId ssoid
+  runSparCass @Client $
+    runValidExternalId
+      Data.getSAMLUser
+      Data.lookupScimExternalId
+      veid
 
 runSparCass ::
   (HasCallStack, m ~ Client, MonadIO m', MonadReader TestEnv m') =>
diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs
new file mode 100644
index 00000000000..825dd25c5c4
--- /dev/null
+++ b/services/spar/test-integration/Util/Email.hs
@@ -0,0 +1,75 @@
+-- | Cloned from "/services/brig/test/integration/{Uril.hs,Util/Email.hs}"
+module Util.Email where
+
+import Bilge hiding (accept, timeout)
+import Bilge.Assert
+import Brig.Types
+import Control.Lens ((^?))
+import Control.Monad.Catch (MonadCatch)
+import Data.Aeson.Lens
+import Data.ByteString.Conversion
+import Data.Id hiding (client)
+import qualified Data.Text.Ascii as Ascii
+import Imports
+import Test.Tasty.HUnit
+import Util.Core
+import Util.Types
+
+activateEmail ::
+  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
+  BrigReq ->
+  Email ->
+  MonadHttp m => m ()
+activateEmail brig email = do
+  act <- getActivationCode brig (Left email)
+  case act of
+    Nothing -> liftIO $ assertFailure "missing activation key/code"
+    Just kc ->
+      activate brig kc !!! do
+        const 200 === statusCode
+        const (Just False) === fmap activatedFirst . responseJsonMaybe
+
+failActivatingEmail ::
+  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
+  BrigReq ->
+  Email ->
+  MonadHttp m => m ()
+failActivatingEmail brig email = do
+  act <- getActivationCode brig (Left email)
+  liftIO $ assertEqual "there should be no pending activation" act Nothing
+
+checkEmail ::
+  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
+  BrigReq ->
+  UserId ->
+  Email ->
+  m ()
+checkEmail brig uid expectedEmail =
+  get (brig . path "/self" . zUser uid) !!! do
+    const 200 === statusCode
+    const (Just expectedEmail) === (userEmail <=< responseJsonMaybe)
+
+activate ::
+  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
+  BrigReq ->
+  ActivationPair ->
+  m ResponseLBS
+activate brig (k, c) =
+  get $
+    brig
+      . path "activate"
+      . queryItem "key" (toByteString' k)
+      . queryItem "code" (toByteString' c)
+
+getActivationCode ::
+  (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) =>
+  BrigReq ->
+  Either Email Phone ->
+  m (Maybe (ActivationKey, ActivationCode))
+getActivationCode brig ep = do
+  let qry = either (queryItem "email" . toByteString') (queryItem "phone" . toByteString') ep
+  r <- get $ brig . path "/i/users/activation-code" . qry
+  let lbs = fromMaybe "" $ responseBody r
+  let akey = ActivationKey . Ascii.unsafeFromText <$> (lbs ^? key "key" . _String)
+  let acode = ActivationCode . Ascii.unsafeFromText <$> (lbs ^? key "code" . _String)
+  return $ (,) <$> akey <*> acode
diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs
index da87c4243c2..5a28a8df5f1 100644
--- a/services/spar/test-integration/Util/Scim.hs
+++ b/services/spar/test-integration/Util/Scim.hs
@@ -25,7 +25,6 @@ import Brig.Types.User
 import Cassandra
 import Control.Lens
 import Control.Monad.Random
-import qualified Data.Aeson as Aeson
 import Data.ByteString.Conversion
 import Data.Handle (Handle (Handle))
 import Data.Id
@@ -242,7 +241,7 @@ deleteUser tok userid = do
       (Just tok)
       (Just userid)
       (env ^. teSpar)
-      <!! const 200 === statusCode -- status code maybe some other 2xx?
+      <!! const 204 === statusCode
   pure (responseJsonUnsafe r)
 
 -- | List all users.
@@ -352,7 +351,7 @@ createUser_ auth user spar_ = do
         . paths ["scim", "v2", "Users"]
         . scimAuth auth
         . contentScim
-        . body (RequestBodyLBS . Aeson.encode $ user)
+        . json user
         . acceptScim
     )
 
@@ -374,7 +373,7 @@ updateUser_ auth muid user spar_ = do
         . paths (["scim", "v2", "Users"] <> maybeToList (toByteString' <$> muid))
         . scimAuth auth
         . contentScim
-        . body (RequestBodyLBS . Aeson.encode $ user)
+        . json user
         . acceptScim
     )
 
@@ -386,7 +385,7 @@ patchUser_ auth muid patchop spar_ =
         . paths (["scim", "v2", "Users"] <> maybeToList (toByteString' <$> muid))
         . scimAuth auth
         . contentScim
-        . body (RequestBodyLBS . Aeson.encode $ patchop)
+        . json patchop
         . acceptScim
     )
 
@@ -463,7 +462,7 @@ createToken_ userid payload spar_ = do
         . paths ["scim", "auth-tokens"]
         . zUser userid
         . contentJson
-        . body (RequestBodyLBS . Aeson.encode $ payload)
+        . json payload
         . acceptJson
     )
 
@@ -540,12 +539,7 @@ class IsUser u where
   maybeName :: Maybe (u -> Maybe Name)
   maybeTenant :: Maybe (u -> Maybe SAML.Issuer)
   maybeSubject :: Maybe (u -> Maybe SAML.NameID)
-
-  -- | Some types (e.g. 'Scim.User.User') have a subject ID as a raw string, i.e. not in a
-  -- structured form. Having 'maybeSubjectRaw' available allows us to compare things like
-  -- SCIM 'Scim.User.User' and a Brig 'User', even though they store subject IDs in a
-  -- different way.
-  maybeSubjectRaw :: Maybe (u -> Maybe Text)
+  maybeScimExternalId :: Maybe (u -> Maybe Text)
 
 -- | 'ValidScimUser' is tested in ScimSpec.hs exhaustively with literal inputs, so here we assume it
 -- is correct and don't aim to verify that name, handle, etc correspond to ones in 'vsuUser'.
@@ -553,9 +547,9 @@ instance IsUser ValidScimUser where
   maybeUserId = Nothing
   maybeHandle = Just (Just . view vsuHandle)
   maybeName = Just (Just . view vsuName)
-  maybeTenant = Just (Just . view (vsuUserRef . SAML.uidTenant))
-  maybeSubject = Just (Just . view (vsuUserRef . SAML.uidSubject))
-  maybeSubjectRaw = Just (SAML.shortShowNameID . view (vsuUserRef . SAML.uidSubject))
+  maybeTenant = Just (^? (vsuExternalId . veidUref . SAML.uidTenant))
+  maybeSubject = Just (^? (vsuExternalId . veidUref . SAML.uidSubject))
+  maybeScimExternalId = Just (runValidExternalId Intra.urefToExternalId (Just . fromEmail) . view vsuExternalId)
 
 instance IsUser (WrappedScimStoredUser SparTag) where
   maybeUserId = Just $ scimUserId . fromWrappedScimStoredUser
@@ -563,7 +557,7 @@ instance IsUser (WrappedScimStoredUser SparTag) where
   maybeName = maybeName <&> _wrappedStoredUserToWrappedUser
   maybeTenant = maybeTenant <&> _wrappedStoredUserToWrappedUser
   maybeSubject = maybeSubject <&> _wrappedStoredUserToWrappedUser
-  maybeSubjectRaw = maybeSubjectRaw <&> _wrappedStoredUserToWrappedUser
+  maybeScimExternalId = maybeScimExternalId <&> _wrappedStoredUserToWrappedUser
 
 _wrappedStoredUserToWrappedUser :: (WrappedScimUser tag -> a) -> (WrappedScimStoredUser tag -> a)
 _wrappedStoredUserToWrappedUser f = f . WrappedScimUser . Scim.value . Scim.thing . fromWrappedScimStoredUser
@@ -574,15 +568,27 @@ instance IsUser (WrappedScimUser SparTag) where
   maybeName = Just (fmap Name . Scim.User.displayName . fromWrappedScimUser)
   maybeTenant = Nothing
   maybeSubject = Nothing
-  maybeSubjectRaw = Just $ Scim.User.externalId . fromWrappedScimUser
+  maybeScimExternalId = Just $ Scim.User.externalId . fromWrappedScimUser
 
 instance IsUser User where
   maybeUserId = Just userId
   maybeHandle = Just userHandle
   maybeName = Just (Just . userDisplayName)
-  maybeTenant = Just (fmap (view SAML.uidTenant) . urefFromBrig)
-  maybeSubject = Just (fmap (view SAML.uidSubject) . urefFromBrig)
-  maybeSubjectRaw = Just (SAML.shortShowNameID . view SAML.uidSubject <=< urefFromBrig)
+  maybeTenant = Just $ \usr ->
+    Intra.veidFromBrigUser usr Nothing
+      & either
+        (const Nothing)
+        (preview (veidUref . SAML.uidTenant))
+  maybeSubject = Just $ \usr ->
+    Intra.veidFromBrigUser usr Nothing
+      & either
+        (const Nothing)
+        (preview (veidUref . SAML.uidSubject))
+  maybeScimExternalId = Just $ \usr ->
+    Intra.veidFromBrigUser usr Nothing
+      & either
+        (const Nothing)
+        (runValidExternalId Intra.urefToExternalId (Just . fromEmail))
 
 -- | For all properties that are present in both @u1@ and @u2@, check that they match.
 --
@@ -603,7 +609,7 @@ userShouldMatch u1 u2 = liftIO $ do
   check "name" maybeName
   check "tenant" maybeTenant
   check "subject" maybeSubject
-  check "subject (raw)" maybeSubjectRaw
+  check "scim externalId" maybeScimExternalId
   where
     check ::
       (Eq a, Show a) =>
@@ -614,22 +620,9 @@ userShouldMatch u1 u2 = liftIO $ do
       (Just a1, Just a2) -> (field, a1) `shouldBe` (field, a2)
       _ -> pure ()
 
-urefFromBrig :: User -> Maybe SAML.UserRef
-urefFromBrig brigUser = case userIdentity brigUser of
-  Just (SSOIdentity ssoid _ _) -> case Intra.fromUserSSOId ssoid of
-    Right uref -> Just uref
-    Left e ->
-      error $
-        "urefFromBrig: bad SSO id: "
-          <> "UserSSOId = "
-          <> show ssoid
-          <> ", error = "
-          <> e
-  _ -> Nothing
-
 -- | The spar scim implementation makes use of its right to drop a lot of attributes on the
 -- floor.  This function calls the spar functions that do that.  This allows us to express
 -- what we expect a user that comes back from spar to look like in terms of what it looked
 -- like when we sent it there.
 whatSparReturnsFor :: HasCallStack => IdP -> Int -> Scim.User.User SparTag -> Either String (Scim.User.User SparTag)
-whatSparReturnsFor idp richInfoSizeLimit = either (Left . show) (Right . synthesizeScimUser) . validateScimUser' idp richInfoSizeLimit
+whatSparReturnsFor idp richInfoSizeLimit = either (Left . show) (Right . synthesizeScimUser) . validateScimUser' (Just idp) richInfoSizeLimit
diff --git a/services/spar/test/Test/Spar/Intra/BrigSpec.hs b/services/spar/test/Test/Spar/Intra/BrigSpec.hs
index 51dc2a5959c..29e86f6aa43 100644
--- a/services/spar/test/Test/Spar/Intra/BrigSpec.hs
+++ b/services/spar/test/Test/Spar/Intra/BrigSpec.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -21,10 +22,12 @@ module Test.Spar.Intra.BrigSpec where
 
 import Arbitrary ()
 import Brig.Types.User (UserSSOId (UserSSOId))
+import Control.Lens ((^.))
 import Data.String.Conversions (ST, cs)
 import Imports
 import SAML2.WebSSO as SAML
 import Spar.Intra.Brig
+import Spar.Scim.Types
 import Test.Hspec
 import Test.QuickCheck
 import URI.ByteString (URI, laxURIParserOptions, parseURI)
@@ -34,36 +37,48 @@ mkuri = either (error . show) id . parseURI laxURIParserOptions . cs
 
 spec :: Spec
 spec = do
-  describe "toUserSSOId, fromUserSSOId" $ do
+  describe "veidToUserSSOId, veidFromUserSSOId" $ do
     -- example unit tests are mostly for documentation.  if they fail, it may be because of some
     -- harmless change in the string representation of the xml data, and you can probably just
     -- remove them.
 
     it "example" $ do
       let have =
-            UserRef
-              (Issuer $ mkuri "http://wire.com/")
-              ( either (error . show) id $
-                  mkNameID (mkUNameIDTransient "V") (Just "kati") (Just "rolli") (Just "jaan")
-              )
+            UrefOnly $
+              UserRef
+                (Issuer $ mkuri "http://wire.com/")
+                ( either (error . show) id $
+                    mkNameID (mkUNameIDTransient "V") (Just "kati") (Just "rolli") (Just "jaan")
+                )
           want =
             UserSSOId
               "<Issuer xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names:tc:SAML:2.0:assertion\" xmlns:samlm=\"urn:oasis:names:tc:SAML:2.0:metadata\" xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\" xmlns=\"urn:oasis:names:tc:SAML:2.0:assertion\">http://wire.com/</Issuer>"
               "<NameID xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names:tc:SAML:2.0:assertion\" xmlns:samlm=\"urn:oasis:names:tc:SAML:2.0:metadata\" xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\" Format=\"urn:oasis:names:tc:SAML:2.0:nameid-format:transient\" NameQualifier=\"kati\" SPNameQualifier=\"rolli\" SPProvidedID=\"jaan\" xmlns=\"urn:oasis:names:tc:SAML:2.0:assertion\">V</NameID>"
-      toUserSSOId have `shouldBe` want
-      fromUserSSOId want `shouldBe` Right have
+      veidToUserSSOId have `shouldBe` want
+      veidFromUserSSOId want `shouldBe` Right have
     it "another example" $ do
       let have =
-            UserRef
-              (Issuer $ mkuri "http://wire.com/")
-              ( either (error . show) id $
-                  mkNameID (mkUNameIDPersistent "PWkS") (Just "hendrik") Nothing (Just "marye")
-              )
+            UrefOnly $
+              UserRef
+                (Issuer $ mkuri "http://wire.com/")
+                ( either (error . show) id $
+                    mkNameID (mkUNameIDPersistent "PWkS") (Just "hendrik") Nothing (Just "marye")
+                )
           want =
             UserSSOId
               "<Issuer xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names:tc:SAML:2.0:assertion\" xmlns:samlm=\"urn:oasis:names:tc:SAML:2.0:metadata\" xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\" xmlns=\"urn:oasis:names:tc:SAML:2.0:assertion\">http://wire.com/</Issuer>"
               "<NameID xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:samla=\"urn:oasis:names:tc:SAML:2.0:assertion\" xmlns:samlm=\"urn:oasis:names:tc:SAML:2.0:metadata\" xmlns:ds=\"http://www.w3.org/2000/09/xmldsig#\" Format=\"urn:oasis:names:tc:SAML:2.0:nameid-format:persistent\" NameQualifier=\"hendrik\" SPProvidedID=\"marye\" xmlns=\"urn:oasis:names:tc:SAML:2.0:assertion\">PWkS</NameID>"
-      toUserSSOId have `shouldBe` want
-      fromUserSSOId want `shouldBe` Right have
+      veidToUserSSOId have `shouldBe` want
+      veidFromUserSSOId want `shouldBe` Right have
+
     it "roundtrips" . property $
-      \(x :: SAML.UserRef) -> (fromUserSSOId @(Either String) . toUserSSOId) x == Right x
+      \(x :: ValidExternalId) -> (veidFromUserSSOId @(Either String) . veidToUserSSOId) x === Right x
+
+instance Arbitrary ValidExternalId where
+  arbitrary = do
+    muref <- arbitrary
+    case muref of
+      Just uref -> case emailFromSAMLNameID $ uref ^. SAML.uidSubject of
+        Just email -> pure $ EmailAndUref email uref
+        Nothing -> pure $ UrefOnly uref
+      Nothing -> EmailOnly <$> arbitrary

From 4acab3bf7d13b49735c9fba445d924cb36ce5618 Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Wed, 16 Sep 2020 09:02:18 +0200
Subject: [PATCH 02/11] Leave domain empty in cookies, but account for clients
 with multiple (old) cookies. (#1102)

---
 .../services-demo/conf/brig.demo-docker.yaml  |   1 -
 deploy/services-demo/conf/brig.demo.yaml      |   1 -
 deploy/services-demo/conf/nginz/nginx.conf    |   5 +
 services/brig/brig.integration.yaml           |   1 -
 services/brig/src/Brig/Options.hs             |   2 -
 services/brig/src/Brig/Provider/API.hs        |   1 -
 services/brig/src/Brig/User/API/Auth.hs       |  64 +++++++---
 services/brig/src/Brig/User/Auth.hs           |  40 ++++--
 services/brig/src/Brig/User/Auth/Cookie.hs    |   2 -
 .../brig/test/integration/API/User/Auth.hs    | 118 +++++++++++++-----
 services/brig/test/integration/Util.hs        |  17 +++
 services/galley/src/Galley/API/LegalHold.hs   |   5 +-
 services/spar/src/Spar/API.hs                 |  16 +--
 services/spar/src/Spar/Options.hs             |   3 -
 services/spar/src/Spar/Types.hs               |   1 -
 15 files changed, 196 insertions(+), 81 deletions(-)

diff --git a/deploy/services-demo/conf/brig.demo-docker.yaml b/deploy/services-demo/conf/brig.demo-docker.yaml
index ec93635dec1..30043d54518 100644
--- a/deploy/services-demo/conf/brig.demo-docker.yaml
+++ b/deploy/services-demo/conf/brig.demo-docker.yaml
@@ -102,7 +102,6 @@ optSettings:
   setActivationTimeout: 1209600     # 1 day
   setTeamInvitationTimeout: 1814400 # 21 days
   setUserMaxConnections: 1000
-  setCookieDomain: brig
   setCookieInsecure: false
   setUserCookieRenewAge: 1209600 # 14 days
   setUserCookieLimit: 32
diff --git a/deploy/services-demo/conf/brig.demo.yaml b/deploy/services-demo/conf/brig.demo.yaml
index 4e6ac3a44fd..7eb7996395a 100644
--- a/deploy/services-demo/conf/brig.demo.yaml
+++ b/deploy/services-demo/conf/brig.demo.yaml
@@ -102,7 +102,6 @@ optSettings:
   setActivationTimeout: 1209600     # 1 day
   setTeamInvitationTimeout: 1814400 # 21 days
   setUserMaxConnections: 1000
-  setCookieDomain: localhost
   setCookieInsecure: false
   setUserCookieRenewAge: 1209600 # 14 days
   setUserCookieLimit: 32
diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf
index 00dd4a94043..979aaebf215 100644
--- a/deploy/services-demo/conf/nginz/nginx.conf
+++ b/deploy/services-demo/conf/nginz/nginx.conf
@@ -290,6 +290,11 @@ http {
       proxy_pass http://galley;
     }
 
+    location ~* ^/teams/([^/]*)/legalhold(.*) {
+      include common_response_with_zauth.conf;
+      proxy_pass http://galley;
+    }
+
     # Gundeck Endpoints
 
     rewrite ^/api-docs/push  /push/api-docs?base_url=http://127.0.0.1:8080/ break;
diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml
index 1614bf928f5..22c6c74dea2 100644
--- a/services/brig/brig.integration.yaml
+++ b/services/brig/brig.integration.yaml
@@ -135,7 +135,6 @@ optSettings:
   setNexmo: test/resources/nexmo-credentials.yaml
   # setStomp: test/resources/stomp-credentials.yaml
   setUserMaxConnections: 16
-  setCookieDomain: 127.0.0.1
   setCookieInsecure: true
   setUserCookieRenewAge: 2
   setUserCookieLimit: 5
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index dd3c3a6a747..b89765f627d 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -410,8 +410,6 @@ data Settings = Settings
     setUserMaxConnections :: !Int64,
     -- | Max. number of permanent clients per user
     setUserMaxPermClients :: !(Maybe Int),
-    -- | The domain to restrict cookies to
-    setCookieDomain :: !Text,
     -- | Whether to allow plain HTTP transmission
     --   of cookies (for testing purposes only)
     setCookieInsecure :: !Bool,
diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs
index b2b27087678..de2cc8ab6ed 100644
--- a/services/brig/src/Brig/Provider/API.hs
+++ b/services/brig/src/Brig/Provider/API.hs
@@ -1045,7 +1045,6 @@ setProviderCookie t r = do
       Cookie.def
         { Cookie.setCookieName = "zprovider",
           Cookie.setCookieValue = toByteString' t,
-          Cookie.setCookieDomain = Just $ Text.encodeUtf8 . setCookieDomain $ s,
           Cookie.setCookiePath = Just "/provider",
           Cookie.setCookieExpires = Just (ZAuth.tokenExpiresUTC t),
           Cookie.setCookieSecure = not (setCookieInsecure s),
diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs
index 103fb6d955a..7a15ab348c0 100644
--- a/services/brig/src/Brig/User/API/Auth.hs
+++ b/services/brig/src/Brig/User/API/Auth.hs
@@ -35,6 +35,8 @@ import qualified Data.ByteString as BS
 import Data.ByteString.Conversion
 import Data.Either.Combinators (leftToMaybe, rightToMaybe)
 import Data.Id
+import Data.List1 (List1)
+import qualified Data.List1 as List1
 import Data.Predicate
 import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.ZAuth.Token as ZAuth
@@ -43,7 +45,7 @@ import Network.HTTP.Types.Status
 import Network.Wai (Response)
 import Network.Wai.Predicate
 import qualified Network.Wai.Predicate as P
-import Network.Wai.Predicate.Request
+import qualified Network.Wai.Predicate.Request as R
 import Network.Wai.Routing
 import Network.Wai.Utilities.Error ((!>>))
 import Network.Wai.Utilities.Request (JsonRequest, jsonRequest)
@@ -225,12 +227,12 @@ legalHoldLogin l = do
   let typ = PersistentCookie -- Session cookie isn't a supported use case here
   Auth.legalHoldLogin l typ !>> legalHoldLoginError
 
-logoutH :: JSON ::: Maybe (Either ZAuth.UserToken ZAuth.LegalHoldUserToken) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> Handler Response
+logoutH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> Handler Response
 logoutH (_ ::: ut ::: at) = empty <$ logout ut at
 
 -- TODO: add legalhold test checking cookies are revoked (/access/logout is called) when legalhold device is deleted.
 logout ::
-  Maybe (Either ZAuth.UserToken ZAuth.LegalHoldUserToken) ->
+  Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ->
   Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) ->
   Handler ()
 logout Nothing Nothing = throwStd authMissingCookieAndToken
@@ -256,7 +258,7 @@ rmCookies :: UserId -> Public.RemoveCookies -> Handler ()
 rmCookies uid (Public.RemoveCookies pw lls ids) = do
   Auth.revokeAccess uid pw ids lls !>> authError
 
-renewH :: JSON ::: Maybe (Either ZAuth.UserToken ZAuth.LegalHoldUserToken) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> Handler Response
+renewH :: JSON ::: Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) -> Handler Response
 renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew ut at
 
 -- | renew access for either:
@@ -265,21 +267,21 @@ renewH (_ ::: ut ::: at) = lift . either tokenResponse tokenResponse =<< renew u
 --
 -- Other combinations of provided inputs will cause an error to be raised.
 renew ::
-  Maybe (Either ZAuth.UserToken ZAuth.LegalHoldUserToken) ->
+  Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken)) ->
   Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken) ->
   Handler (Either (Auth.Access ZAuth.User) (Auth.Access ZAuth.LegalHoldUser))
 renew = \case
   Nothing ->
     const $ throwStd authMissingCookie
-  (Just (Left userToken)) ->
+  (Just (Left userTokens)) ->
     -- normal UserToken, so we want a normal AccessToken
-    fmap Left . renewAccess userToken <=< matchingOrNone leftToMaybe
-  (Just (Right legalholdUserToken)) ->
+    fmap Left . renewAccess userTokens <=< matchingOrNone leftToMaybe
+  (Just (Right legalholdUserTokens)) ->
     -- LegalholdUserToken, so we want a LegalholdAccessToken
-    fmap Right . renewAccess legalholdUserToken <=< matchingOrNone rightToMaybe
+    fmap Right . renewAccess legalholdUserTokens <=< matchingOrNone rightToMaybe
   where
-    renewAccess ut mat =
-      Auth.renewAccess ut mat !>> zauthError
+    renewAccess uts mat =
+      Auth.renewAccess uts mat !>> zauthError
     matchingOrNone :: (a -> Maybe b) -> Maybe a -> Handler (Maybe b)
     matchingOrNone matching = traverse $ \accessToken ->
       case matching accessToken of
@@ -292,24 +294,30 @@ renew = \case
 -- | A predicate that captures user and access tokens for a request handler.
 tokenRequest ::
   forall r.
-  (HasCookies r, HasHeaders r, HasQuery r) =>
+  (R.HasCookies r, R.HasHeaders r, R.HasQuery r) =>
   Predicate
     r
     P.Error
-    ( Maybe (Either ZAuth.UserToken ZAuth.LegalHoldUserToken)
+    ( Maybe (Either (List1 ZAuth.UserToken) (List1 ZAuth.LegalHoldUserToken))
         ::: Maybe (Either ZAuth.AccessToken ZAuth.LegalHoldAccessToken)
     )
 tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| legalHoldAccessToken)
   where
-    userToken = cookieErr @ZAuth.User <$> cookie "zuid"
-    legalHoldUserToken = cookieErr @ZAuth.LegalHoldUser <$> cookie "zuid"
+    userToken = cookieErr @ZAuth.User <$> cookies "zuid"
+    legalHoldUserToken = cookieErr @ZAuth.LegalHoldUser <$> cookies "zuid"
     accessToken = parse @ZAuth.Access <$> (tokenHeader .|. tokenQuery)
     legalHoldAccessToken = parse @ZAuth.LegalHoldAccess <$> (tokenHeader .|. tokenQuery)
+    --
+    tokenHeader :: r -> Result P.Error ByteString
     tokenHeader = bearer <$> header "authorization"
+    --
+    tokenQuery :: r -> Result P.Error ByteString
     tokenQuery = query "access_token"
-    cookieErr :: ZAuth.UserTokenLike u => Result P.Error (ZAuth.Token u) -> Result P.Error (ZAuth.Token u)
+    --
+    cookieErr :: ZAuth.UserTokenLike u => Result P.Error (List1 (ZAuth.Token u)) -> Result P.Error (List1 (ZAuth.Token u))
     cookieErr x@Okay {} = x
     cookieErr (Fail x) = Fail (setMessage "Invalid user token" (P.setStatus status403 x))
+    --
     -- Extract the access token from the Authorization header.
     bearer :: Result P.Error ByteString -> Result P.Error ByteString
     bearer (Fail x) = Fail x
@@ -323,6 +331,7 @@ tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| l
                     TypeError
                     (setMessage "Invalid authorization scheme" (err status403))
                 )
+    --
     -- Parse the access token
     parse :: ZAuth.AccessTokenLike a => Result P.Error ByteString -> Result P.Error (ZAuth.Token a)
     parse (Fail x) = Fail x
@@ -338,3 +347,26 @@ tokenRequest = opt (userToken ||| legalHoldUserToken) .&. opt (accessToken ||| l
 tokenResponse :: ZAuth.UserTokenLike u => Auth.Access u -> AppIO Response
 tokenResponse (Auth.Access t Nothing) = pure $ json t
 tokenResponse (Auth.Access t (Just c)) = Auth.setResponseCookie c (json t)
+
+-- | Internal utilities: These functions are nearly copies verbatim from the original
+-- project: https://gitlab.com/twittner/wai-predicates/-/blob/develop/src/Network/Wai/Predicate.hs#L106-112
+-- I will still make an upstream PR but would not like to block this PR because of
+-- it. Main difference: the original stops after finding the first valid cookie which
+-- is a problem if clients send more than 1 cookie and one of them happens to be invalid
+-- We should also be dropping this in favor of servant which will make this redundant
+cookies :: (R.HasCookies r, FromByteString a) => ByteString -> Predicate r P.Error (List1 a)
+cookies k r =
+  case R.lookupCookie k r of
+    [] -> Fail . addLabel "cookie" $ notAvailable k
+    cc ->
+      case mapMaybe fromByteString cc of
+        [] -> (Fail . addLabel "cookie" . typeError k $ "Failed to get zuid cookies")
+        (x : xs) -> return $ List1.list1 x xs
+
+notAvailable :: ByteString -> P.Error
+notAvailable k = e400 & setReason NotAvailable . setSource k
+{-# INLINE notAvailable #-}
+
+typeError :: ByteString -> ByteString -> P.Error
+typeError k m = e400 & setReason TypeError . setSource k . setMessage m
+{-# INLINE typeError #-}
diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs
index 251e094d446..650374da184 100644
--- a/services/brig/src/Brig/User/Auth.hs
+++ b/services/brig/src/Brig/User/Auth.hs
@@ -60,7 +60,9 @@ import Control.Lens (to, view)
 import Data.ByteString.Conversion (toByteString)
 import Data.Handle (Handle)
 import Data.Id
-import Data.List1 (singleton)
+import qualified Data.List.NonEmpty as NE
+import Data.List1 (List1)
+import qualified Data.List1 as List1
 import Data.Misc (PlainTextPassword (..))
 import qualified Data.ZAuth.Token as ZAuth
 import Imports
@@ -152,18 +154,18 @@ withRetryLimit action uid = do
       BudgetExhausted ttl -> throwE . LoginBlocked . RetryAfter . floor $ ttl
       BudgetedValue () _ -> pure ()
 
-logout :: ZAuth.TokenPair u a => ZAuth.Token u -> ZAuth.Token a -> ExceptT ZAuth.Failure AppIO ()
-logout ut at = do
-  (u, ck) <- validateTokens ut (Just at)
+logout :: ZAuth.TokenPair u a => List1 (ZAuth.Token u) -> ZAuth.Token a -> ExceptT ZAuth.Failure AppIO ()
+logout uts at = do
+  (u, ck) <- validateTokens uts (Just at)
   lift $ revokeCookies u [cookieId ck] []
 
 renewAccess ::
   ZAuth.TokenPair u a =>
-  ZAuth.Token u ->
+  List1 (ZAuth.Token u) ->
   Maybe (ZAuth.Token a) ->
   ExceptT ZAuth.Failure AppIO (Access u)
-renewAccess ut at = do
-  (uid, ck) <- validateTokens ut at
+renewAccess uts at = do
+  (uid, ck) <- validateTokens uts at
   Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.renewAccess")
   catchSuspendInactiveUser uid ZAuth.Expired
   ck' <- lift $ nextCookie ck
@@ -192,7 +194,7 @@ catchSuspendInactiveUser uid errval = do
       msg (val "Suspending user due to inactivity")
         ~~ field "user" (toByteString uid)
         ~~ field "action" ("user.suspend" :: String)
-    lift $ suspendAccount (singleton uid)
+    lift $ suspendAccount (List1.singleton uid)
     throwE errval
 
 newAccess :: forall u a. ZAuth.TokenPair u a => UserId -> CookieType -> Maybe CookieLabel -> ExceptT LoginError AppIO (Access u)
@@ -252,12 +254,32 @@ isPendingActivation ident = case ident of
             Just SSOIdentity {} -> False -- sso-created users are activated immediately.
             Nothing -> True
 
+-- | Validate a list of (User/LH) tokens potentially with an associated access token.
+--   If there are multiple valid cookies, we try all of them. When an access token is
+--   given, we perform the usual checks.
+--   If multiple cookies are given and several are valid, we return the first valid one.
 validateTokens ::
+  ZAuth.TokenPair u a =>
+  List1 (ZAuth.Token u) ->
+  Maybe (ZAuth.Token a) ->
+  ExceptT ZAuth.Failure AppIO (UserId, Cookie (ZAuth.Token u))
+validateTokens uts at = do
+  tokens <- forM uts $ \ut -> lift $ runExceptT (validateToken ut at)
+  getFirstSuccessOrFirstFail tokens
+  where
+    -- FUTUREWORK: There is surely a better way to do this
+    getFirstSuccessOrFirstFail :: List1 (Either ZAuth.Failure (UserId, Cookie (ZAuth.Token u))) -> ExceptT ZAuth.Failure AppIO (UserId, Cookie (ZAuth.Token u))
+    getFirstSuccessOrFirstFail tks = case (lefts $ NE.toList $ List1.toNonEmpty tks, rights $ NE.toList $ List1.toNonEmpty tks) of
+      (_, (suc : _)) -> return suc
+      ((e : _), _) -> throwE e
+      _ -> throwE ZAuth.Invalid -- Impossible
+
+validateToken ::
   ZAuth.TokenPair u a =>
   ZAuth.Token u ->
   Maybe (ZAuth.Token a) ->
   ExceptT ZAuth.Failure AppIO (UserId, Cookie (ZAuth.Token u))
-validateTokens ut at = do
+validateToken ut at = do
   unless (maybe True ((ZAuth.userTokenOf ut ==) . ZAuth.accessTokenOf) at) $
     throwE ZAuth.Invalid
   ExceptT (ZAuth.validateToken ut)
diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs
index 037c2b8016b..2d0b394a242 100644
--- a/services/brig/src/Brig/User/Auth/Cookie.hs
+++ b/services/brig/src/Brig/User/Auth/Cookie.hs
@@ -52,7 +52,6 @@ import Data.Id
 import qualified Data.List as List
 import qualified Data.Metrics as Metrics
 import Data.Proxy
-import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock
 import Imports
 import Network.Wai (Response)
@@ -235,7 +234,6 @@ setResponseCookie c r = do
       WebCookie.def
         { WebCookie.setCookieName = "zuid",
           WebCookie.setCookieValue = toByteString' (cookieValue c),
-          WebCookie.setCookieDomain = Just $ encodeUtf8 . setCookieDomain $ s,
           WebCookie.setCookiePath = Just "/access",
           WebCookie.setCookieExpires =
             if cookieType c == PersistentCookie
diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs
index 2059a71d956..3590159df1c 100644
--- a/services/brig/test/integration/API/User/Auth.hs
+++ b/services/brig/test/integration/API/User/Auth.hs
@@ -36,10 +36,9 @@ import Brig.Types.User.Auth
 import qualified Brig.Types.User.Auth as Auth
 import Brig.ZAuth (ZAuth, runZAuth)
 import qualified Brig.ZAuth as ZAuth
-import Control.Lens (set, (^.), (^?))
+import Control.Lens (set, (^.))
 import Control.Retry
 import Data.Aeson
-import Data.Aeson.Lens
 import qualified Data.ByteString as BS
 import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as Lazy
@@ -48,7 +47,6 @@ import Data.Id
 import Data.Misc (PlainTextPassword (..))
 import Data.Proxy
 import qualified Data.Text as Text
-import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.Lazy as Lazy
 import Data.Time.Clock
 import qualified Data.UUID.V4 as UUID
@@ -96,7 +94,8 @@ tests conf m z b g n =
           testGroup
             "nginz"
             [ test m "nginz-login" (testNginz b n),
-              test m "nginz-legalhold-login" (testNginzLegalHold b g n)
+              test m "nginz-legalhold-login" (testNginzLegalHold b g n),
+              test m "nginz-login-multiple-cookies" (testNginzMultipleCookies conf b n)
             ]
         ],
       testGroup
@@ -146,7 +145,7 @@ testNginz b n = do
   let Just email = userEmail u
   -- Login with email
   rs <-
-    login b (defEmailLogin email) PersistentCookie
+    login n (defEmailLogin email) PersistentCookie
       <!! const 200 === statusCode
   let c = decodeCookie rs
       t = decodeToken rs
@@ -167,13 +166,27 @@ testNginz b n = do
 testNginzLegalHold :: Brig -> Galley -> Nginz -> Http ()
 testNginzLegalHold b g n = do
   -- create team user Alice
-  (alice, tid) <- createUserWithTeam b
+  (alice, tid) <- createUserWithTeam' b
   putLegalHoldEnabled tid TeamFeatureEnabled g -- enable it for this team
-  rs <-
-    legalHoldLogin b (LegalHoldLogin alice (Just defPassword) Nothing) PersistentCookie
-      <!! const 200 === statusCode
-  let c = decodeCookie rs
-      t = decodeToken' @ZAuth.LegalHoldAccess rs
+  (c, t) <- do
+    -- we need to get the cookie domain from a login through nginz.  otherwise, if brig and
+    -- nginz are running on different hosts, no cookie will be presented in the later requests
+    -- to nginz in this test.  for simplicity, we use the internal end-point for
+    -- authenticating an LH dev, and then steal the domain from a cookie obtained via user
+    -- login.
+    rsUsr <- do
+      let Just email = userEmail alice
+      login n (defEmailLogin email) PersistentCookie
+        <!! const 200 === statusCode
+    rsLhDev <-
+      legalHoldLogin b (LegalHoldLogin (userId alice) (Just defPassword) Nothing) PersistentCookie
+        <!! const 200 === statusCode
+    let t = decodeToken' @ZAuth.LegalHoldAccess rsLhDev
+        c = cLhDev {cookie_domain = cookie_domain cUsr}
+        cLhDev = decodeCookie rsLhDev
+        cUsr = decodeCookie rsUsr
+    pure (c, t)
+
   -- ensure nginz allows passing legalhold cookies / tokens through to /access
   post (n . path "/access" . cookie c . header "Authorization" ("Bearer " <> (toByteString' t))) !!! do
     const 200 === statusCode
@@ -183,6 +196,57 @@ testNginzLegalHold b g n = do
   -- ensure legal hold tokens can fetch notifications
   get (n . path "/notifications" . header "Authorization" ("Bearer " <> (toByteString' t))) !!! const 200 === statusCode
 
+-- | Corner case for 'testNginz': when upgrading a wire backend from the old behavior (setting
+-- cookie domain to eg. @*.wire.com@) to the new behavior (leaving cookie domain empty,
+-- effectively setting it to the backend host), clients may start sending two cookies for a
+-- while: because the domains differ, new ones will not overwrite old ones locally (it was seen
+-- on different browsers) although the cookie does get overriden in the DB). This should be handled
+-- gracefully (ie., one invalid cookie should just be ignored if up to two cookies with label @"zuid"@ are present).
+--
+-- In this test, we actually don't use different domains - testing that correctly is actually pretty
+-- complex. The reason why testing 2 domains is complicated has to do with the fact that we need to
+-- have 2 distinct domains that point to the same backend; i.e., this is the case on our staging env where
+-- old cookies had the domain to the TLD and new ones to <subdomain>.TLD. This is hard to do on k8s for instance
+--
+-- Instead, we simply set 2 cookies with the same name and different values and the http client
+-- will replicate the situation: we have 2 cookies, one of them is incorrect (but must parse correctly!)
+-- and the other is valid.
+-- In order to make the test even more similar, we also use VALID and NON-EXPIRED but SUPERSEDED cookies
+-- cookies to test sending 2 perfectly valid cookies where one of them simply got overriden due to the revew age
+testNginzMultipleCookies :: Opts.Opts -> Brig -> Nginz -> Http ()
+testNginzMultipleCookies o b n = do
+  u <- randomUser b
+  let Just email = userEmail u
+      dologin :: HasCallStack => Http ResponseLBS
+      dologin = login n (defEmailLogin email) PersistentCookie <!! const 200 === statusCode
+  unparseableCookie <- (\c -> c {cookie_value = "ThisIsNotAZauthCookie"}) . decodeCookie <$> dologin
+  badCookie1 <- (\c -> c {cookie_value = "SKsjKQbiqxuEugGMWVbq02fNEA7QFdNmTiSa1Y0YMgaEP5tWl3nYHWlIrM5F8Tt7Cfn2Of738C7oeiY8xzPHAB==.v=1.k=1.d=1.t=u.l=.u=13da31b4-c6bb-4561-8fed-07e728fa6cc5.r=f844b420"}) . decodeCookie <$> dologin
+  goodCookie <- decodeCookie <$> dologin
+  badCookie2 <- (\c -> c {cookie_value = "SKsjKQbiqxuEugGMWVbq02fNEA7QFdNmTiSa1Y0YMgaEP5tWl3nYHWlIrM5F8Tt7Cfn2Of738C7oeiY8xzPHAC==.v=1.k=1.d=1.t=u.l=.u=13da31b4-c6bb-4561-8fed-07e728fa6cc5.r=f844b420"}) . decodeCookie <$> dologin
+
+  -- Basic sanity checks
+  post (n . path "/access" . cookie goodCookie) !!! const 200 === statusCode
+  post (n . path "/access" . cookie badCookie1) !!! const 403 === statusCode
+  post (n . path "/access" . cookie badCookie2) !!! const 403 === statusCode
+
+  -- Sending both cookies should always work, regardless of the order (they are ordered by time)
+  post (n . path "/access" . cookie badCookie1 . cookie goodCookie . cookie badCookie2) !!! const 200 === statusCode
+  post (n . path "/access" . cookie goodCookie . cookie badCookie1 . cookie badCookie2) !!! const 200 === statusCode
+  post (n . path "/access" . cookie badCookie1 . cookie badCookie2 . cookie goodCookie) !!! const 200 === statusCode -- -- Sending a bad cookie and an unparseble one should work too
+  post (n . path "/access" . cookie unparseableCookie . cookie goodCookie) !!! const 200 === statusCode
+  post (n . path "/access" . cookie goodCookie . cookie unparseableCookie) !!! const 200 === statusCode
+
+  -- We want to make sure we are using a cookie that was deleted from the DB but not expired - this way the client
+  -- will still have it in the cookie jar because it did not get overriden
+  (deleted, valid) <- getAndTestDBSupersededCookieAndItsValidSuccessor o b n
+  now <- liftIO getCurrentTime
+  liftIO $ assertBool "cookie should not be expired" (cookie_expiry_time deleted > now)
+  liftIO $ assertBool "cookie should not be expired" (cookie_expiry_time valid > now)
+  post (n . path "/access" . cookie deleted) !!! const 403 === statusCode
+  post (n . path "/access" . cookie valid) !!! const 200 === statusCode
+  post (n . path "/access" . cookie deleted . cookie valid) !!! const 200 === statusCode
+  post (n . path "/access" . cookie valid . cookie deleted) !!! const 200 === statusCode
+
 -------------------------------------------------------------------------------
 -- Login
 
@@ -579,21 +643,28 @@ testTokenMismatch z brig galley = do
     const 403 === statusCode
     const (Just "Token mismatch") =~= responseBody
 
+-- | We are a little bit nasty on this test. For most cases, one can use brig and nginz interchangeably.
+--   In this case, the issue relates to the usage of `getAndTestDBSupersededCookieAndItsValidSuccessor`.
+--   That function can be refactored though to make this more clear
 testNewPersistentCookie :: Opts.Opts -> Brig -> Http ()
-testNewPersistentCookie config b = do
+testNewPersistentCookie config b =
+  void $ getAndTestDBSupersededCookieAndItsValidSuccessor config b b
+
+getAndTestDBSupersededCookieAndItsValidSuccessor :: Opts.Opts -> Brig -> Nginz -> Http (Http.Cookie, Http.Cookie)
+getAndTestDBSupersededCookieAndItsValidSuccessor config b n = do
   u <- randomUser b
   let renewAge = Opts.setUserCookieRenewAge $ Opts.optSettings config
   let minAge = fromIntegral $ renewAge * 1000000 + 1
       Just email = userEmail u
   _rs <-
-    login b (emailLogin email defPassword (Just "nexus1")) PersistentCookie
+    login n (emailLogin email defPassword (Just "nexus1")) PersistentCookie
       <!! const 200 === statusCode
   let c = decodeCookie _rs
   -- Wait for the cookie to be eligible for renewal
   liftIO $ threadDelay minAge
   -- Refresh tokens
   _rs <-
-    post (b . path "/access" . cookie c) <!! do
+    post (n . path "/access" . cookie c) <!! do
       const 200 === statusCode
       const Nothing =/= getHeader "Set-Cookie"
       const (Just "access_token") =~= responseBody
@@ -603,7 +674,7 @@ testNewPersistentCookie config b = do
   -- duration of another BRIG_COOKIE_RENEW_AGE seconds,
   -- but the response should keep advertising the new cookie.
   _rs <-
-    post (b . path "/access" . cookie c) <!! do
+    post (n . path "/access" . cookie c) <!! do
       const 200 === statusCode
       const Nothing =/= getHeader "Set-Cookie"
       const (Just "access_token") =~= responseBody
@@ -611,7 +682,7 @@ testNewPersistentCookie config b = do
   liftIO $ assertBool "cookie" (c' `equivCookie` decodeCookie _rs)
   -- Refresh with the new cookie should succeed
   -- (without advertising yet another new cookie).
-  post (b . path "/access" . cookie c') !!! do
+  post (n . path "/access" . cookie c') !!! do
     const 200 === statusCode
     const Nothing === getHeader "Set-Cookie"
     const (Just "access_token") =~= responseBody
@@ -628,6 +699,9 @@ testNewPersistentCookie config b = do
   liftIO $ do
     [PersistentCookie] @=? map cookieType _cs
     [Nothing] @=? map cookieSucc _cs
+  -- Return non-expired cookie but removed from DB (because it was renewed)
+  -- and a valid cookie
+  return (c, c')
 
 testNewSessionCookie :: Opts.Opts -> Brig -> Http ()
 testNewSessionCookie config b = do
@@ -849,18 +923,6 @@ prepareLegalHoldUser brig galley = do
   putLegalHoldEnabled tid TeamFeatureEnabled galley
   return uid
 
-decodeCookie :: HasCallStack => Response a -> Http.Cookie
-decodeCookie = fromMaybe (error "missing zuid cookie") . getCookie "zuid"
-
-decodeToken :: HasCallStack => Response (Maybe Lazy.ByteString) -> ZAuth.AccessToken
-decodeToken = decodeToken' @ZAuth.Access
-
-decodeToken' :: (HasCallStack, ZAuth.AccessTokenLike a) => Response (Maybe Lazy.ByteString) -> ZAuth.Token a
-decodeToken' r = fromMaybe (error "invalid access_token") $ do
-  x <- responseBody r
-  t <- x ^? key "access_token" . _String
-  fromByteString (encodeUtf8 t)
-
 getCookieId :: forall u. (HasCallStack, ZAuth.UserTokenLike u) => Http.Cookie -> CookieId
 getCookieId c =
   maybe
diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs
index 405ee2b69df..bade4a50538 100644
--- a/services/brig/test/integration/Util.hs
+++ b/services/brig/test/integration/Util.hs
@@ -35,6 +35,7 @@ import Brig.Types.Connection
 import Brig.Types.Intra
 import Brig.Types.User
 import Brig.Types.User.Auth
+import qualified Brig.ZAuth as ZAuth
 import Control.Lens ((^.), (^?), (^?!))
 import Control.Monad.Catch (MonadCatch)
 import Control.Monad.Fail (MonadFail)
@@ -53,6 +54,7 @@ import qualified Data.List1 as List1
 import Data.Misc (PlainTextPassword (..))
 import qualified Data.Text as Text
 import qualified Data.Text.Ascii as Ascii
+import Data.Text.Encoding (encodeUtf8)
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as UUID
 import qualified Galley.Types.Teams as Team
@@ -316,6 +318,9 @@ getUser brig zusr usr =
       . paths ["users", toByteString' usr]
       . zUser zusr
 
+-- | NB: you can also use nginz as the first argument here.  The type aliases are compatible,
+-- and so are the end-points.  This is important in tests where the cookie must come from the
+-- nginz domain, so it can be passed back to it.
 login :: Brig -> Login -> CookieType -> (MonadIO m, MonadHttp m) => m ResponseLBS
 login b l t =
   let js = RequestBodyLBS (encode l)
@@ -346,6 +351,18 @@ legalHoldLogin b l t =
           . (if t == PersistentCookie then queryItem "persist" "true" else id)
           . body js
 
+decodeCookie :: HasCallStack => Response a -> Bilge.Cookie
+decodeCookie = fromMaybe (error "missing zuid cookie") . getCookie "zuid"
+
+decodeToken :: HasCallStack => Response (Maybe LByteString) -> ZAuth.AccessToken
+decodeToken = decodeToken'
+
+decodeToken' :: (HasCallStack, ZAuth.AccessTokenLike a) => Response (Maybe LByteString) -> ZAuth.Token a
+decodeToken' r = fromMaybe (error "invalid access_token") $ do
+  x <- responseBody r
+  t <- x ^? key "access_token" . _String
+  fromByteString (encodeUtf8 t)
+
 data LoginCodeType = LoginCodeSMS | LoginCodeVoice
   deriving (Eq)
 
diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs
index 76d1a081834..bf1719bf7ce 100644
--- a/services/galley/src/Galley/API/LegalHold.hs
+++ b/services/galley/src/Galley/API/LegalHold.hs
@@ -217,8 +217,9 @@ requestDevice zusr tid uid = do
       let NewLegalHoldClient prekeys lastKey = lhDevice
       return (lastKey, prekeys)
 
--- | Approve the adding of a Legal Hold device to the user
--- we don't delete pending prekeys during this flow just in case
+-- | Approve the adding of a Legal Hold device to the user.
+--
+-- We don't delete pending prekeys during this flow just in case
 -- it gets interupted. There's really no reason to delete them anyways
 -- since they are replaced if needed when registering new LH devices.
 approveDeviceH ::
diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs
index 3549a3a1b41..57edd55aacd 100644
--- a/services/spar/src/Spar/API.hs
+++ b/services/spar/src/Spar/API.hs
@@ -69,7 +69,6 @@ import Spar.Scim
 import Spar.Scim.Swagger ()
 import Spar.Types
 import qualified URI.ByteString as URI
-import qualified Web.Cookie as Cky
 
 app :: Env -> Application
 app ctx =
@@ -144,23 +143,12 @@ authreq authreqttl _ zusr msucc merr idpid = do
 -- value that deletes any bind cookies on the client.
 initializeBindCookie :: Maybe UserId -> NominalDiffTime -> Spar SetBindCookie
 initializeBindCookie zusr authreqttl = do
-  DerivedOpts {derivedOptsBindCookiePath, derivedOptsBindCookieDomain} <-
-    asks (derivedOpts . sparCtxOpts)
+  DerivedOpts {derivedOptsBindCookiePath} <- asks (derivedOpts . sparCtxOpts)
   msecret <-
     if isJust zusr
       then liftIO $ Just . cs . ES.encode <$> randBytes 32
       else pure Nothing
-  let updSetCkyDom (SAML.SimpleSetCookie raw) =
-        SAML.SimpleSetCookie
-          raw
-            { Cky.setCookieDomain = Just derivedOptsBindCookieDomain
-            }
-  cky <-
-    updSetCkyDom
-      <$> ( SAML.toggleCookie derivedOptsBindCookiePath $
-              (,authreqttl) <$> msecret ::
-              Spar SetBindCookie
-          )
+  cky <- SAML.toggleCookie derivedOptsBindCookiePath $ (,authreqttl) <$> msecret
   forM_ zusr $ \userid -> wrapMonadClientWithEnv $ Data.insertBindCookie cky userid authreqttl
   pure cky
 
diff --git a/services/spar/src/Spar/Options.hs b/services/spar/src/Spar/Options.hs
index fc9386fecac..c993140f520 100644
--- a/services/spar/src/Spar/Options.hs
+++ b/services/spar/src/Spar/Options.hs
@@ -30,7 +30,6 @@ where
 
 import Control.Exception
 import Control.Lens
-import Control.Monad.Catch
 import qualified Data.ByteString as SBS
 import qualified Data.Yaml as Yaml
 import Imports
@@ -56,8 +55,6 @@ deriveOpts raw = do
   derived <- do
     let respuri = runWithConfig raw sparResponseURI
         derivedOptsBindCookiePath = URI.uriPath respuri
-        unwrap = maybe (throwM $ ErrorCall "Bad server config: no domain in response URI") pure
-    derivedOptsBindCookieDomain <- URI.hostBS . URI.authorityHost <$> unwrap (URI.uriAuthority respuri)
     -- We could also make this selectable in the config file, but it seems easier to derive it from
     -- the SAML base uri.
     let derivedOptsScimBaseURI = (saml raw ^. SAML.cfgSPSsoURI) & pathL %~ derive
diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs
index 66425194635..efa304135e7 100644
--- a/services/spar/src/Spar/Types.hs
+++ b/services/spar/src/Spar/Types.hs
@@ -253,7 +253,6 @@ instance FromJSON (Opts' (Maybe ()))
 
 data DerivedOpts = DerivedOpts
   { derivedOptsBindCookiePath :: !SBS,
-    derivedOptsBindCookieDomain :: !SBS,
     derivedOptsScimBaseURI :: !URI
   }
   deriving (Show, Generic)

From d238b11595557e6d2ca356229ed507f522bab06c Mon Sep 17 00:00:00 2001
From: Matthias Heinzel <mheinzel@posteo.de>
Date: Thu, 17 Sep 2020 17:50:57 +0200
Subject: [PATCH 03/11] Cargohold: Log more about AWS errors (#1205)

We will probably make it less verbose again in the future, but at the
moment this is helpful for debugging issues caused by switching to
amazonka.

* cargohold: log more AWS errors

* add comments to amazonka log level mapping

Copied from other services. Might be nice to unify this?
---
 services/cargohold/src/CargoHold/AWS.hs | 27 +++++++++++++++++++++----
 services/cargohold/src/CargoHold/S3.hs  |  4 ++--
 2 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/services/cargohold/src/CargoHold/AWS.hs b/services/cargohold/src/CargoHold/AWS.hs
index 096daf00d36..b3b00d531f8 100644
--- a/services/cargohold/src/CargoHold/AWS.hs
+++ b/services/cargohold/src/CargoHold/AWS.hs
@@ -129,8 +129,17 @@ mkEnv lgr s3End s3Download bucket cfOpts mgr = do
         <&> AWS.configure s3
     awsLogger g l = Logger.log g (mapLevel l) . Log.msg . toLazyByteString
     mapLevel AWS.Info = Logger.Info
+    -- Debug output from amazonka can be very useful for tracing requests
+    -- but is very verbose (and multiline which we don't handle well)
+    -- distracting from our own debug logs, so we map amazonka's 'Debug'
+    -- level to our 'Trace' level.
     mapLevel AWS.Debug = Logger.Trace
     mapLevel AWS.Trace = Logger.Trace
+    -- n.b. Errors are either returned or thrown. In both cases they will
+    -- already be logged if left unhandled. We don't want errors to be
+    -- logged inside amazonka already, before we even had a chance to handle
+    -- them, which results in distracting noise. For debugging purposes,
+    -- they are still revealed on debug level.
     mapLevel AWS.Error = Logger.Debug
 
 execute :: MonadIO m => Env -> Amazon a -> m a
@@ -158,13 +167,23 @@ throwA :: Either AWS.Error a -> Amazon a
 throwA = either (throwM . GeneralError) return
 
 exec ::
-  (AWSRequest r, MonadIO m) =>
+  (AWSRequest r, Show r, MonadLogger m, MonadIO m, MonadThrow m) =>
   Env ->
   (Text -> r) ->
   m (Rs r)
 exec env request = do
-  let bucket = _s3Bucket env
-  execute env (AWS.send $ request bucket)
+  let req = request (_s3Bucket env)
+  resp <- execute env (sendCatch req)
+  case resp of
+    Left err -> do
+      Log.info $
+        Log.field "remote" (Log.val "S3")
+          ~~ Log.msg (show err)
+          ~~ Log.msg (show req)
+      -- We just re-throw the error, but logging it here also gives us the request
+      -- that caused it.
+      throwM (GeneralError err)
+    Right r -> return r
 
 execCatch ::
   (AWSRequest r, Show r, MonadLogger m, MonadIO m) =>
@@ -176,7 +195,7 @@ execCatch env request = do
   resp <- execute env (retrying retry5x (const canRetry) (const (sendCatch req)))
   case resp of
     Left err -> do
-      Log.debug $
+      Log.info $
         Log.field "remote" (Log.val "S3")
           ~~ Log.msg (show err)
           ~~ Log.msg (show req)
diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs
index dbe4e84a721..8d5e05aabe7 100644
--- a/services/cargohold/src/CargoHold/S3.hs
+++ b/services/cargohold/src/CargoHold/S3.hs
@@ -107,7 +107,7 @@ uploadV3 ::
   Conduit.ConduitM () ByteString (ResourceT IO) () ->
   ExceptT Error App ()
 uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do
-  Log.debug $
+  Log.info $
     "remote" .= val "S3"
       ~~ "asset.owner" .= toByteString prc
       ~~ "asset.key" .= key
@@ -728,7 +728,7 @@ parseAmzMeta k h = lookupCI k h >>= fromByteString . encodeUtf8
 octets :: MIME.Type
 octets = MIME.Type (MIME.Application "octet-stream") []
 
-exec :: (AWSRequest r) => (Text -> r) -> ExceptT Error App (Rs r)
+exec :: (AWSRequest r, Show r) => (Text -> r) -> ExceptT Error App (Rs r)
 exec req = do
   env <- view aws
   AWS.exec env req

From 597769a5df0d029ec0106205ef939da663f3dbd8 Mon Sep 17 00:00:00 2001
From: fisx <mf@zerobuzz.net>
Date: Tue, 22 Sep 2020 10:34:14 +0200
Subject: [PATCH 04/11] Move <$$>, <$$$> to default imports. (#1208)

---
 libs/imports/src/Imports.hs                   | 17 +++++++++++++++
 libs/tasty-cannon/src/Test/Tasty/Cannon.hs    |  1 -
 libs/types-common/src/Data/Misc.hs            | 17 ---------------
 services/brig/src/Brig/API/Internal.hs        |  1 -
 services/brig/src/Brig/API/Public.hs          |  2 +-
 services/brig/src/Brig/API/User.hs            |  2 +-
 services/brig/src/Brig/Calling/API.hs         |  1 -
 services/brig/src/Brig/Options.hs             |  1 -
 services/brig/src/Brig/Provider/API.hs        |  2 +-
 services/gundeck/test/unit/MockGundeck.hs     |  2 +-
 services/spar/src/Spar/App.hs                 | 20 +++++++++++++++++-
 services/spar/src/Spar/Data.hs                |  1 -
 services/spar/src/Spar/Intra/Brig.hs          |  2 +-
 services/spar/src/Spar/Scim/User.hs           |  1 -
 .../test-integration/Test/Spar/APISpec.hs     | 21 ++++++++++++++++++-
 15 files changed, 61 insertions(+), 30 deletions(-)

diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs
index 50be52f3589..961a96519da 100644
--- a/libs/imports/src/Imports.hs
+++ b/libs/imports/src/Imports.hs
@@ -114,6 +114,10 @@ module Imports
     -- * Extra Helpers
     whenM,
     unlessM,
+
+    -- * Functor
+    (<$$>),
+    (<$$$>),
   )
 where
 
@@ -276,3 +280,16 @@ readIO = liftIO . P.readIO
 
 readLn :: (Read a, MonadIO m) => m a
 readLn = liftIO P.readLn
+
+----------------------------------------------------------------------
+-- Functor
+
+(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
+(<$$>) = fmap . fmap
+
+infix 4 <$$>
+
+(<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
+(<$$$>) = fmap . fmap . fmap
+
+infix 4 <$$$>
diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs
index c40cef37ef2..368c8a8386c 100644
--- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs
+++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs
@@ -74,7 +74,6 @@ import qualified Data.ByteString.Char8 as C
 import Data.ByteString.Conversion
 import Data.Id
 import Data.List1
-import Data.Misc ((<$$>))
 import Data.Timeout (Timeout, TimeoutUnit (..), (#))
 import Gundeck.Types
 import Imports
diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs
index b58c715e2ac..bbe736b3950 100644
--- a/libs/types-common/src/Data/Misc.hs
+++ b/libs/types-common/src/Data/Misc.hs
@@ -51,10 +51,6 @@ module Data.Misc
     -- * PlainTextPassword
     PlainTextPassword (..),
 
-    -- * Functor infix ops
-    (<$$>),
-    (<$$$>),
-
     -- * Swagger
     modelLocation,
   )
@@ -327,16 +323,3 @@ instance FromJSON PlainTextPassword where
 instance Arbitrary PlainTextPassword where
   -- TODO: why 6..1024? For tests we might want invalid passwords as well, e.g. 3 chars
   arbitrary = PlainTextPassword . fromRange <$> genRangeText @6 @1024 arbitrary
-
-----------------------------------------------------------------------
--- Functor
-
-(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
-(<$$>) = fmap . fmap
-
-infix 4 <$$>
-
-(<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
-(<$$$>) = fmap . fmap . fmap
-
-infix 4 <$$$>
diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs
index 4c5a296ae69..01daee37123 100644
--- a/services/brig/src/Brig/API/Internal.hs
+++ b/services/brig/src/Brig/API/Internal.hs
@@ -48,7 +48,6 @@ import Data.Handle (Handle)
 import Data.Id as Id
 import qualified Data.List1 as List1
 import qualified Data.Map.Strict as Map
-import Data.Misc ((<$$>))
 import qualified Data.Set as Set
 import Galley.Types (UserClients (..))
 import Imports hiding (head)
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index f40c5b03c81..7afead44526 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -56,7 +56,7 @@ import Data.Handle (Handle, parseHandle)
 import Data.Id as Id
 import Data.IdMapping (MappedOrLocalId (Local))
 import qualified Data.Map.Strict as Map
-import Data.Misc (IpAddr (..), (<$$>))
+import Data.Misc (IpAddr (..))
 import Data.Qualified (OptionallyQualified, eitherQualifiedOrNot)
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs
index a861304e37b..03bbea02914 100644
--- a/services/brig/src/Brig/API/User.hs
+++ b/services/brig/src/Brig/API/User.hs
@@ -132,7 +132,7 @@ import Data.IdMapping (MappedOrLocalId, partitionMappedOrLocalIds)
 import Data.Json.Util
 import Data.List1 (List1)
 import qualified Data.Map.Strict as Map
-import Data.Misc (PlainTextPassword (..), (<$$>))
+import Data.Misc (PlainTextPassword (..))
 import Data.Time.Clock (diffUTCTime)
 import Data.UUID.V4 (nextRandom)
 import qualified Galley.Types.Teams as Team
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index e1900114acf..b0e393c83c0 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -34,7 +34,6 @@ import Data.Id
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.List1 as List1
-import Data.Misc ((<$$>))
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
 import Data.Text.Ascii (AsciiBase64, encodeBase64)
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index b89765f627d..2e6937862bc 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -33,7 +33,6 @@ import Data.Aeson.Types (typeMismatch)
 import qualified Data.Char as Char
 import Data.Domain (Domain)
 import Data.Id
-import Data.Misc ((<$$>))
 import Data.Scientific (toBoundedInteger)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs
index de2cc8ab6ed..9de1e49f6d4 100644
--- a/services/brig/src/Brig/Provider/API.hs
+++ b/services/brig/src/Brig/Provider/API.hs
@@ -64,7 +64,7 @@ import Data.Id
 import qualified Data.List as List
 import Data.List1 (maybeList1)
 import qualified Data.Map.Strict as Map
-import Data.Misc (Fingerprint (..), Rsa, (<$$>))
+import Data.Misc (Fingerprint (..), Rsa)
 import Data.Predicate
 import Data.Range
 import qualified Data.Set as Set
diff --git a/services/gundeck/test/unit/MockGundeck.hs b/services/gundeck/test/unit/MockGundeck.hs
index 9ea022a2303..99b47309d39 100644
--- a/services/gundeck/test/unit/MockGundeck.hs
+++ b/services/gundeck/test/unit/MockGundeck.hs
@@ -53,7 +53,7 @@ import qualified Data.IntMultiSet as MSet
 import qualified Data.List.NonEmpty as NE
 import Data.List1
 import qualified Data.Map as Map
-import Data.Misc (Milliseconds (Ms), (<$$>))
+import Data.Misc (Milliseconds (Ms))
 import Data.Range
 import qualified Data.Scientific as Scientific
 import qualified Data.Set as Set
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index 56778246e97..b9af844e549 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -54,7 +54,25 @@ import Imports hiding (log)
 import qualified Network.HTTP.Types.Status as Http
 import qualified Network.Wai.Utilities.Error as Wai
 import SAML2.Util (renderURI)
-import SAML2.WebSSO hiding (Email (..), UserRef (..))
+import SAML2.WebSSO
+  ( Assertion (..),
+    AuthnRequest (..),
+    HasConfig (..),
+    HasCreateUUID (..),
+    HasLogger (..),
+    HasNow (..),
+    IdPId (..),
+    Issuer (..),
+    SPHandler (..),
+    SPStoreID (..),
+    SPStoreIdP (..),
+    UnqualifiedNameID (..),
+    explainDeniedReason,
+    fromTime,
+    idpExtraInfo,
+    idpId,
+    uidTenant,
+  )
 import qualified SAML2.WebSSO as SAML
 import Servant
 import qualified Servant.Multipart as Multipart
diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs
index d31bfecf97f..fcc1dc102cb 100644
--- a/services/spar/src/Spar/Data.hs
+++ b/services/spar/src/Spar/Data.hs
@@ -92,7 +92,6 @@ import Control.Monad.Except
 import Data.Id
 import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis)
 import qualified Data.List.NonEmpty as NL
-import Data.Misc ((<$$>))
 import Data.String.Conversions
 import Data.Time
 import Data.X509 (SignedCertificate)
diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs
index 3f22161a401..6685464cf07 100644
--- a/services/spar/src/Spar/Intra/Brig.hs
+++ b/services/spar/src/Spar/Intra/Brig.hs
@@ -68,7 +68,7 @@ import Data.ByteString.Conversion
 import Data.Handle (Handle (Handle, fromHandle))
 import Data.Id (Id (Id), TeamId, UserId)
 import Data.Ix
-import Data.Misc (PlainTextPassword, (<$$>))
+import Data.Misc (PlainTextPassword)
 import Data.String.Conversions
 import Data.String.Conversions (cs)
 import Imports
diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index e602db7f501..17f077dd9f3 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -54,7 +54,6 @@ import qualified Data.Aeson as Aeson
 import Data.Handle (Handle (Handle), parseHandle)
 import Data.Id (Id (Id), TeamId, UserId, idToText)
 import Data.Json.Util (UTCTimeMillis, fromUTCTimeMillis, toUTCTimeMillis)
-import Data.Misc ((<$$>))
 import Data.String.Conversions (cs)
 import qualified Data.Text as Text
 import qualified Data.UUID.V4 as UUID
diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs
index f0c7dc2f0ae..88738baaf84 100644
--- a/services/spar/test-integration/Test/Spar/APISpec.hs
+++ b/services/spar/test-integration/Test/Spar/APISpec.hs
@@ -42,7 +42,26 @@ import qualified Data.ZAuth.Token as ZAuth
 import qualified Galley.Types.Teams as Galley
 import Imports hiding (head)
 import Network.HTTP.Types (status200, status202)
-import SAML2.WebSSO as SAML
+import SAML2.WebSSO
+  ( AuthnResponse,
+    IdPId (..),
+    Issuer (..),
+    NameID,
+    SimpleSetCookie (..),
+    UserRef (..),
+    edCertAuthnResponse,
+    edIssuer,
+    edRequestURI,
+    getUserRef,
+    idPIdToST,
+    idpExtraInfo,
+    idpId,
+    idpMetadata,
+    mkNameID,
+    parseFromDocument,
+    (-/),
+  )
+import qualified SAML2.WebSSO as SAML
 import SAML2.WebSSO.Test.Lenses
 import SAML2.WebSSO.Test.MockResponse
 import SAML2.WebSSO.Test.Util

From 8daf2813f8eaff8c8e192404683c50e54b24a93f Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Wed, 23 Sep 2020 16:49:58 +0200
Subject: [PATCH 05/11] cargohold compat target for testing different S3-like
 buckets (#1210)

If testing against S3, minio, and others, this allows to run

```
cd services/cargohold
make compat-minio
make compat-s3
...
```

Requires a `compat` folder (currently symlinked to a private repository containing some credentials)
---
 services/cargohold/Makefile | 10 +++++++++
 services/cargohold/compat   |  1 +
 services/integration.sh     | 44 +++++++++++++++++++++++++++----------
 3 files changed, 43 insertions(+), 12 deletions(-)
 create mode 120000 services/cargohold/compat

diff --git a/services/cargohold/Makefile b/services/cargohold/Makefile
index da8a5caeb98..5e7bbf94cde 100644
--- a/services/cargohold/Makefile
+++ b/services/cargohold/Makefile
@@ -76,6 +76,16 @@ i-list:
 i-%:
 	../integration.sh $(EXE_IT) -s $(NAME).integration.yaml -i ../integration.yaml -p "$*" $(WIRE_INTEGRATION_TEST_OPTIONS)
 
+# Before using this target, create a symlink to a directory containing configurations to
+# test different S3-like buckets to see if cargohold can interact with them.
+#   ln -s /path/to/private/folder compat
+# If you have a folder compat/minio, run e.g.
+#   make compat-minio
+# Currently only the "simple" integration test group is run.
+.PHONY: compat-%
+compat-%:
+	INTEGRATION_CARGOHOLD_ONLY_COMPAT=1 CARGOHOLD_COMPAT_CONFIG_FOLDER=compat/$* ../integration.sh $(EXE_IT) -s compat/$*/cargohold.integration.yaml -i ../integration.yaml -p simple $(WIRE_INTEGRATION_TEST_OPTIONS)
+
 .PHONY: integration
 integration: fast i
 
diff --git a/services/cargohold/compat b/services/cargohold/compat
new file mode 120000
index 00000000000..3d87014545f
--- /dev/null
+++ b/services/cargohold/compat
@@ -0,0 +1 @@
+../../../cailleach/integration-test-configs
\ No newline at end of file
diff --git a/services/integration.sh b/services/integration.sh
index 7979bfe9d70..2c4e1eefc48 100755
--- a/services/integration.sh
+++ b/services/integration.sh
@@ -62,6 +62,14 @@ if [[ $INTEGRATION_USE_REAL_AWS -eq 1 ]]; then
     [ -z "$AWS_SECRET_ACCESS_KEY" ] && echo "Need to set AWS_SECRET_ACCESS_KEY in your environment" && exit 1;
     "${TOP_LEVEL}"/services/gen-aws-conf.sh
     integration_file_extension='-aws.yaml'
+elif [[ $INTEGRATION_CARGOHOLD_ONLY_COMPAT -eq 1 ]]; then
+    echo "Running tests using specific S3 buckets for cargohold using folder $CARGOHOLD_COMPAT_CONFIG_FOLDER"
+    if [ ! -f "${CARGOHOLD_COMPAT_CONFIG_FOLDER}/env.sh" ] \
+        && [ ! -f "${CARGOHOLD_COMPAT_CONFIG_FOLDER}/cargohold.integration.yaml" ]; then
+        echo 'expecting a CARGOHOLD_COMPAT_CONFIG_FOLDER/cargohold.integration.yaml and'
+        echo 'expecting a CARGOHOLD_COMPAT_CONFIG_FOLDER/env.sh'
+        exit 1;
+    fi
 else
     # brig,gundeck,galley use the amazonka library's 'Discover', which expects AWS credentials
     # even if those are not used/can be dummy values with the fake sqs/ses/etc containers used
@@ -77,6 +85,7 @@ function run() {
     service=$1
     instance=$2
     colour=$3
+    configfile=${4:-"${service}${instance}.integration${integration_file_extension}"}
     # Check if we're on a Mac
     if [[ "$OSTYPE" == "darwin"* ]]; then
         # Mac sed uses '-l' to set line-by-line buffering
@@ -88,21 +97,26 @@ function run() {
         echo -e "\n\nWARNING: log output is buffered and may not show on your screen!\n\n"
         UNBUFFERED=''
     fi
-    ( ( cd "${DIR}/${service}" && "${TOP_LEVEL}/dist/${service}" -c "${service}${instance}.integration${integration_file_extension}" ) || kill_all) \
+    ( ( cd "${DIR}/${service}" && "${TOP_LEVEL}/dist/${service}" -c "${configfile}" ) || kill_all) \
         | sed ${UNBUFFERED} -e "s/^/$(tput setaf ${colour})[${service}] /" -e "s/$/$(tput sgr0)/" &
 }
 
 
-check_prerequisites
-
-run brig "" ${green}
-run galley "" ${yellow}
-run gundeck "" ${blue}
-run cannon "" ${orange}
-run cannon "2" ${orange}
-run cargohold "" ${purpleish}
-run spar "" ${orange}
-run federator "" ${blue}
+if [[ $INTEGRATION_CARGOHOLD_ONLY_COMPAT -eq 1 ]]; then
+    source "${CARGOHOLD_COMPAT_CONFIG_FOLDER}/env.sh"
+    echo run cargohold "" ${purpleish} "${CARGOHOLD_COMPAT_CONFIG_FOLDER}/cargohold.integration.yaml"
+    run cargohold "" ${purpleish} "${CARGOHOLD_COMPAT_CONFIG_FOLDER}/cargohold.integration.yaml"
+else
+    check_prerequisites
+    run brig "" ${green}
+    run galley "" ${yellow}
+    run gundeck "" ${blue}
+    run cannon "" ${orange}
+    run cannon "2" ${orange}
+    run cargohold "" ${purpleish}
+    run spar "" ${orange}
+    run federator "" ${blue}
+fi
 
 function run_nginz() {
     colour=$1
@@ -132,9 +146,15 @@ if [[ $INTEGRATION_USE_NGINZ -eq 1 ]]; then
 fi
 
 # the ports are copied from ./integration.yaml
+if [[ $INTEGRATION_CARGOHOLD_ONLY_COMPAT -eq 1 ]]; then
+    PORT_LIST="8084"
+else
+    PORT_LIST="8082 8083 8084 8085 8086 8088 $NGINZ_PORT"
+fi
+
 while [ "$all_services_are_up" == "" ]; do
     export all_services_are_up="1"
-    for port in $(seq 8082 8086) 8088 $NGINZ_PORT; do
+    for port in $PORT_LIST; do
         ( curl --write-out '%{http_code}' --silent --output /dev/null http://localhost:"$port"/i/status \
                 | grep -q '^20[04]' ) \
             || export all_services_are_up=""

From c4f87a5e260faf5729bdb1b358d0b37b86d87d71 Mon Sep 17 00:00:00 2001
From: Tiago Manuel Ventura Loureiro <tiago.loureiro@gmail.com>
Date: Thu, 24 Sep 2020 20:51:57 +0200
Subject: [PATCH 06/11] Remove unused scim_user table (#1211)

* Remove unused scim_user table

* update cabal file.

* update cassandra dump.

* Fix test descriptions.

Co-authored-by: Matthias Fischmann <mf@zerobuzz.net>
---
 docs/reference/cassandra-schema.cql           | 39 ++++++++++++++-----
 services/spar/schema/src/Main.hs              |  4 +-
 services/spar/schema/src/V11.hs               | 33 ++++++++++++++++
 services/spar/spar.cabal                      |  3 +-
 services/spar/src/Spar/Data.hs                |  2 +-
 .../Test/Spar/Scim/UserSpec.hs                |  6 +--
 6 files changed, 71 insertions(+), 16 deletions(-)
 create mode 100644 services/spar/schema/src/V11.hs

diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql
index d9df270e54f..413d2a3d95a 100644
--- a/docs/reference/cassandra-schema.cql
+++ b/docs/reference/cassandra-schema.cql
@@ -1335,13 +1335,10 @@ CREATE TABLE brig_test.service_prefix (
 
 CREATE KEYSPACE spar_test WITH replication = {'class': 'SimpleStrategy', 'replication_factor': '1'}  AND durable_writes = true;
 
-CREATE TABLE spar_test.user (
-    issuer text,
-    sso_id text,
-    uid uuid,
-    PRIMARY KEY (issuer, sso_id)
-) WITH CLUSTERING ORDER BY (sso_id ASC)
-    AND bloom_filter_fp_chance = 0.1
+CREATE TABLE spar_test.scim_external_ids (
+    external text PRIMARY KEY,
+    user uuid
+) WITH bloom_filter_fp_chance = 0.1
     AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'}
     AND comment = ''
     AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'}
@@ -1598,9 +1595,10 @@ CREATE TABLE spar_test.team_provisioning_by_token (
     AND read_repair_chance = 0.0
     AND speculative_retry = '99PERCENTILE';
 
-CREATE TABLE spar_test.scim_user (
-    id uuid PRIMARY KEY,
-    json blob
+CREATE TABLE spar_test.scim_user_times (
+    uid uuid PRIMARY KEY,
+    created_at timestamp,
+    last_updated_at timestamp
 ) WITH bloom_filter_fp_chance = 0.1
     AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'}
     AND comment = ''
@@ -1616,3 +1614,24 @@ CREATE TABLE spar_test.scim_user (
     AND read_repair_chance = 0.0
     AND speculative_retry = '99PERCENTILE';
 
+CREATE TABLE spar_test.user (
+    issuer text,
+    sso_id text,
+    uid uuid,
+    PRIMARY KEY (issuer, sso_id)
+) WITH CLUSTERING ORDER BY (sso_id ASC)
+    AND bloom_filter_fp_chance = 0.1
+    AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'}
+    AND comment = ''
+    AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'}
+    AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'}
+    AND crc_check_chance = 1.0
+    AND dclocal_read_repair_chance = 0.1
+    AND default_time_to_live = 0
+    AND gc_grace_seconds = 864000
+    AND max_index_interval = 2048
+    AND memtable_flush_period_in_ms = 0
+    AND min_index_interval = 128
+    AND read_repair_chance = 0.0
+    AND speculative_retry = '99PERCENTILE';
+
diff --git a/services/spar/schema/src/Main.hs b/services/spar/schema/src/Main.hs
index 0cd5e61423e..f8586f9dee7 100644
--- a/services/spar/schema/src/Main.hs
+++ b/services/spar/schema/src/Main.hs
@@ -25,6 +25,7 @@ import Util.Options
 import qualified V0
 import qualified V1
 import qualified V10
+import qualified V11
 import qualified V2
 import qualified V3
 import qualified V4
@@ -53,7 +54,8 @@ main = do
       V7.migration,
       V8.migration,
       V9.migration,
-      V10.migration
+      V10.migration,
+      V11.migration
       -- When adding migrations here, don't forget to update
       -- 'schemaVersion' in Spar.Data
 
diff --git a/services/spar/schema/src/V11.hs b/services/spar/schema/src/V11.hs
new file mode 100644
index 00000000000..18f7a7488c1
--- /dev/null
+++ b/services/spar/schema/src/V11.hs
@@ -0,0 +1,33 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 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 V11
+  ( migration,
+  )
+where
+
+import Cassandra.Schema
+import Imports
+import Text.RawString.QQ
+
+migration :: Migration
+migration = Migration 11 "Remove unused table" $ do
+  void $
+    schema'
+      [r|
+        DROP TABLE scim_user;
+      |]
diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal
index bae725a5dd5..92b9befd6e0 100644
--- a/services/spar/spar.cabal
+++ b/services/spar/spar.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 88a250ccd05fb0ad0b42a8b133068a52e559f6b5e00efb0df3098445c92f2a45
+-- hash: 8a7b77bbc7e9d990ac78dd068fccb94f15521732eac4d3a2cc9bc44aa38c7e7f
 
 name:           spar
 version:        0.1
@@ -309,6 +309,7 @@ executable spar-schema
       V0
       V1
       V10
+      V11
       V2
       V3
       V4
diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs
index fcc1dc102cb..da6aac4b551 100644
--- a/services/spar/src/Spar/Data.hs
+++ b/services/spar/src/Spar/Data.hs
@@ -108,7 +108,7 @@ import Web.Scim.Schema.Meta (Meta (..), WithMeta (..))
 
 -- | A lower bound: @schemaVersion <= whatWeFoundOnCassandra@, not @==@.
 schemaVersion :: Int32
-schemaVersion = 10
+schemaVersion = 11
 
 ----------------------------------------------------------------------
 -- helpers
diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
index 28ef7e55134..0307d275a72 100644
--- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
@@ -839,7 +839,7 @@ testUserGetFailsWithNotFoundIfOutsideTeam = do
 specUpdateUser :: SpecWith TestEnv
 specUpdateUser = describe "PUT /Users/:id" $ do
   it "requires a user ID" $ testUpdateRequiresUserId
-  it "updates user attributes in scim_user" $ testScimSideIsUpdated
+  it "updates user attributes in brig" $ testScimSideIsUpdated
   it "works fine when neither name nor handle are changed" $ testUpdateSameHandle
   it "updates the 'SAML.UserRef' index in Spar" $ testUpdateExternalId True
   it "updates the 'Email' index in Brig" $ testUpdateExternalId False
@@ -848,7 +848,7 @@ specUpdateUser = describe "PUT /Users/:id" $ do
   it "cannot remove display name" $ testCannotRemoveDisplayName
   context "user is from different team" $ do
     it "fails to update user with 404" testUserUpdateFailsWithNotFoundIfOutsideTeam
-  context "scim_user has no entry with this id" $ do
+  context "user does not exist" $ do
     it "fails" $ pending
   it "does not update if nothing changed" $ testSameUpdateNoChange
   context "brig user is updated" $ do
@@ -1258,7 +1258,7 @@ specDeleteUser = do
       deleteUser_ (Just tok) Nothing (env ^. teSpar)
         !!! const 405 === statusCode
   describe "DELETE /Users/:id" $ do
-    it "should delete user from brig, spar.scim_user, spar.user" $ do
+    it "should delete user from brig, spar.scim_user_times, spar.user" $ do
       (tok, _) <- registerIdPAndScimToken
       user <- randomScimUser
       storedUser <- createUser tok user

From 86c59f9bfa7cc0f91dd5e4926d5c9c25b6256edb Mon Sep 17 00:00:00 2001
From: Tiago Manuel Ventura Loureiro <tiago.loureiro@gmail.com>
Date: Fri, 25 Sep 2020 13:10:46 +0200
Subject: [PATCH 07/11] Manage invited user by SCIM when SSO is enabled (#1207)

* Added failing test

* Haddocks.

* Fix: when looking for uref fails, try email.

* Fix name.

Co-authored-by: Matthias Fischmann <mf@zerobuzz.net>
---
 services/spar/src/Spar/Scim/User.hs           | 29 ++++--
 .../Test/Spar/Scim/UserSpec.hs                | 95 +++++++++++++------
 2 files changed, 87 insertions(+), 37 deletions(-)

diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs
index 17f077dd9f3..1ed04e002dd 100644
--- a/services/spar/src/Spar/Scim/User.hs
+++ b/services/spar/src/Spar/Scim/User.hs
@@ -36,7 +36,7 @@ module Spar.Scim.User
   ( validateScimUser',
     synthesizeScimUser,
     toScimStoredUser',
-    mkUserRef,
+    mkValidExternalId,
     scimFindUserByEmail,
   )
 where
@@ -203,7 +203,7 @@ validateScimUser' midp richInfoLimit user = do
       Scim.badRequest
         Scim.InvalidValue
         (Just "Setting user passwords is not supported for security reasons.")
-  veid <- mkUserRef midp (Scim.externalId user)
+  veid <- mkValidExternalId midp (Scim.externalId user)
   handl <- validateHandle . Text.toLower . Scim.userName $ user
   -- FUTUREWORK: 'Scim.userName' should be case insensitive; then the toLower here would
   -- be a little less brittle.
@@ -234,28 +234,28 @@ validateScimUser' midp richInfoLimit user = do
             }
       pure richInfo
 
--- | Given an 'externalId' and an 'IdP', construct a 'SAML.UserRef'.
+-- | Given an 'externalId' and an 'IdP', construct a 'ST.ValidExternalId'.
 --
 -- This is needed primarily in 'validateScimUser', but also in 'updateValidScimUser' to
 -- recover the 'SAML.UserRef' of the scim user before the update from the database.
-mkUserRef ::
+mkValidExternalId ::
   forall m.
   (MonadError Scim.ScimError m) =>
   Maybe IdP ->
   Maybe Text ->
   m ST.ValidExternalId
-mkUserRef _ Nothing = do
+mkValidExternalId _ Nothing = do
   throwError $
     Scim.badRequest
       Scim.InvalidValue
       (Just "externalId is required for SAML users")
-mkUserRef Nothing (Just extid) = do
+mkValidExternalId Nothing (Just extid) = do
   let err =
         Scim.badRequest
           Scim.InvalidValue
           (Just "externalId must be a valid email address or (if there is a SAML IdP) a valid SAML NameID")
   maybe (throwError err) (pure . ST.EmailOnly) $ parseEmail extid
-mkUserRef (Just idp) (Just extid) = do
+mkValidExternalId (Just idp) (Just extid) = do
   let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer
   subject <- validateSubject extid
   let uref = SAML.UserRef issuer subject
@@ -656,20 +656,31 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do
     Right veid -> lift $ synthesizeStoredUser brigUser veid
     Left _ -> Applicative.empty
 
+-- | Construct a 'ValidExternalid'.  If it an 'Email', find the non-SAML SCIM user in spar; if
+-- that fails, find the user by email in brig.  If it is a 'UserRef', find the SAML user.
+-- Return the result as a SCIM user.
+--
+-- Note the user won't get an entry in `spar.user`.  That will only happen on their first
+-- successful authentication with their SAML credentials.
 scimFindUserByEmail :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler Spar) (Scim.StoredUser ST.SparTag)
 scimFindUserByEmail mIdpConfig stiTeam email = do
-  veid <- mkUserRef mIdpConfig (pure email)
+  veid <- mkValidExternalId mIdpConfig (pure email)
   uid <- MaybeT . lift $ ST.runValidExternalId withUref withEmailOnly veid
   brigUser <- MaybeT . lift . Brig.getBrigUserAccount $ uid
   guard $ userTeam (accountUser brigUser) == Just stiTeam
   lift $ synthesizeStoredUser brigUser veid
   where
     withUref :: SAML.UserRef -> Spar (Maybe UserId)
-    withUref = wrapMonadClient . Data.getSAMLUser
+    withUref uref = do
+      wrapMonadClient (Data.getSAMLUser uref) >>= \case
+        Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref
+        Just uid -> pure (Just uid)
 
     withEmailOnly :: BT.Email -> Spar (Maybe UserId)
     withEmailOnly eml = maybe inbrig (pure . Just) =<< inspar
       where
+        -- FUTUREWORK: we could also always lookup brig, that's simpler and possibly faster,
+        -- and it never should be visible in spar, but not in brig.
         inspar, inbrig :: Spar (Maybe UserId)
         inspar = wrapMonadClient $ Data.lookupScimExternalId eml
         inbrig = userId . accountUser <$$> Brig.getBrigUserByEmail eml
diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
index 0307d275a72..b1d08c3e904 100644
--- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
+++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
@@ -564,10 +564,14 @@ specListUsers = describe "GET /Users" $ do
   it "lists all SCIM users in a team" $ testListProvisionedUsers
   context "1 SAML IdP" $ do
     it "finds a SCIM-provisioned user by userName or externalId" $ testFindProvisionedUser
-    it "finds a non-SCIM-provisioned user by userName or externalId" $ testFindNonProvisionedUser
+    it "finds a user autoprovisioned via saml by externalId via email" $ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO
+    it "finds a user invited via team settings by externalId via email" $ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO
+    it "finds a user invited via team settings by UserId" $ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId
   context "0 SAML IdP" $ do
     it "finds a SCIM-provisioned user by userName or externalId" $ testFindProvisionedUserNoIdP
-    it "finds a non-SCIM-provisioned user by userName or externalId" $ testFindNonProvisionedUserNoIdP
+    it "finds a non-SCIM-provisioned user by userName" $ testFindNonProvisionedUserNoIdP FindByHandle
+    it "finds a non-SCIM-provisioned user by externalId" $ testFindNonProvisionedUserNoIdP FindByExternalId
+    it "finds a non-SCIM-provisioned user by UserId" $ testFindNonProvisionedUserNoIdP GetByUserId
   it "doesn't list deleted users" $ testListNoDeletedUsers
   it "doesnt't find deleted users by userName or externalId" $ testFindNoDeletedUsers
   it "doesn't list users from other teams" $ testUserListFailsWithNotFoundIfOutsideTeam
@@ -594,33 +598,66 @@ testFindProvisionedUser = do
   users' <- listUsers tok (Just (filterBy "externalId" externalId))
   liftIO $ users' `shouldBe` [storedUser]
 
--- When explicitly filtering, we should be able to find non-SCIM-provisioned users
-testFindNonProvisionedUser :: HasCallStack => TestSpar ()
-testFindNonProvisionedUser = do
-  (_, teamid, idp, (_, privCreds)) <- registerTestIdPWithMeta
-  member <- loginSsoUserFirstTime idp privCreds
-  -- NOTE: once SCIM is enabled SSO Auto-provisioning is disabled
+-- The user is migrated by using the email as the externalId
+testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO :: TestSpar ()
+testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do
+  (_owner, teamid, idp, (_, privCreds)) <- registerTestIdPWithMeta
+
+  -- auto-provision user via saml
+  memberWithSSO <- do
+    uid <- loginSsoUserFirstTime idp privCreds
+    Just usr <- runSpar $ Intra.getBrigUser uid
+    handle <- nextHandle
+    runSpar $ Intra.setBrigUserHandle uid handle
+    pure usr
+  let memberIdWithSSO = userId memberWithSSO
+      externalId = either error id $ Intra.userToExternalId memberWithSSO
+
+  -- NOTE: once SCIM is enabled, SSO auto-provisioning is disabled
   tok <- registerScimToken teamid (Just (idp ^. SAML.idpId))
-  handle <- nextHandle
-  runSpar $ Intra.setBrigUserHandle member handle
-  Just brigUser <- runSpar $ Intra.getBrigUser member
-  liftIO $ userManagedBy brigUser `shouldBe` ManagedByWire
-  users <- listUsers tok (Just (filterBy "userName" (fromHandle handle)))
-  liftIO $ (scimUserId <$> users) `shouldContain` [member]
-  Just brigUser' <- runSpar $ Intra.getBrigUser member
+
+  liftIO $ userManagedBy memberWithSSO `shouldBe` ManagedByWire
+  users <- listUsers tok (Just (filterBy "externalId" externalId))
+  liftIO $ (scimUserId <$> users) `shouldContain` [memberIdWithSSO]
+  Just brigUser' <- runSpar $ Intra.getBrigUser memberIdWithSSO
   liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim
-  _ <- getUser tok member
-  let externalId = either error id $ Intra.userToExternalId brigUser'
-  users' <- listUsers tok (Just (filterBy "externalId" externalId))
-  liftIO $ (scimUserId <$> users') `shouldContain` [member]
+
+testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO :: TestSpar ()
+testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO = do
+  env <- ask
+  (tok, (owner, teamid, _idp)) <- registerIdPAndScimToken
+
+  memberInvited <- call (inviteAndRegisterUser (env ^. teBrig) owner teamid)
+  let emailInvited = maybe (error "must have email") fromEmail (userEmail memberInvited)
+      memberIdInvited = userId memberInvited
+
+  users' <- listUsers tok (Just (filterBy "externalId" emailInvited))
+  liftIO $ (scimUserId <$> users') `shouldContain` [memberIdInvited]
+  Just brigUserInvited' <- runSpar $ Intra.getBrigUser (memberIdInvited)
+  liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim
+
+testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId :: TestSpar ()
+testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId = do
+  env <- ask
+  (tok, (owner, teamid, _idp)) <- registerIdPAndScimToken
+
+  memberInvited <- call (inviteAndRegisterUser (env ^. teBrig) owner teamid)
+  let memberIdInvited = userId memberInvited
+
+  _ <- getUser tok memberIdInvited
+  Just brigUserInvited' <- runSpar $ Intra.getBrigUser (memberIdInvited)
+  liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim
 
 testFindProvisionedUserNoIdP :: TestSpar ()
 testFindProvisionedUserNoIdP = do
   -- covered in 'testCreateUserNoIdP' (as of Mon 31 Aug 2020 08:37:05 PM CEST)
   pure ()
 
-testFindNonProvisionedUserNoIdP :: TestSpar ()
-testFindNonProvisionedUserNoIdP = do
+data FindBy = FindByExternalId | FindByHandle | GetByUserId
+  deriving (Eq, Show)
+
+testFindNonProvisionedUserNoIdP :: FindBy -> TestSpar ()
+testFindNonProvisionedUserNoIdP findBy = do
   env <- ask
   (owner, teamid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley)
   tok <- registerScimToken teamid Nothing
@@ -636,11 +673,13 @@ testFindNonProvisionedUserNoIdP = do
     liftIO $ userManagedBy brigUser `shouldBe` ManagedByWire
     liftIO $ userEmail brigUser `shouldSatisfy` isJust
 
-  byHandle <- listUsers tok (Just (filterBy "userName" (fromHandle handle)))
-  byExternalId <- listUsers tok (Just (filterBy "externalId" (fromEmail email)))
+  users <- case findBy of
+    FindByExternalId -> scimUserId <$$> listUsers tok (Just (filterBy "externalId" (fromEmail email)))
+    FindByHandle -> scimUserId <$$> listUsers tok (Just (filterBy "userName" (fromHandle handle)))
+    GetByUserId -> (: []) . scimUserId <$> getUser tok uid
 
-  for_ [byHandle, byExternalId] $ \users -> do
-    liftIO $ (scimUserId <$> users) `shouldBe` [uid]
+  do
+    liftIO $ users `shouldBe` [uid]
     Just brigUser' <- runSpar $ Intra.getBrigUser uid
     liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim
     liftIO $ brigUser' `shouldBe` brigUser {userManagedBy = ManagedByScim}
@@ -1028,7 +1067,7 @@ testUpdateExternalId withidp = do
         storedUser <- createUser tok user
         let userid = scimUserId storedUser
         veid :: ValidExternalId <-
-          either (error . show) pure $ mkUserRef midp (Scim.User.externalId user)
+          either (error . show) pure $ mkValidExternalId midp (Scim.User.externalId user)
         -- Overwrite the user with another randomly-generated user (only controlling externalId)
         user' <- do
           otherEmail <- randomEmail
@@ -1040,7 +1079,7 @@ testUpdateExternalId withidp = do
                         else Scim.User.externalId user
                   }
           randomScimUser <&> upd
-        let veid' = either (error . show) id $ mkUserRef midp (Scim.User.externalId user')
+        let veid' = either (error . show) id $ mkValidExternalId midp (Scim.User.externalId user')
 
         _ <- updateUser tok userid user'
 
@@ -1387,7 +1426,7 @@ specEmailValidation = do
           scimStoredUser <- createUser tok user
           uref :: SAML.UserRef <-
             either (error . show) (pure . (^?! veidUref)) $
-              mkUserRef (Just idp) (Scim.User.externalId . Scim.value . Scim.thing $ scimStoredUser)
+              mkValidExternalId (Just idp) (Scim.User.externalId . Scim.value . Scim.thing $ scimStoredUser)
           uid :: UserId <-
             getUserIdViaRef uref
           brig <- asks (^. teBrig)

From fab4983c15666a4c441b049bfb629568111da2e8 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <akshay@wire.com>
Date: Mon, 28 Sep 2020 13:46:34 +0200
Subject: [PATCH 08/11] Upgrade GHC to 8.8.4 (#1204)

* Bump alpine to 3.12 for GHC

* Install GHC using ghcup

* Add ncurses-dev to prebuilder

* Parametrize builder image using the same way as others

* Upgrade to LTS 16.14, GHC 8.8.4

* Use upstream master branch of HaskelNet-SSL

* Use merge-request branch of wai-predicates

* Use merge-request branch of redis-io

* Upgrade saml2-web-sso to support GHC 8.8

* Upgrade our fork of bloodhound to support GHC 8.8

* Replace 'mapM' with 'sequence $ map ...' in bonanza tests

Bug report in GHC: https://gitlab.haskell.org/ghc/ghc/-/issues/18730

* Tidy up stack.yaml
---
 build/alpine/Dockerfile.builder               |   7 +-
 build/alpine/Dockerfile.deps                  |   4 +-
 build/alpine/Dockerfile.prebuilder            |  18 +-
 libs/api-bot/src/Network/Wire/Bot/Monad.hs    |   1 -
 libs/bilge/src/Bilge/Assert.hs                |   1 -
 libs/bilge/src/Bilge/IO.hs                    |   1 -
 libs/brig-types/src/Brig/Types/Instances.hs   |  16 +-
 .../brig-types/src/Brig/Types/Provider/Tag.hs |   1 -
 libs/extended/src/Servant/API/Extended.hs     |   2 -
 libs/galley-types/src/Galley/Types.hs         |   1 -
 libs/galley-types/src/Galley/Types/Teams.hs   |   1 -
 .../gundeck-types/src/Gundeck/Types/Common.hs |   2 +-
 libs/hscim/hscim.cabal                        |  22 +--
 libs/hscim/package.yaml                       |   6 +-
 .../src/Web/Scim/Capabilities/MetaSchema.hs   |   1 -
 libs/hscim/src/Web/Scim/Class/Group.hs        |   1 -
 libs/hscim/src/Web/Scim/Class/User.hs         |   1 -
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs     |   1 -
 libs/hscim/src/Web/Scim/Schema/User.hs        |   1 -
 libs/hscim/src/Web/Scim/Server.hs             |   1 -
 libs/hscim/src/Web/Scim/Test/Util.hs          |   2 +-
 libs/imports/src/Imports.hs                   |   1 -
 .../src/Data/Metrics/Middleware/Prometheus.hs |   2 -
 libs/ssl-util/src/Ssl/Util.hs                 |   1 -
 libs/tasty-cannon/src/Test/Tasty/Cannon.hs    |   2 +-
 libs/types-common-aws/src/Util/Test/SQS.hs    |   2 +-
 libs/types-common-journal/src/Data/Proto.hs   |   1 -
 libs/types-common/src/Data/Json/Util.hs       |   2 +-
 libs/types-common/src/Data/LegalHold.hs       |   4 +-
 libs/types-common/src/Data/List1.hs           |   2 +-
 libs/types-common/src/Data/Misc.hs            |  11 +-
 libs/types-common/src/Util/Options.hs         |   3 +-
 libs/wire-api/src/Wire/API/Call/Config.hs     |   2 +-
 .../src/Wire/API/Event/Conversation.hs        |   1 -
 libs/wire-api/src/Wire/API/Team/Permission.hs |   2 +-
 libs/wire-api/src/Wire/API/Team/Role.hs       |   4 +-
 libs/wire-api/src/Wire/API/User/RichInfo.hs   |   5 +-
 nix/overlays/wire-server.nix                  |  12 +-
 nix/sources.json                              |  14 +-
 services/brig/src/Brig/API/Error.hs           |   2 +-
 services/brig/src/Brig/API/Internal.hs        |   1 -
 services/brig/src/Brig/API/Public.hs          |   1 -
 services/brig/src/Brig/AWS.hs                 |   1 -
 services/brig/src/Brig/App.hs                 |   2 +-
 services/brig/src/Brig/Calling/API.hs         |   1 -
 services/brig/src/Brig/Code.hs                |   4 +-
 services/brig/src/Brig/Data/Instances.hs      |  48 ++---
 services/brig/src/Brig/Data/User.hs           |   1 -
 services/brig/src/Brig/Data/UserKey.hs        |   8 +-
 services/brig/src/Brig/Index/Migrations.hs    |   2 +-
 .../brig/src/Brig/Index/Migrations/Types.hs   |   1 -
 services/brig/src/Brig/Password.hs            |   2 +-
 services/brig/src/Brig/Phone.hs               |   1 -
 services/brig/src/Brig/Provider/DB.hs         |   1 -
 services/brig/src/Brig/RPC.hs                 |   2 +-
 services/brig/src/Brig/SMTP.hs                |   1 -
 .../brig/src/Brig/User/Auth/Cookie/Limit.hs   |   1 -
 .../brig/src/Brig/User/Auth/DB/Instances.hs   |   4 +-
 services/brig/src/Brig/User/Search/Index.hs   |   1 -
 services/brig/src/Brig/Whitelist.hs           |   2 +-
 services/brig/test/integration/API/Calling.hs |   2 -
 services/brig/test/integration/API/Search.hs  |   3 -
 services/brig/test/integration/API/Team.hs    |   2 -
 .../brig/test/integration/API/Team/Util.hs    |   1 -
 services/brig/test/integration/Util.hs        |   3 +-
 services/cannon/src/Cannon/API/Internal.hs    |   2 -
 services/cannon/src/Cannon/API/Public.hs      |   1 -
 services/cannon/src/Cannon/App.hs             |   2 +-
 .../cargohold/src/CargoHold/API/Public.hs     |   1 -
 services/federator/src/Federator/App.hs       |   2 +-
 services/galley/src/Galley/API/Error.hs       |   2 +-
 services/galley/src/Galley/Data.hs            |   1 -
 services/galley/src/Galley/Data/Instances.hs  |  32 ++--
 services/galley/src/Galley/Data/Types.hs      |   2 +-
 services/galley/src/Galley/External.hs        |   1 -
 services/galley/src/Galley/Intra/Client.hs    |   1 -
 services/galley/src/Galley/Intra/Push.hs      |   2 +-
 services/galley/src/Galley/Intra/User.hs      |   3 +-
 services/galley/test/integration/API/SQS.hs   |   2 +-
 .../test/integration/API/Teams/LegalHold.hs   |   3 +-
 services/galley/test/integration/API/Util.hs  |   3 +-
 services/galley/test/integration/TestSetup.hs |   1 -
 services/gundeck/src/Gundeck/API/Public.hs    |   1 -
 services/gundeck/src/Gundeck/Instances.hs     |  14 +-
 services/gundeck/src/Gundeck/Push.hs          |   1 -
 .../gundeck/src/Gundeck/Push/Native/Types.hs  |   1 -
 .../gundeck/src/Gundeck/Push/Websocket.hs     |   2 +-
 .../gundeck/src/Gundeck/Util/DelayQueue.hs    |   1 -
 services/gundeck/test/integration/API.hs      |   2 +-
 .../gundeck/test/integration/TestSetup.hs     |   1 -
 services/spar/src/Spar/App.hs                 |   1 -
 services/spar/src/Spar/Data/Instances.hs      |  12 +-
 services/spar/src/Spar/Intra/Brig.hs          |   1 -
 services/spar/src/Spar/Scim/Swagger.hs        |   2 +-
 services/spar/src/Spar/Types.hs               |   1 -
 .../test-integration/Test/Spar/AppSpec.hs     |   1 -
 .../test-integration/Test/Spar/DataSpec.hs    |   1 -
 services/spar/test-integration/Util/Core.hs   |   1 -
 services/spar/test-integration/Util/Scim.hs   |   1 -
 stack-deps.nix                                |   2 +-
 stack.yaml                                    |  53 +++---
 stack.yaml.lock                               | 173 +++++++++++-------
 tools/bonanza/bonanza.cabal                   |   7 +-
 tools/bonanza/package.yaml                    |   3 +-
 .../test/unit/Test/Bonanza/Arbitrary.hs       |  35 ++--
 tools/db/find-undead/src/Work.hs              |   4 +-
 tools/makedeb/src/System/MakeDeb.hs           |  12 +-
 tools/stern/src/Stern/API.hs                  |   5 +-
 tools/stern/src/Stern/API/Predicates.hs       |   1 -
 tools/stern/src/Stern/App.hs                  |   2 -
 tools/stern/src/Stern/Intra.hs                |   3 +-
 111 files changed, 329 insertions(+), 336 deletions(-)

diff --git a/build/alpine/Dockerfile.builder b/build/alpine/Dockerfile.builder
index 482e7aa42af..52203d7a58b 100644
--- a/build/alpine/Dockerfile.builder
+++ b/build/alpine/Dockerfile.builder
@@ -1,9 +1,7 @@
 # Requires docker >= 17.05 (requires support for multi-stage builds)
-
-ARG prebuilder_tag=latest
 ARG prebuilder=quay.io/wire/alpine-prebuilder
 
-FROM ${prebuilder}:${prebuilder_tag}
+FROM ${prebuilder}
 WORKDIR /
 
 # Download stack indices and compile/cache dependencies to speed up subsequent
@@ -13,6 +11,7 @@ WORKDIR /
 # a Haddock segfault. See https://github.com/haskell/haddock/issues/928
 
 ARG wire_server_branch=develop
+ARG THREADS=4
 RUN set -x && \
     echo ${wire_server_branch} && \
     git clone -b ${wire_server_branch} https://github.com/wireapp/wire-server.git && \
@@ -21,7 +20,7 @@ RUN set -x && \
     echo "allow-different-user: true" >> /root/.stack/config.yaml && \
     stack build --haddock --dependencies-only haskell-src-exts && \
     stack build --haddock --no-haddock-hyperlink-source haskell-src-exts && \
-    stack build --pedantic --haddock --test --no-run-tests --bench --no-run-benchmarks --dependencies-only && \
+    stack build --pedantic --haddock --test --no-run-tests --bench --no-run-benchmarks --dependencies-only -j${THREADS} && \
     stack install ormolu && \
     cd / && \
     # we run the build only to cache the built source in /root/.stack, we can remove the source code itself
diff --git a/build/alpine/Dockerfile.deps b/build/alpine/Dockerfile.deps
index 96e7804a3cc..212d8df510a 100644
--- a/build/alpine/Dockerfile.deps
+++ b/build/alpine/Dockerfile.deps
@@ -1,6 +1,6 @@
 # Requires docker >= 17.05 (requires support for multi-stage builds)
 
-FROM alpine:3.11 as cryptobox-builder
+FROM alpine:3.12 as cryptobox-builder
 
 # compile cryptobox-c
 RUN apk add --no-cache cargo file libsodium-dev git && \
@@ -11,7 +11,7 @@ RUN apk add --no-cache cargo file libsodium-dev git && \
     cargo build --release
 
 # Minimal dependencies for alpine-compiled, dynamically linked wire-server Haskell services
-FROM alpine:3.11
+FROM alpine:3.12
 
 COPY --from=cryptobox-builder /tmp/cryptobox-c/target/release/libcryptobox.so /usr/lib
 
diff --git a/build/alpine/Dockerfile.prebuilder b/build/alpine/Dockerfile.prebuilder
index d0a71453238..3f84e00a7a4 100644
--- a/build/alpine/Dockerfile.prebuilder
+++ b/build/alpine/Dockerfile.prebuilder
@@ -1,6 +1,6 @@
 # Requires docker >= 17.05 (requires support for multi-stage builds)
 
-FROM alpine:3.11 as cryptobox-builder
+FROM alpine:3.12 as cryptobox-builder
 
 # compile cryptobox-c
 RUN apk add --no-cache cargo file libsodium-dev git && \
@@ -10,7 +10,7 @@ RUN apk add --no-cache cargo file libsodium-dev git && \
     export SODIUM_USE_PKG_CONFIG=1 && \
     cargo build --release
 
-FROM alpine:3.11
+FROM alpine:3.12
 
 # install cryptobox-c in the new container
 COPY --from=cryptobox-builder /tmp/cryptobox-c/target/release/libcryptobox.so /usr/lib/libcryptobox.so
@@ -22,9 +22,10 @@ RUN apk add --no-cache \
         ca-certificates \
         linux-headers \
         zlib-dev \
-        ghc \
-        ghc-dev \
-        ghc-doc \
+        perl \
+        gmp-dev \
+        libffi-dev \
+        make \
         libsodium-dev \
         openssl-dev \
         protobuf \
@@ -37,6 +38,7 @@ RUN apk add --no-cache \
         libxml2-dev \
         git \
         ncurses \
+        ncurses-dev \
         sed
 
 # get static version of Haskell Stack and use system ghc by default
@@ -44,3 +46,9 @@ ARG STACK_ALPINE_VERSION=2.3.1
 RUN curl -sSfL https://github.com/commercialhaskell/stack/releases/download/v${STACK_ALPINE_VERSION}/stack-${STACK_ALPINE_VERSION}-linux-x86_64-static.tar.gz \
     | tar --wildcards -C /usr/local/bin --strip-components=1 -xzvf - '*/stack' && chmod 755 /usr/local/bin/stack && \
     stack config set system-ghc --global true
+
+ARG GHC_VERSION=8.8.4
+RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org \
+  | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_GHC_VERSION=${GHC_VERSION} sh
+
+ENV PATH=/root/.ghcup/bin:${PATH}
diff --git a/libs/api-bot/src/Network/Wire/Bot/Monad.hs b/libs/api-bot/src/Network/Wire/Bot/Monad.hs
index da01c668e79..d7fd11ea459 100644
--- a/libs/api-bot/src/Network/Wire/Bot/Monad.hs
+++ b/libs/api-bot/src/Network/Wire/Bot/Monad.hs
@@ -94,7 +94,6 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM (retry)
 import Control.Monad.Base
 import Control.Monad.Catch hiding (try)
-import Control.Monad.Fail (MonadFail)
 import Control.Monad.Trans.Control
 import qualified Data.HashMap.Strict as HashMap
 import Data.Id
diff --git a/libs/bilge/src/Bilge/Assert.hs b/libs/bilge/src/Bilge/Assert.hs
index 472117d11ff..670d20b19e5 100644
--- a/libs/bilge/src/Bilge/Assert.hs
+++ b/libs/bilge/src/Bilge/Assert.hs
@@ -38,7 +38,6 @@ import Control.Monad.Writer.Class
 import Control.Monad.Writer.Strict
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as Lazy
-import Data.List (intersperse, isInfixOf)
 import Imports
 import Network.HTTP.Client
 import System.Console.ANSI
diff --git a/libs/bilge/src/Bilge/IO.hs b/libs/bilge/src/Bilge/IO.hs
index 0a794cb2691..34aa87291b1 100644
--- a/libs/bilge/src/Bilge/IO.hs
+++ b/libs/bilge/src/Bilge/IO.hs
@@ -72,7 +72,6 @@ import Bilge.Request
 import Bilge.Response
 import Control.Monad.Base
 import Control.Monad.Catch
-import Control.Monad.Fail (MonadFail)
 import Control.Monad.Trans.Control
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.ByteString.Lazy as Lazy
diff --git a/libs/brig-types/src/Brig/Types/Instances.hs b/libs/brig-types/src/Brig/Types/Instances.hs
index f4422aac93a..9e280ad5888 100644
--- a/libs/brig-types/src/Brig/Types/Instances.hs
+++ b/libs/brig-types/src/Brig/Types/Instances.hs
@@ -33,15 +33,15 @@ instance Cql PrekeyId where
   ctype = Tagged IntColumn
   toCql = CqlInt . fromIntegral . keyId
   fromCql (CqlInt i) = return $ PrekeyId (fromIntegral i)
-  fromCql _ = fail "PrekeyId: Int expected"
+  fromCql _ = Left "PrekeyId: Int expected"
 
 instance Cql ServiceTag where
   ctype = Tagged BigIntColumn
 
   fromCql (CqlBigInt i) = case intToTag i of
     Just t -> return t
-    Nothing -> fail $ "unexpected service tag: " ++ show i
-  fromCql _ = fail "service tag: int expected"
+    Nothing -> Left $ "unexpected service tag: " ++ show i
+  fromCql _ = Left "service tag: int expected"
 
   toCql = CqlBigInt . tagToInt
 
@@ -50,10 +50,10 @@ instance Cql ServiceKeyPEM where
 
   fromCql (CqlBlob b) =
     maybe
-      (fail "service key pem: malformed key")
+      (Left "service key pem: malformed key")
       pure
       (fromByteString' b)
-  fromCql _ = fail "service key pem: blob expected"
+  fromCql _ = Left "service key pem: blob expected"
 
   toCql = CqlBlob . toByteString
 
@@ -74,15 +74,15 @@ instance Cql ServiceKey where
     p <- required "pem"
     case (t :: Int32) of
       0 -> return $! ServiceKey RsaServiceKey s p
-      _ -> fail $ "Unexpected service key type: " ++ show t
+      _ -> Left $ "Unexpected service key type: " ++ show t
     where
       required :: Cql r => Text -> Either String r
       required f =
         maybe
-          (fail ("ServiceKey: Missing required field '" ++ show f ++ "'"))
+          (Left ("ServiceKey: Missing required field '" ++ show f ++ "'"))
           fromCql
           (lookup f fs)
-  fromCql _ = fail "service key: udt expected"
+  fromCql _ = Left "service key: udt expected"
 
   toCql (ServiceKey RsaServiceKey siz pem) =
     CqlUdt
diff --git a/libs/brig-types/src/Brig/Types/Provider/Tag.hs b/libs/brig-types/src/Brig/Types/Provider/Tag.hs
index 12ca5cf3546..f8f351bd5cf 100644
--- a/libs/brig-types/src/Brig/Types/Provider/Tag.hs
+++ b/libs/brig-types/src/Brig/Types/Provider/Tag.hs
@@ -48,7 +48,6 @@ where
 
 import Cassandra.CQL (Cql)
 import Data.Bits
-import Data.List (foldl')
 import Data.Range
 import qualified Data.Set as Set
 import Imports
diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs
index 5122f4f737f..a4801626d7d 100644
--- a/libs/extended/src/Servant/API/Extended.hs
+++ b/libs/extended/src/Servant/API/Extended.hs
@@ -21,10 +21,8 @@
 -- errors instead of plaintext.
 module Servant.API.Extended where
 
-import Control.Monad.Trans (liftIO)
 import qualified Data.ByteString.Lazy as BL
 import Data.EitherR (fmapL)
-import Data.Maybe (fromMaybe)
 import Data.String.Conversions (cs)
 import Data.Typeable
 import GHC.TypeLits
diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs
index c3804604311..8b1dd5cd0db 100644
--- a/libs/galley-types/src/Galley/Types.hs
+++ b/libs/galley-types/src/Galley/Types.hs
@@ -85,7 +85,6 @@ import Wire.API.Conversation.Typing
 import Wire.API.CustomBackend
 import Wire.API.Event.Conversation
 import Wire.API.Message
-import Wire.API.User (UserIdList (..))
 import Wire.API.User.Client
 
 --------------------------------------------------------------------------------
diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs
index 7aba8945405..7d77246b7f0 100644
--- a/libs/galley-types/src/Galley/Types/Teams.hs
+++ b/libs/galley-types/src/Galley/Types/Teams.hs
@@ -138,7 +138,6 @@ import Data.String.Conversions (cs)
 import Imports
 import Wire.API.Event.Team
 import Wire.API.Team
-import Wire.API.Team (NewTeam (..), Team (..), TeamBinding (..))
 import Wire.API.Team.Conversation
 import Wire.API.Team.Feature
 import Wire.API.Team.Member
diff --git a/libs/gundeck-types/src/Gundeck/Types/Common.hs b/libs/gundeck-types/src/Gundeck/Types/Common.hs
index e49931dbe84..15b7a511066 100644
--- a/libs/gundeck-types/src/Gundeck/Types/Common.hs
+++ b/libs/gundeck-types/src/Gundeck/Types/Common.hs
@@ -57,5 +57,5 @@ instance ToByteString URI where
 instance FromByteString URI where
   parser = takeByteString >>= parse . Bytes.unpack
 
-parse :: Monad m => String -> m URI
+parse :: (Monad m, MonadFail m) => String -> m URI
 parse = maybe (fail "Invalid URI") (return . URI) . Net.parseURI
diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index 95d263a3692..94b6e1dc31c 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.31.2.
+-- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1b9add2104b5ee4d50f0d991824c3a07c5c0816d995bb90e64c48ce47717d7c5
+-- hash: 6f50966a204628956d641ded5887d6d680439edc24085d2d5a39ffaa42bb9f48
 
 name:           hscim
 version:        0.3.4
@@ -72,7 +72,7 @@ library
       aeson >=1.4.5 && <1.5
     , aeson-qq >=0.8.2 && <0.9
     , attoparsec >=0.13.2 && <0.14
-    , base >=4.12 && <4.13
+    , base >=4.12 && <4.14
     , bytestring >=0.10.8 && <0.11
     , email-validate >=2.3.2 && <2.4
     , errors >=2.3.0 && <2.4
@@ -97,9 +97,9 @@ library
     , stm >=2.5.0 && <2.6
     , stm-containers >=1.1.0 && <1.2
     , string-conversions >=0.4.0 && <0.5
-    , template-haskell >=2.14.0 && <2.15
+    , template-haskell >=2.14.0 && <2.16
     , text >=1.2.3 && <1.3
-    , time >=1.8.0 && <1.9
+    , time >=1.8.0 && <1.10
     , unordered-containers >=0.2.10 && <0.3
     , uuid >=1.3.13 && <1.4
     , vector >=0.12.0 && <0.13
@@ -121,7 +121,7 @@ executable hscim-server
       aeson >=1.4.5 && <1.5
     , aeson-qq >=0.8.2 && <0.9
     , attoparsec >=0.13.2 && <0.14
-    , base >=4.12 && <4.13
+    , base >=4.12 && <4.14
     , bytestring >=0.10.8 && <0.11
     , email-validate >=2.3.2 && <2.4
     , errors >=2.3.0 && <2.4
@@ -147,9 +147,9 @@ executable hscim-server
     , stm >=2.5.0 && <2.6
     , stm-containers >=1.1.0 && <1.2
     , string-conversions >=0.4.0 && <0.5
-    , template-haskell >=2.14.0 && <2.15
+    , template-haskell >=2.14.0 && <2.16
     , text >=1.2.3 && <1.3
-    , time >=1.8.0 && <1.9
+    , time >=1.8.0 && <1.10
     , unordered-containers >=0.2.10 && <0.3
     , uuid >=1.3.13 && <1.4
     , vector >=0.12.0 && <0.13
@@ -183,7 +183,7 @@ test-suite spec
       aeson >=1.4.5 && <1.5
     , aeson-qq >=0.8.2 && <0.9
     , attoparsec >=0.13.2 && <0.14
-    , base >=4.12 && <4.13
+    , base >=4.12 && <4.14
     , bytestring >=0.10.8 && <0.11
     , email-validate >=2.3.2 && <2.4
     , errors >=2.3.0 && <2.4
@@ -209,9 +209,9 @@ test-suite spec
     , stm >=2.5.0 && <2.6
     , stm-containers >=1.1.0 && <1.2
     , string-conversions >=0.4.0 && <0.5
-    , template-haskell >=2.14.0 && <2.15
+    , template-haskell >=2.14.0 && <2.16
     , text >=1.2.3 && <1.3
-    , time >=1.8.0 && <1.9
+    , time >=1.8.0 && <1.10
     , unordered-containers >=0.2.10 && <0.3
     , uuid >=1.3.13 && <1.4
     , vector >=0.12.0 && <0.13
diff --git a/libs/hscim/package.yaml b/libs/hscim/package.yaml
index 1afdc336b6d..af12cfd2281 100644
--- a/libs/hscim/package.yaml
+++ b/libs/hscim/package.yaml
@@ -38,12 +38,12 @@ dependencies:
   -  aeson                >= 1.4.5 && < 1.5
   -  attoparsec           >= 0.13.2 && < 0.14
   -  bytestring           >= 0.10.8 && < 0.11
-  -  base                 >= 4.12  && < 4.13
+  -  base                 >= 4.12  && < 4.14
   -  scientific           >= 0.3.6 && < 0.4
   -  hashable             >= 1.2.7 && < 1.4
   -  text                 >= 1.2.3 && < 1.3
-  -  time                 >= 1.8.0 && < 1.9
-  -  template-haskell     >= 2.14.0 && < 2.15
+  -  time                 >= 1.8.0 && < 1.10
+  -  template-haskell     >= 2.14.0 && < 2.16
   -  unordered-containers >= 0.2.10 && < 0.3
   -  vector               >= 0.12.0 && < 0.13
   -  aeson-qq             >= 0.8.2 && < 0.9
diff --git a/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs b/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs
index 42dafbb8731..9549982c371 100644
--- a/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs
+++ b/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs
@@ -29,7 +29,6 @@ where
 import Data.Aeson
 import qualified Data.HashMap.Lazy as HML
 import Data.Text (Text)
-import GHC.Generics (Generic)
 import Servant hiding (URI)
 import Servant.API.Generic
 import Servant.Server.Generic
diff --git a/libs/hscim/src/Web/Scim/Class/Group.hs b/libs/hscim/src/Web/Scim/Class/Group.hs
index e206d4b0cd0..6643fc30112 100644
--- a/libs/hscim/src/Web/Scim/Class/Group.hs
+++ b/libs/hscim/src/Web/Scim/Class/Group.hs
@@ -31,7 +31,6 @@ where
 import Data.Aeson
 import qualified Data.Aeson as Aeson
 import Data.Text
-import GHC.Generics (Generic)
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic
diff --git a/libs/hscim/src/Web/Scim/Class/User.hs b/libs/hscim/src/Web/Scim/Class/User.hs
index 1e8e5932f8b..d65ad0cecd5 100644
--- a/libs/hscim/src/Web/Scim/Class/User.hs
+++ b/libs/hscim/src/Web/Scim/Class/User.hs
@@ -27,7 +27,6 @@ module Web.Scim.Class.User
 where
 
 import Data.Aeson.Types (FromJSON)
-import GHC.Generics (Generic)
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic
diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index b44fe9f7a30..66ddf7c2bb0 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -18,7 +18,6 @@
 module Web.Scim.Schema.PatchOp where
 
 import Control.Applicative
-import Control.Monad (guard)
 import Control.Monad.Except
 import Data.Aeson.Types (FromJSON (parseJSON), ToJSON (toJSON), Value (String), object, withObject, withText, (.:), (.:?), (.=))
 import qualified Data.Aeson.Types as Aeson
diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs
index c16aa8709d5..f83b261f0ac 100644
--- a/libs/hscim/src/Web/Scim/Schema/User.hs
+++ b/libs/hscim/src/Web/Scim/Schema/User.hs
@@ -72,7 +72,6 @@ module Web.Scim.Schema.User
   )
 where
 
-import Control.Monad (foldM)
 import Control.Monad.Except
 import Data.Aeson
 import qualified Data.HashMap.Strict as HM
diff --git a/libs/hscim/src/Web/Scim/Server.hs b/libs/hscim/src/Web/Scim/Server.hs
index 7e4b866bffc..cc726506ca9 100644
--- a/libs/hscim/src/Web/Scim/Server.hs
+++ b/libs/hscim/src/Web/Scim/Server.hs
@@ -37,7 +37,6 @@ module Web.Scim.Server
   )
 where
 
-import GHC.Generics (Generic)
 import Network.Wai
 import Servant
 import Servant.API.Generic
diff --git a/libs/hscim/src/Web/Scim/Test/Util.hs b/libs/hscim/src/Web/Scim/Test/Util.hs
index 38feba2a0ef..ee77c1f6029 100644
--- a/libs/hscim/src/Web/Scim/Test/Util.hs
+++ b/libs/hscim/src/Web/Scim/Test/Util.hs
@@ -52,8 +52,8 @@ where
 
 import qualified Control.Retry as Retry
 import Data.Aeson
-import Data.Aeson.Internal (JSONPathElement (Key), (<?>))
 import Data.Aeson.QQ
+import Data.Aeson.Types (JSONPathElement (Key))
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS8
diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs
index 961a96519da..05eed16c996 100644
--- a/libs/imports/src/Imports.hs
+++ b/libs/imports/src/Imports.hs
@@ -168,7 +168,6 @@ import Data.Text (Text)
 import qualified Data.Text.Lazy
 import Data.Traversable
 import Data.Tuple
-import Data.Typeable (Typeable)
 import Data.Void
 import Data.Word
 import GHC.Generics (Generic)
diff --git a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs
index b35e502da28..b04c99d11c0 100644
--- a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs
+++ b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs
@@ -20,10 +20,8 @@ module Data.Metrics.Middleware.Prometheus
   )
 where
 
-import Data.Maybe (fromMaybe)
 import Data.Metrics.Types (Paths, treeLookup)
 import Data.Metrics.WaiRoute (treeToPaths)
-import Data.Text (Text)
 import qualified Data.Text.Encoding as T
 import Imports
 import qualified Network.Wai as Wai
diff --git a/libs/ssl-util/src/Ssl/Util.hs b/libs/ssl-util/src/Ssl/Util.hs
index ef4285e070d..40aa869b657 100644
--- a/libs/ssl-util/src/Ssl/Util.hs
+++ b/libs/ssl-util/src/Ssl/Util.hs
@@ -39,7 +39,6 @@ import Data.Byteable (constEqBytes)
 import Data.Dynamic (fromDynamic)
 import Data.Time.Clock (getCurrentTime)
 import Imports
-import Network.HTTP.Client (defaultRequest)
 import Network.HTTP.Client.Internal
 import OpenSSL.BN (integerToMPI)
 import OpenSSL.EVP.Digest (Digest, digestLBS)
diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs
index 368c8a8386c..66be04fbf21 100644
--- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs
+++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs
@@ -65,7 +65,7 @@ where
 
 import Control.Concurrent.Async
 import Control.Concurrent.Timeout hiding (threadDelay)
-import Control.Exception (SomeAsyncException, asyncExceptionFromException, throwIO)
+import Control.Exception (asyncExceptionFromException, throwIO)
 import Control.Monad.Catch hiding (bracket)
 import qualified Control.Monad.Catch as Catch
 import Data.Aeson (FromJSON, Value (..), decodeStrict', fromJSON)
diff --git a/libs/types-common-aws/src/Util/Test/SQS.hs b/libs/types-common-aws/src/Util/Test/SQS.hs
index dddaa98d67d..d19edb7ac97 100644
--- a/libs/types-common-aws/src/Util/Test/SQS.hs
+++ b/libs/types-common-aws/src/Util/Test/SQS.hs
@@ -25,7 +25,7 @@
 
 module Util.Test.SQS where
 
-import Control.Exception (SomeAsyncException, asyncExceptionFromException)
+import Control.Exception (asyncExceptionFromException)
 import Control.Lens hiding ((.=))
 import Control.Monad.Catch hiding (bracket)
 import Control.Monad.Trans.Control
diff --git a/libs/types-common-journal/src/Data/Proto.hs b/libs/types-common-journal/src/Data/Proto.hs
index 2bcebc6ed4b..b3445805dd0 100644
--- a/libs/types-common-journal/src/Data/Proto.hs
+++ b/libs/types-common-journal/src/Data/Proto.hs
@@ -17,7 +17,6 @@
 
 module Data.Proto where
 
-import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.POSIX
 import Imports
 
diff --git a/libs/types-common/src/Data/Json/Util.hs b/libs/types-common/src/Data/Json/Util.hs
index b2479a4e48b..03b79cfbed8 100644
--- a/libs/types-common/src/Data/Json/Util.hs
+++ b/libs/types-common/src/Data/Json/Util.hs
@@ -151,7 +151,7 @@ instance FromJSON Base64ByteString where
       stToLbs = L.fromChunks . pure . Data.Text.Encoding.encodeUtf8
       handleError =
         either
-          (fail "parse Base64ByteString: invalid base64 encoding")
+          (const $ fail "parse Base64ByteString: invalid base64 encoding")
           (pure . Base64ByteString)
   parseJSON _ = fail "parse Base64ByteString: not a string"
 
diff --git a/libs/types-common/src/Data/LegalHold.hs b/libs/types-common/src/Data/LegalHold.hs
index 4a866805bf7..1839ebf179b 100644
--- a/libs/types-common/src/Data/LegalHold.hs
+++ b/libs/types-common/src/Data/LegalHold.hs
@@ -58,8 +58,8 @@ instance Cql UserLegalHoldStatus where
     0 -> pure $ UserLegalHoldDisabled
     1 -> pure $ UserLegalHoldPending
     2 -> pure $ UserLegalHoldEnabled
-    _ -> fail "fromCql: Invalid UserLegalHoldStatus"
-  fromCql _ = fail "fromCql: UserLegalHoldStatus: CqlInt expected"
+    _ -> Left "fromCql: Invalid UserLegalHoldStatus"
+  fromCql _ = Left "fromCql: UserLegalHoldStatus: CqlInt expected"
 
   toCql UserLegalHoldDisabled = CqlInt 0
   toCql UserLegalHoldPending = CqlInt 1
diff --git a/libs/types-common/src/Data/List1.hs b/libs/types-common/src/Data/List1.hs
index 9426491fb00..3cefeaa6aa0 100644
--- a/libs/types-common/src/Data/List1.hs
+++ b/libs/types-common/src/Data/List1.hs
@@ -77,6 +77,6 @@ instance (Cql a) => Cql (List1 a) where
 
   toCql = CqlList . map toCql . toList
 
-  fromCql (CqlList []) = fail "At least 1 element in list required."
+  fromCql (CqlList []) = Left "At least 1 element in list required."
   fromCql (CqlList l) = List1 . N.fromList <$> mapM fromCql l
   fromCql _ = Left "Expected CqlList."
diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs
index bbe736b3950..3a0b6106445 100644
--- a/libs/types-common/src/Data/Misc.hs
+++ b/libs/types-common/src/Data/Misc.hs
@@ -67,7 +67,6 @@ import Data.ByteString.Char8 (unpack)
 import Data.ByteString.Conversion
 import Data.ByteString.Lazy (toStrict)
 import Data.IP (IP (IPv4, IPv6), toIPv4, toIPv6b)
-import Data.Int (Int64)
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.Text as Text
@@ -187,7 +186,7 @@ instance Cql Latitude where
   toCql (Latitude x) = CqlDouble x
 
   fromCql (CqlDouble x) = return (Latitude x)
-  fromCql _ = fail "Latitude: Expected CqlDouble."
+  fromCql _ = Left "Latitude: Expected CqlDouble."
 
 instance Cql Longitude where
   ctype = Tagged DoubleColumn
@@ -195,7 +194,7 @@ instance Cql Longitude where
   toCql (Longitude x) = CqlDouble x
 
   fromCql (CqlDouble x) = return (Longitude x)
-  fromCql _ = fail "Longitude: Expected CqlDouble."
+  fromCql _ = Left "Longitude: Expected CqlDouble."
 
 --------------------------------------------------------------------------------
 -- Time
@@ -225,7 +224,7 @@ instance Cql Milliseconds where
   toCql = CqlBigInt . msToInt64
   fromCql = \case
     CqlBigInt i -> pure $ int64ToMs i
-    _ -> fail "Milliseconds: expected CqlBigInt"
+    _ -> Left "Milliseconds: expected CqlBigInt"
 
 --------------------------------------------------------------------------------
 -- HttpsUrl
@@ -266,7 +265,7 @@ instance Cql HttpsUrl where
   toCql = CqlBlob . toByteString
 
   fromCql (CqlBlob t) = runParser parser (toStrict t)
-  fromCql _ = fail "HttpsUrl: Expected CqlBlob"
+  fromCql _ = Left "HttpsUrl: Expected CqlBlob"
 
 instance Arbitrary HttpsUrl where
   arbitrary = pure $ HttpsUrl [URI.QQ.uri|https://example.com|]
@@ -296,7 +295,7 @@ instance Cql (Fingerprint a) where
   toCql = CqlBlob . toByteString
 
   fromCql (CqlBlob b) = return (Fingerprint (toStrict b))
-  fromCql _ = fail "Fingerprint: Expected CqlBlob"
+  fromCql _ = Left "Fingerprint: Expected CqlBlob"
 
 instance Arbitrary (Fingerprint Rsa) where
   arbitrary =
diff --git a/libs/types-common/src/Util/Options.hs b/libs/types-common/src/Util/Options.hs
index bcf8d315e60..33313e9a5ce 100644
--- a/libs/types-common/src/Util/Options.hs
+++ b/libs/types-common/src/Util/Options.hs
@@ -23,7 +23,6 @@
 module Util.Options where
 
 import Control.Lens
-import Data.Aeson (FromJSON)
 import Data.Aeson.TH
 import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Conversion
@@ -33,7 +32,7 @@ import Imports
 import Options.Applicative
 import Options.Applicative.Types
 import System.Exit (die)
-import System.IO (hPutStrLn, stderr)
+import System.IO (hPutStrLn)
 import URI.ByteString
 import Util.Options.Common
 
diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs
index e7ccbcd6f5e..9fca13243f0 100644
--- a/libs/wire-api/src/Wire/API/Call/Config.hs
+++ b/libs/wire-api/src/Wire/API/Call/Config.hs
@@ -253,7 +253,7 @@ parseTurnURI = parseOnly (parser <* endOfInput)
     parseScheme = parse "parseScheme"
     parseHost = parse "parseHost"
     parseTransport = parse "parseTransport"
-    parse :: (BC.FromByteString b, Monad m) => String -> Text -> m b
+    parse :: (BC.FromByteString b, Monad m, MonadFail m) => String -> Text -> m b
     parse err x = case BC.fromByteString (TE.encodeUtf8 x) of
       Just ok -> return ok
       Nothing -> fail (err ++ " failed when parsing: " ++ show x)
diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs
index 491c640b001..e3c7086bb03 100644
--- a/libs/wire-api/src/Wire/API/Event/Conversation.hs
+++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs
@@ -75,7 +75,6 @@ import qualified Test.QuickCheck as QC
 import URI.ByteString ()
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
 import Wire.API.Conversation
-import Wire.API.Conversation (modelConversationAccessUpdate, modelConversationMessageTimerUpdate, modelConversationReceiptModeUpdate, modelConversationUpdateName)
 import Wire.API.Conversation.Code (ConversationCode (..), modelConversationCode)
 import Wire.API.Conversation.Role
 import Wire.API.Conversation.Typing (TypingData (..), modelTyping)
diff --git a/libs/wire-api/src/Wire/API/Team/Permission.hs b/libs/wire-api/src/Wire/API/Team/Permission.hs
index 4c3e023a7d6..97533cdeb5c 100644
--- a/libs/wire-api/src/Wire/API/Team/Permission.hs
+++ b/libs/wire-api/src/Wire/API/Team/Permission.hs
@@ -202,4 +202,4 @@ instance Cql.Cql Permissions where
     d <- Err.note "missing 'copy' permissions" ("copy" `lookup` p) >>= Cql.fromCql
     r <- Err.note "invalid permissions" (newPermissions (f s) (f d))
     pure r
-  fromCql _ = fail "permissions: udt expected"
+  fromCql _ = Left "permissions: udt expected"
diff --git a/libs/wire-api/src/Wire/API/Team/Role.hs b/libs/wire-api/src/Wire/API/Team/Role.hs
index d7fdef5e490..9b6e0f43226 100644
--- a/libs/wire-api/src/Wire/API/Team/Role.hs
+++ b/libs/wire-api/src/Wire/API/Team/Role.hs
@@ -122,5 +122,5 @@ instance Cql.Cql Role where
     2 -> return RoleAdmin
     3 -> return RoleMember
     4 -> return RoleExternalPartner
-    n -> fail $ "Unexpected Role value: " ++ show n
-  fromCql _ = fail "Role value: int expected"
+    n -> Left $ "Unexpected Role value: " ++ show n
+  fromCql _ = Left "Role value: int expected"
diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs
index 91e1a589c81..dfa65cce8e7 100644
--- a/libs/wire-api/src/Wire/API/User/RichInfo.hs
+++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs
@@ -45,7 +45,6 @@ module Wire.API.User.RichInfo
   )
 where
 
-import Control.Monad.Fail (MonadFail)
 import Data.Aeson
 import qualified Data.Aeson.Types as Aeson
 import Data.CaseInsensitive (CI)
@@ -53,7 +52,7 @@ import qualified Data.CaseInsensitive as CI
 import qualified Data.HashMap.Strict as HM
 import qualified Data.HashMap.Strict as HashMap
 import Data.Hashable (Hashable)
-import Data.List.Extra (nubOn)
+import Data.List.Extra (nubOrdOn)
 import qualified Data.Map as Map
 import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.Text as Text
@@ -237,7 +236,7 @@ richInfoAssocListFromObject richinfoObj = do
         ds -> fail ("duplicate fields: " <> show (map head ds))
 
 instance Arbitrary RichInfoAssocList where
-  arbitrary = RichInfoAssocList <$> nubOn richFieldType <$> arbitrary
+  arbitrary = RichInfoAssocList <$> nubOrdOn richFieldType <$> arbitrary
 
 emptyRichInfoAssocList :: RichInfoAssocList
 emptyRichInfoAssocList = RichInfoAssocList []
diff --git a/nix/overlays/wire-server.nix b/nix/overlays/wire-server.nix
index 9b1a1e5a983..aeefaa46ffc 100644
--- a/nix/overlays/wire-server.nix
+++ b/nix/overlays/wire-server.nix
@@ -5,14 +5,15 @@ self: super: {
       rustPlatform.buildRustPackage rec {
         name = "cryptobox-c-${version}";
         version = "2019-06-17";
-        buildInputs = [ pkgconfig libsodium ];
+        nativeBuildInputs = [ pkgconfig ];
+        buildInputs = [ libsodium ];
         src = fetchFromGitHub {
           owner = "wireapp";
           repo = "cryptobox-c";
           rev = "4067ad96b125942545dbdec8c1a89f1e1b65d013";
           sha256 = "1i9dlhw0xk1viglyhail9fb36v1awrypps8jmhrkz8k1bhx98ci3";
         };
-        cargoSha256 = "0m85c49hvvxxv7jdipfcaydy4n8iw4h6myzv63v7qc0fxnp1vfm8";
+        cargoSha256 = "0zs8ibv7rinrrzp9naxd7yak7kn1gp3pjb3g8i4wf7xw2hkkq81z";
         postInstall = ''
           mkdir -p $out/include
           cp src/cbox.h $out/include
@@ -25,11 +26,12 @@ self: super: {
       rustPlatform.buildRustPackage rec {
         name = "libzauth-${version}";
         version = "3.0.0";
-        buildInputs = [ libsodium pkgconfig ];
+        nativeBuildInputs = [ pkgconfig ];
+        buildInputs = [ libsodium ];
         src = self.nix-gitignore.gitignoreSourcePure [ ../../.gitignore ] ../../libs/libzauth;
         sourceRoot = "libzauth/libzauth-c";
 
-        cargoSha256 = "01yj1rchqmjnpj5cb9wl7vdzrycjwjhm60xh1jghw02n8jhl51p2"; # self.lib.fakeSha256;
+        cargoSha256 = "10ijvi3rnnqpy589hhhp8s4p7xfpsbb1c3mzqnf65ra96q4nd6bf"; # self.lib.fakeSha256;
         postInstall = ''
           mkdir -p $out/lib/pkgconfig
           mkdir -p $out/include
@@ -37,7 +39,7 @@ self: super: {
           sed -e "s~<<VERSION>>~${version}~" \
             -e "s~<<PREFIX>>~$out~" \
             src/libzauth.pc > $out/lib/pkgconfig/libzauth.pc
-          cp target/release/libzauth.so $out/lib/
+          cp target/release-tmp/libzauth.so $out/lib/
         '';
       }
   ) {};
diff --git a/nix/sources.json b/nix/sources.json
index e4ab45d9d5f..370e10743a1 100644
--- a/nix/sources.json
+++ b/nix/sources.json
@@ -5,22 +5,22 @@
         "homepage": "https://github.com/nmattia/niv",
         "owner": "nmattia",
         "repo": "niv",
-        "rev": "50600603b51432839c4b6267fd6a0d00ae6b0451",
-        "sha256": "1rrhlscbqdn9a77ws49acl536n3mz6bai68z08mpg8qqa4ahr2sn",
+        "rev": "ab9cc41caf44d1f1d465d8028e4bc0096fd73238",
+        "sha256": "17k52n8zwp832cqifsc4458mhy4044wmk22f807171hf6p7l4xvr",
         "type": "tarball",
-        "url": "https://github.com/nmattia/niv/archive/50600603b51432839c4b6267fd6a0d00ae6b0451.tar.gz",
+        "url": "https://github.com/nmattia/niv/archive/ab9cc41caf44d1f1d465d8028e4bc0096fd73238.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "nixpkgs": {
-        "branch": "nixos-19.09",
+        "branch": "nixpkgs-unstable",
         "description": "A read-only mirror of NixOS/nixpkgs tracking the released channels. Send issues and PRs to",
         "homepage": "https://github.com/NixOS/nixpkgs",
         "owner": "NixOS",
         "repo": "nixpkgs-channels",
-        "rev": "8731aaaf8b30888bc24994096db830993090d7c4",
-        "sha256": "1hcc89rxi47nb0mpk05nl9rbbb04kfw97xfydhpmmgh57yrp3zqa",
+        "rev": "6d4b93323e7f78121f8d6db6c59f3889aa1dd931",
+        "sha256": "0g2j41cx2w2an5d9kkqvgmada7ssdxqz1zvjd7hi5vif8ag0v5la",
         "type": "tarball",
-        "url": "https://github.com/NixOS/nixpkgs-channels/archive/8731aaaf8b30888bc24994096db830993090d7c4.tar.gz",
+        "url": "https://github.com/NixOS/nixpkgs-channels/archive/6d4b93323e7f78121f8d6db6c59f3889aa1dd931.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     }
 }
diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs
index f16e8e0916e..2835c60c57a 100644
--- a/services/brig/src/Brig/API/Error.hs
+++ b/services/brig/src/Brig/API/Error.hs
@@ -38,7 +38,7 @@ import Imports
 import Network.HTTP.Types.Header
 import Network.HTTP.Types.Status
 import qualified Network.Wai.Utilities.Error as Wai
-import Type.Reflection (Typeable, typeRep)
+import Type.Reflection (typeRep)
 
 data Error where
   StdError :: !Wai.Error -> Error
diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs
index 01daee37123..4c0ec07110e 100644
--- a/services/brig/src/Brig/API/Internal.hs
+++ b/services/brig/src/Brig/API/Internal.hs
@@ -56,7 +56,6 @@ import Network.Wai (Response)
 import Network.Wai.Predicate hiding (result, setStatus)
 import Network.Wai.Routing
 import Network.Wai.Utilities as Utilities
-import Network.Wai.Utilities.Response (json)
 import Network.Wai.Utilities.ZAuth (zauthConnId, zauthUserId)
 import Wire.API.User
 import Wire.API.User.RichInfo
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index 7afead44526..f5d2f51ff0f 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -71,7 +71,6 @@ import Network.Wai (Response, lazyRequestBody)
 import Network.Wai.Predicate hiding (result, setStatus)
 import Network.Wai.Routing
 import Network.Wai.Utilities as Utilities
-import Network.Wai.Utilities.Response (json)
 import Network.Wai.Utilities.Swagger (document, mkSwaggerApi)
 import qualified Network.Wai.Utilities.Swagger as Doc
 import Network.Wai.Utilities.ZAuth (zauthConnId, zauthUserId)
diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs
index 745ed6408d7..d4e0f449029 100644
--- a/services/brig/src/Brig/AWS.hs
+++ b/services/brig/src/Brig/AWS.hs
@@ -56,7 +56,6 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import Data.UUID hiding (null)
-import Data.Yaml (FromJSON (..))
 import Imports hiding (group)
 import Network.AWS (AWSRequest, Rs)
 import qualified Network.AWS as AWS
diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs
index 1daf11a86c6..198e2684bf5 100644
--- a/services/brig/src/Brig/App.hs
+++ b/services/brig/src/Brig/App.hs
@@ -90,7 +90,7 @@ import Control.AutoUpdate
 import Control.Error
 import Control.Exception.Enclosed (handleAny)
 import Control.Lens hiding (index, (.=))
-import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
+import Control.Monad.Catch (MonadCatch, MonadMask)
 import Control.Monad.Trans.Resource
 import Data.ByteString.Conversion
 import Data.Default (def)
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index b0e393c83c0..1bcb262f42b 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -26,7 +26,6 @@ import Brig.Calling
 import qualified Brig.Calling as Calling
 import Brig.Calling.Internal
 import Control.Lens
-import Control.Monad.Fail (MonadFail)
 import Control.Monad.Random.Class
 import Data.ByteString.Conversion (toByteString')
 import Data.ByteString.Lens
diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs
index e2e091bea9c..76475084e7f 100644
--- a/services/brig/src/Brig/Code.hs
+++ b/services/brig/src/Brig/Code.hs
@@ -127,7 +127,7 @@ instance Cql Scope where
   fromCql (CqlInt 3) = return PasswordReset
   fromCql (CqlInt 4) = return AccountLogin
   fromCql (CqlInt 5) = return AccountApproval
-  fromCql _ = fail "fromCql: Scope: int expected"
+  fromCql _ = Left "fromCql: Scope: int expected"
 
 newtype Retries = Retries {numRetries :: Word8}
   deriving (Eq, Show, Ord, Num, Integral, Enum, Real)
@@ -136,7 +136,7 @@ instance Cql Retries where
   ctype = Tagged IntColumn
   toCql = CqlInt . fromIntegral . numRetries
   fromCql (CqlInt n) = return (Retries (fromIntegral n))
-  fromCql _ = fail "fromCql: Retries: int expected"
+  fromCql _ = Left "fromCql: Retries: int expected"
 
 --------------------------------------------------------------------------------
 -- Generation
diff --git a/services/brig/src/Brig/Data/Instances.hs b/services/brig/src/Brig/Data/Instances.hs
index fa906ab0256..19246eeb378 100644
--- a/services/brig/src/Brig/Data/Instances.hs
+++ b/services/brig/src/Brig/Data/Instances.hs
@@ -68,8 +68,8 @@ instance Cql Email where
 
   fromCql (CqlText t) = case parseEmail t of
     Just e -> return e
-    Nothing -> fail "fromCql: Invalid email"
-  fromCql _ = fail "fromCql: email: CqlText expected"
+    Nothing -> Left "fromCql: Invalid email"
+  fromCql _ = Left "fromCql: email: CqlText expected"
 
   toCql = toCql . fromEmail
 
@@ -78,8 +78,8 @@ instance Cql UserSSOId where
 
   fromCql (CqlText t) = case eitherDecode $ cs t of
     Right i -> return i
-    Left msg -> fail $ "fromCql: Invalid UserSSOId: " ++ msg
-  fromCql _ = fail "fromCql: UserSSOId: CqlText expected"
+    Left msg -> Left $ "fromCql: Invalid UserSSOId: " ++ msg
+  fromCql _ = Left "fromCql: UserSSOId: CqlText expected"
 
   toCql = toCql . cs @LBS @ST . encode
 
@@ -93,8 +93,8 @@ instance Cql Relation where
     3 -> return Ignored
     4 -> return Sent
     5 -> return Cancelled
-    n -> fail $ "unexpected relation: " ++ show n
-  fromCql _ = fail "relation: int expected"
+    n -> Left $ "unexpected relation: " ++ show n
+  fromCql _ = Left "relation: int expected"
 
   toCql Accepted = CqlInt 0
   toCql Blocked = CqlInt 1
@@ -120,7 +120,7 @@ instance Cql AssetSize where
 
   fromCql (CqlInt 0) = return AssetPreview
   fromCql (CqlInt 1) = return AssetComplete
-  fromCql n = fail $ "Unexpected asset size: " ++ show n
+  fromCql n = Left $ "Unexpected asset size: " ++ show n
 
   toCql AssetPreview = CqlInt 0
   toCql AssetComplete = CqlInt 1
@@ -145,16 +145,16 @@ instance Cql Asset where
     s <- optional "size"
     case (t :: Int32) of
       0 -> return $! ImageAsset k s
-      _ -> fail $ "unexpected user asset type: " ++ show t
+      _ -> Left $ "unexpected user asset type: " ++ show t
     where
       required :: Cql r => Text -> Either String r
       required f =
         maybe
-          (fail ("Asset: Missing required field '" ++ show f ++ "'"))
+          (Left ("Asset: Missing required field '" ++ show f ++ "'"))
           fromCql
           (lookup f fs)
       optional f = maybe (Right Nothing) fromCql (lookup f fs)
-  fromCql _ = fail "UserAsset: UDT expected"
+  fromCql _ = Left "UserAsset: UDT expected"
 
   -- Note: Order must match up with the 'ctype' definition.
   toCql (ImageAsset k s) =
@@ -177,8 +177,8 @@ instance Cql AccountStatus where
     1 -> return Suspended
     2 -> return Deleted
     3 -> return Ephemeral
-    n -> fail $ "unexpected account status: " ++ show n
-  fromCql _ = fail "account status: int expected"
+    n -> Left $ "unexpected account status: " ++ show n
+  fromCql _ = Left "account status: int expected"
 
 instance Cql ClientType where
   ctype = Tagged IntColumn
@@ -189,7 +189,7 @@ instance Cql ClientType where
   fromCql (CqlInt 0) = return TemporaryClientType
   fromCql (CqlInt 1) = return PermanentClientType
   fromCql (CqlInt 2) = return LegalHoldClientType
-  fromCql _ = fail "ClientType: Int [0, 2] expected"
+  fromCql _ = Left "ClientType: Int [0, 2] expected"
 
 instance Cql ClientClass where
   ctype = Tagged IntColumn
@@ -202,15 +202,15 @@ instance Cql ClientClass where
   fromCql (CqlInt 1) = return TabletClient
   fromCql (CqlInt 2) = return DesktopClient
   fromCql (CqlInt 3) = return LegalHoldClient
-  fromCql _ = fail "ClientClass: Int [0, 3] expected"
+  fromCql _ = Left "ClientClass: Int [0, 3] expected"
 
 instance Cql PropertyValue where
   ctype = Tagged BlobColumn
   toCql = toCql . Blob . JSON.encode . propertyValueJson
   fromCql (CqlBlob v) = case JSON.eitherDecode v of
-    Left e -> fail ("Failed to read property value: " <> e)
+    Left e -> Left ("Failed to read property value: " <> e)
     Right x -> pure (PropertyValue x)
-  fromCql _ = fail "PropertyValue: Blob expected"
+  fromCql _ = Left "PropertyValue: Blob expected"
 
 instance Cql Country where
   ctype = Tagged AsciiColumn
@@ -218,8 +218,8 @@ instance Cql Country where
 
   fromCql (CqlAscii c) = case parseCountry c of
     Just c' -> return c'
-    Nothing -> fail "Country: ISO 3166-1-alpha2 expected."
-  fromCql _ = fail "Country: ASCII expected"
+    Nothing -> Left "Country: ISO 3166-1-alpha2 expected."
+  fromCql _ = Left "Country: ASCII expected"
 
 instance Cql Language where
   ctype = Tagged AsciiColumn
@@ -227,15 +227,15 @@ instance Cql Language where
 
   fromCql (CqlAscii l) = case parseLanguage l of
     Just l' -> return l'
-    Nothing -> fail "Language: ISO 639-1 expected."
-  fromCql _ = fail "Language: ASCII expected"
+    Nothing -> Left "Language: ISO 639-1 expected."
+  fromCql _ = Left "Language: ASCII expected"
 
 instance Cql ManagedBy where
   ctype = Tagged IntColumn
 
   fromCql (CqlInt 0) = return ManagedByWire
   fromCql (CqlInt 1) = return ManagedByScim
-  fromCql n = fail $ "Unexpected ManagedBy: " ++ show n
+  fromCql n = Left $ "Unexpected ManagedBy: " ++ show n
 
   toCql ManagedByWire = CqlInt 0
   toCql ManagedByScim = CqlInt 1
@@ -244,10 +244,10 @@ instance Cql RichInfoAssocList where
   ctype = Tagged BlobColumn
   toCql = toCql . Blob . JSON.encode
   fromCql (CqlBlob v) = JSON.eitherDecode v
-  fromCql _ = fail "RichInfo: Blob expected"
+  fromCql _ = Left "RichInfo: Blob expected"
 
 instance Cql Domain where
   ctype = Tagged TextColumn
   toCql = CqlText . domainText
-  fromCql (CqlText txt) = either fail pure $ mkDomain txt
-  fromCql _ = fail "Domain: Text expected"
+  fromCql (CqlText txt) = mkDomain txt
+  fromCql _ = Left "Domain: Text expected"
diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs
index b192b8fd8f8..2eb4c9c1d69 100644
--- a/services/brig/src/Brig/Data/User.hs
+++ b/services/brig/src/Brig/Data/User.hs
@@ -73,7 +73,6 @@ import Brig.Options
 import Brig.Password
 import Brig.Types
 import Brig.Types.Intra
-import Brig.Types.User (newUserExpiresIn)
 import qualified Brig.ZAuth as ZAuth
 import Cassandra
 import Control.Error
diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs
index be21c62a357..408973ff0dd 100644
--- a/services/brig/src/Brig/Data/UserKey.hs
+++ b/services/brig/src/Brig/Data/UserKey.hs
@@ -72,8 +72,8 @@ instance Cql UKHashType where
   fromCql (CqlInt i) = case i of
     0 -> return UKHashPhone
     1 -> return UKHashEmail
-    n -> fail $ "unexpected hashtype: " ++ show n
-  fromCql _ = fail "userkeyhashtype: int expected"
+    n -> Left $ "unexpected hashtype: " ++ show n
+  fromCql _ = Left "userkeyhashtype: int expected"
 
   toCql UKHashPhone = CqlInt 0
   toCql UKHashEmail = CqlInt 1
@@ -84,9 +84,9 @@ instance Cql UserKeyHash where
   ctype = Tagged BlobColumn
 
   fromCql (CqlBlob lbs) = case MH.decode (toStrict lbs) of
-    Left e -> fail ("userkeyhash: " ++ e)
+    Left e -> Left ("userkeyhash: " ++ e)
     Right h -> return $ UserKeyHash h
-  fromCql _ = fail "userkeyhash: expected blob"
+  fromCql _ = Left "userkeyhash: expected blob"
 
   toCql (UserKeyHash d) = CqlBlob $ MH.encode (MH.algorithm d) (MH.digest d)
 
diff --git a/services/brig/src/Brig/Index/Migrations.hs b/services/brig/src/Brig/Index/Migrations.hs
index 14ea80ebf4e..852ef985932 100644
--- a/services/brig/src/Brig/Index/Migrations.hs
+++ b/services/brig/src/Brig/Index/Migrations.hs
@@ -26,7 +26,7 @@ import qualified Brig.User.Search.Index as Search
 import qualified Cassandra as C
 import qualified Cassandra.Settings as C
 import Control.Lens (view, (^.))
-import Control.Monad.Catch (Exception, MonadThrow, finally, throwM)
+import Control.Monad.Catch (MonadThrow, finally, throwM)
 import Data.Aeson (Value, object, (.=))
 import qualified Data.Metrics as Metrics
 import qualified Data.Text as Text
diff --git a/services/brig/src/Brig/Index/Migrations/Types.hs b/services/brig/src/Brig/Index/Migrations/Types.hs
index 920ed007e1d..3327515a134 100644
--- a/services/brig/src/Brig/Index/Migrations/Types.hs
+++ b/services/brig/src/Brig/Index/Migrations/Types.hs
@@ -23,7 +23,6 @@ module Brig.Index.Migrations.Types where
 import qualified Brig.User.Search.Index as Search
 import qualified Cassandra as C
 import Control.Monad.Catch (MonadThrow)
-import Control.Monad.Reader (MonadReader (..), ReaderT, lift, runReaderT)
 import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=))
 import Data.Metrics (Metrics)
 import qualified Database.Bloodhound as ES
diff --git a/services/brig/src/Brig/Password.hs b/services/brig/src/Brig/Password.hs
index 1b782ac74c6..0f7738e8375 100644
--- a/services/brig/src/Brig/Password.hs
+++ b/services/brig/src/Brig/Password.hs
@@ -43,7 +43,7 @@ instance Cql Password where
   ctype = Tagged BlobColumn
 
   fromCql (CqlBlob lbs) = return . Password . EncryptedPass $ toStrict lbs
-  fromCql _ = fail "password: expected blob"
+  fromCql _ = Left "password: expected blob"
 
   toCql = CqlBlob . fromStrict . getEncryptedPass . fromPassword
 
diff --git a/services/brig/src/Brig/Phone.hs b/services/brig/src/Brig/Phone.hs
index 41520c0dc41..02379acb2ba 100644
--- a/services/brig/src/Brig/Phone.hs
+++ b/services/brig/src/Brig/Phone.hs
@@ -44,7 +44,6 @@ import Brig.Types
 import Control.Lens (view)
 import Control.Monad.Catch
 import Control.Retry
-import Data.Char (isSpace)
 import Data.LanguageCodes
 import qualified Data.Metrics as Metrics
 import qualified Data.Text as Text
diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs
index c9adc1089a8..af0313ae037 100644
--- a/services/brig/src/Brig/Provider/DB.hs
+++ b/services/brig/src/Brig/Provider/DB.hs
@@ -29,7 +29,6 @@ import Brig.Types.Provider.Tag
 import Cassandra as C
 import Control.Arrow ((&&&))
 import Data.Id
-import Data.List (minimumBy, sortOn, uncons, unfoldr)
 import Data.List1 (List1)
 import Data.Misc
 import Data.Range (Range, fromRange, rcast, rnil)
diff --git a/services/brig/src/Brig/RPC.hs b/services/brig/src/Brig/RPC.hs
index 1bb3a0f9419..4d12ab84065 100644
--- a/services/brig/src/Brig/RPC.hs
+++ b/services/brig/src/Brig/RPC.hs
@@ -32,7 +32,7 @@ import Data.Id
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as LT
 import Imports
-import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), checkResponse)
+import Network.HTTP.Client (HttpExceptionContent (..), checkResponse)
 import Network.HTTP.Types.Method
 import Network.HTTP.Types.Status
 import System.Logger.Class hiding (name, (.=))
diff --git a/services/brig/src/Brig/SMTP.hs b/services/brig/src/Brig/SMTP.hs
index 86d5eb0022e..59818297d81 100644
--- a/services/brig/src/Brig/SMTP.hs
+++ b/services/brig/src/Brig/SMTP.hs
@@ -20,7 +20,6 @@ module Brig.SMTP where
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Data.Char (toLower)
 import Data.Pool
 import Data.Text (unpack)
 import Imports
diff --git a/services/brig/src/Brig/User/Auth/Cookie/Limit.hs b/services/brig/src/Brig/User/Auth/Cookie/Limit.hs
index 77ca9c71507..d8160d3f03b 100644
--- a/services/brig/src/Brig/User/Auth/Cookie/Limit.hs
+++ b/services/brig/src/Brig/User/Auth/Cookie/Limit.hs
@@ -19,7 +19,6 @@ module Brig.User.Auth.Cookie.Limit where
 
 import Brig.Types.User.Auth
 import Data.Aeson
-import Data.List (sortBy)
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import qualified Data.Vector as Vector
diff --git a/services/brig/src/Brig/User/Auth/DB/Instances.hs b/services/brig/src/Brig/User/Auth/DB/Instances.hs
index 737af407f98..971f8fd2488 100644
--- a/services/brig/src/Brig/User/Auth/DB/Instances.hs
+++ b/services/brig/src/Brig/User/Auth/DB/Instances.hs
@@ -40,7 +40,7 @@ instance Cql CookieId where
   toCql = CqlBigInt . fromIntegral . cookieIdNum
 
   fromCql (CqlBigInt i) = return (CookieId (fromIntegral i))
-  fromCql _ = fail "fromCql: invalid cookie id"
+  fromCql _ = Left "fromCql: invalid cookie id"
 
 instance Cql CookieType where
   ctype = Tagged IntColumn
@@ -50,4 +50,4 @@ instance Cql CookieType where
 
   fromCql (CqlInt 0) = return SessionCookie
   fromCql (CqlInt 1) = return PersistentCookie
-  fromCql _ = fail "fromCql: invalid cookie type"
+  fromCql _ = Left "fromCql: invalid cookie type"
diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs
index 95ceb2ec267..d66267f3118 100644
--- a/services/brig/src/Brig/User/Search/Index.hs
+++ b/services/brig/src/Brig/User/Search/Index.hs
@@ -71,7 +71,6 @@ import Data.Id
 import qualified Data.Map as Map
 import Data.Metrics
 import Data.Range
-import Data.Semigroup (Max (..))
 import Data.Text.ICU.Translit (trans, transliterate)
 import Data.Text.Lazy.Builder.Int (decimal)
 import Data.Text.Lens hiding (text)
diff --git a/services/brig/src/Brig/Whitelist.hs b/services/brig/src/Brig/Whitelist.hs
index a61e7838844..010412c85b8 100644
--- a/services/brig/src/Brig/Whitelist.hs
+++ b/services/brig/src/Brig/Whitelist.hs
@@ -35,7 +35,7 @@ import Data.Aeson
 import Data.Text
 import Data.Text.Encoding (encodeUtf8)
 import Imports
-import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), parseRequest)
+import Network.HTTP.Client (HttpExceptionContent (..))
 
 -- | A service providing a whitelist of allowed email addresses and phone numbers
 data Whitelist = Whitelist
diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index b36a2182270..1f693223de9 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -29,14 +29,12 @@ import Data.Bifunctor (Bifunctor (first))
 import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as LB
 import Data.Id
-import Data.List ((\\))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.List1 (List1)
 import qualified Data.List1 as List1
 import Data.Misc (Port, mkHttpsUrl)
 import qualified Data.Set as Set
 import Imports
-import Network.HTTP.Client (Manager)
 import System.FilePath ((</>))
 import Test.Tasty
 import Test.Tasty.HUnit
diff --git a/services/brig/test/integration/API/Search.hs b/services/brig/test/integration/API/Search.hs
index 7574a5be620..ff669fa11cc 100644
--- a/services/brig/test/integration/API/Search.hs
+++ b/services/brig/test/integration/API/Search.hs
@@ -30,18 +30,15 @@ import qualified Brig.Options as Opt
 import Brig.Types
 import Control.Lens ((.~), (?~), (^.))
 import Control.Monad.Catch (MonadCatch, MonadThrow)
-import Control.Monad.Fail (MonadFail)
 import Control.Retry
 import Data.Aeson (FromJSON, Value, (.=))
 import qualified Data.Aeson as Aeson
 import Data.Handle (fromHandle)
 import Data.Id
-import Data.List (elemIndex)
 import qualified Data.Text as Text
 import qualified Database.Bloodhound as ES
 import qualified Galley.Types.Teams.SearchVisibility as Team
 import Imports
-import Network.HTTP.Client (Manager)
 import qualified Network.HTTP.Client as HTTP
 import qualified Network.Wai.Test as WaiTest
 import Test.Tasty
diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs
index 1a83cdad7af..26644728549 100644
--- a/services/brig/test/integration/API/Team.hs
+++ b/services/brig/test/integration/API/Team.hs
@@ -36,7 +36,6 @@ import Brig.Types.User.Auth
 import Control.Arrow ((&&&))
 import Control.Lens hiding ((.=))
 import Control.Monad.Catch (MonadCatch, MonadThrow)
-import Control.Monad.Fail (MonadFail)
 import Data.Aeson
 import Data.ByteString.Conversion
 import Data.Id hiding (client)
@@ -47,7 +46,6 @@ import qualified Data.UUID.V4 as UUID
 import qualified Galley.Types.Teams as Team
 import qualified Galley.Types.Teams.Intra as Team
 import Imports
-import Network.HTTP.Client (Manager)
 import qualified Network.Wai.Test as WaiTest
 import qualified Network.Wai.Utilities.Error as Error
 import Numeric.Natural (Natural)
diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs
index 107ac430dba..0293e682fb7 100644
--- a/services/brig/test/integration/API/Team/Util.hs
+++ b/services/brig/test/integration/API/Team/Util.hs
@@ -28,7 +28,6 @@ import Brig.Types.Team.Invitation
 import Brig.Types.User
 import Control.Lens ((^?))
 import Control.Monad.Catch (MonadCatch, MonadThrow)
-import Control.Monad.Fail (MonadFail)
 import Data.Aeson
 import Data.Aeson.Lens
 import Data.ByteString.Conversion
diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs
index bade4a50538..f61798825b7 100644
--- a/services/brig/test/integration/Util.hs
+++ b/services/brig/test/integration/Util.hs
@@ -38,7 +38,6 @@ import Brig.Types.User.Auth
 import qualified Brig.ZAuth as ZAuth
 import Control.Lens ((^.), (^?), (^?!))
 import Control.Monad.Catch (MonadCatch)
-import Control.Monad.Fail (MonadFail)
 import Control.Retry
 import Data.Aeson
 import Data.Aeson.Lens (key, _Integral, _JSON, _String)
@@ -557,7 +556,7 @@ mkEmailRandomLocalSuffix e = do
   uid <- liftIO UUID.nextRandom
   case parseEmail e of
     Just (Email loc dom) -> return $ Email (loc <> "+" <> UUID.toText uid) dom
-    Nothing -> fail $ "Invalid email address: " ++ Text.unpack e
+    Nothing -> error $ "Invalid email address: " ++ Text.unpack e
 
 -- | Generate emails that are in the trusted whitelist of domains whose @+@ suffices count for email
 -- disambiguation.  See also: 'Brig.Email.mkEmailKey'.
diff --git a/services/cannon/src/Cannon/API/Internal.hs b/services/cannon/src/Cannon/API/Internal.hs
index d9e15604386..b60d6dcdff3 100644
--- a/services/cannon/src/Cannon/API/Internal.hs
+++ b/services/cannon/src/Cannon/API/Internal.hs
@@ -37,8 +37,6 @@ import Network.Wai
 import Network.Wai.Predicate
 import Network.Wai.Routing
 import Network.Wai.Utilities
-import Network.Wai.Utilities.Request (parseBody')
-import Network.Wai.Utilities.Response (json)
 import System.Logger.Class (msg, val)
 import qualified System.Logger.Class as LC
 
diff --git a/services/cannon/src/Cannon/API/Public.hs b/services/cannon/src/Cannon/API/Public.hs
index 1084491e30b..8480c5932f9 100644
--- a/services/cannon/src/Cannon/API/Public.hs
+++ b/services/cannon/src/Cannon/API/Public.hs
@@ -33,7 +33,6 @@ import Network.Wai.Handler.WebSockets
 import Network.Wai.Predicate
 import Network.Wai.Routing
 import Network.Wai.Utilities
-import Network.Wai.Utilities.Response (json)
 import Network.Wai.Utilities.Swagger
 import qualified Network.WebSockets as Ws
 
diff --git a/services/cannon/src/Cannon/App.hs b/services/cannon/src/Cannon/App.hs
index 74de9451438..428549a4dfc 100644
--- a/services/cannon/src/Cannon/App.hs
+++ b/services/cannon/src/Cannon/App.hs
@@ -33,7 +33,7 @@ import Data.Id (ClientId)
 import qualified Data.Text.Lazy as Text
 import Data.Timeout
 import Imports hiding (threadDelay)
-import Lens.Family hiding (set)
+import Lens.Family hiding (reset, set)
 import Network.HTTP.Types.Status
 import Network.Wai.Utilities.Error
 import Network.WebSockets hiding (Request, Response, requestHeaders)
diff --git a/services/cargohold/src/CargoHold/API/Public.hs b/services/cargohold/src/CargoHold/API/Public.hs
index 73ba7eb5dd4..33950d5c024 100644
--- a/services/cargohold/src/CargoHold/API/Public.hs
+++ b/services/cargohold/src/CargoHold/API/Public.hs
@@ -43,7 +43,6 @@ import Network.Wai.Conduit (sourceRequestBody)
 import Network.Wai.Predicate hiding (Error, setStatus)
 import Network.Wai.Routing
 import Network.Wai.Utilities hiding (message)
-import Network.Wai.Utilities.Response (json)
 import Network.Wai.Utilities.Swagger (document, mkSwaggerApi)
 import qualified Network.Wai.Utilities.Swagger as Doc
 import Network.Wai.Utilities.ZAuth
diff --git a/services/federator/src/Federator/App.hs b/services/federator/src/Federator/App.hs
index f6dcd763ab2..872aed9e9f4 100644
--- a/services/federator/src/Federator/App.hs
+++ b/services/federator/src/Federator/App.hs
@@ -31,7 +31,7 @@ import Bilge.RPC (HasRequestId (..))
 import Control.Error (ExceptT)
 import Control.Lens (view)
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
-import Control.Monad.Trans.Resource (MonadUnliftIO, ResourceT, runResourceT, transResourceT)
+import Control.Monad.Trans.Resource (ResourceT, runResourceT, transResourceT)
 import Federator.Types (Env, applog, requestId)
 import Imports
 import Servant.API.Generic ()
diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs
index cd26fe1618e..5e6bd16254a 100644
--- a/services/galley/src/Galley/API/Error.hs
+++ b/services/galley/src/Galley/API/Error.hs
@@ -30,7 +30,7 @@ import Galley.Types.Teams (IsPerm, hardTruncationLimit)
 import Imports
 import Network.HTTP.Types.Status
 import Network.Wai.Utilities.Error
-import Type.Reflection (Typeable, typeRep)
+import Type.Reflection (typeRep)
 
 internalError :: Error
 internalError = internalErrorWithDescription "internal error"
diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs
index 355a6b09adb..5b54cba20ec 100644
--- a/services/galley/src/Galley/Data.hs
+++ b/services/galley/src/Galley/Data.hs
@@ -116,7 +116,6 @@ import Data.Bifunctor (first)
 import Data.ByteString.Conversion hiding (parser)
 import Data.Coerce (coerce)
 import Data.Domain (Domain)
-import Data.Function (on)
 import Data.Id as Id
 import Data.IdMapping (IdMapping (IdMapping), MappedOrLocalId (Local, Mapped), opaqueIdFromMappedOrLocal)
 import Data.Json.Util (UTCTimeMillis (..))
diff --git a/services/galley/src/Galley/Data/Instances.hs b/services/galley/src/Galley/Data/Instances.hs
index d94b533a315..0175d87b5f5 100644
--- a/services/galley/src/Galley/Data/Instances.hs
+++ b/services/galley/src/Galley/Data/Instances.hs
@@ -51,8 +51,8 @@ instance Cql ConvType where
     1 -> return SelfConv
     2 -> return One2OneConv
     3 -> return ConnectConv
-    n -> fail $ "unexpected conversation-type: " ++ show n
-  fromCql _ = fail "conv-type: int expected"
+    n -> Left $ "unexpected conversation-type: " ++ show n
+  fromCql _ = Left "conv-type: int expected"
 
 instance Cql Access where
   ctype = Tagged IntColumn
@@ -67,8 +67,8 @@ instance Cql Access where
     2 -> return InviteAccess
     3 -> return LinkAccess
     4 -> return CodeAccess
-    n -> fail $ "Unexpected Access value: " ++ show n
-  fromCql _ = fail "Access value: int expected"
+    n -> Left $ "Unexpected Access value: " ++ show n
+  fromCql _ = Left "Access value: int expected"
 
 instance Cql AccessRole where
   ctype = Tagged IntColumn
@@ -83,8 +83,8 @@ instance Cql AccessRole where
     2 -> return TeamAccessRole
     3 -> return ActivatedAccessRole
     4 -> return NonActivatedAccessRole
-    n -> fail $ "Unexpected AccessRole value: " ++ show n
-  fromCql _ = fail "AccessRole value: int expected"
+    n -> Left $ "Unexpected AccessRole value: " ++ show n
+  fromCql _ = Left "AccessRole value: int expected"
 
 instance Cql ConvTeamInfo where
   ctype = Tagged $ UdtColumn "teaminfo" [("teamid", UuidColumn), ("managed", BooleanColumn)]
@@ -95,7 +95,7 @@ instance Cql ConvTeamInfo where
     t <- note "missing 'teamid' in teaminfo" ("teamid" `lookup` u) >>= fromCql
     m <- note "missing 'managed' in teaminfo" ("managed" `lookup` u) >>= fromCql
     pure (ConvTeamInfo t m)
-  fromCql _ = fail "teaminfo: udt expected"
+  fromCql _ = Left "teaminfo: udt expected"
 
 instance Cql TeamBinding where
   ctype = Tagged BooleanColumn
@@ -105,7 +105,7 @@ instance Cql TeamBinding where
 
   fromCql (CqlBoolean True) = pure Binding
   fromCql (CqlBoolean False) = pure NonBinding
-  fromCql _ = fail "teambinding: boolean expected"
+  fromCql _ = Left "teambinding: boolean expected"
 
 instance Cql TeamStatus where
   ctype = Tagged IntColumn
@@ -122,8 +122,8 @@ instance Cql TeamStatus where
     2 -> return Deleted
     3 -> return Suspended
     4 -> return PendingActive
-    n -> fail $ "unexpected team-status: " ++ show n
-  fromCql _ = fail "team-status: int expected"
+    n -> Left $ "unexpected team-status: " ++ show n
+  fromCql _ = Left "team-status: int expected"
 
 instance Cql Public.TeamFeatureStatusValue where
   ctype = Tagged IntColumn
@@ -131,8 +131,8 @@ instance Cql Public.TeamFeatureStatusValue where
   fromCql (CqlInt n) = case n of
     0 -> pure $ Public.TeamFeatureDisabled
     1 -> pure $ Public.TeamFeatureEnabled
-    _ -> fail "fromCql: Invalid TeamFeatureStatusValue"
-  fromCql _ = fail "fromCql: TeamFeatureStatusValue: CqlInt expected"
+    _ -> Left "fromCql: Invalid TeamFeatureStatusValue"
+  fromCql _ = Left "fromCql: TeamFeatureStatusValue: CqlInt expected"
 
   toCql Public.TeamFeatureDisabled = CqlInt 0
   toCql Public.TeamFeatureEnabled = CqlInt 1
@@ -143,8 +143,8 @@ instance Cql TeamSearchVisibility where
   fromCql (CqlInt n) = case n of
     0 -> pure $ SearchVisibilityStandard
     1 -> pure $ SearchVisibilityNoNameOutsideTeam
-    _ -> fail "fromCql: Invalid TeamSearchVisibility"
-  fromCql _ = fail "fromCql: TeamSearchVisibility: CqlInt expected"
+    _ -> Left "fromCql: Invalid TeamSearchVisibility"
+  fromCql _ = Left "fromCql: TeamSearchVisibility: CqlInt expected"
 
   toCql SearchVisibilityStandard = CqlInt 0
   toCql SearchVisibilityNoNameOutsideTeam = CqlInt 1
@@ -152,5 +152,5 @@ instance Cql TeamSearchVisibility where
 instance Cql Domain where
   ctype = Tagged TextColumn
   toCql = CqlText . domainText
-  fromCql (CqlText txt) = either fail pure $ mkDomain txt
-  fromCql _ = fail "Domain: Text expected"
+  fromCql (CqlText txt) = mkDomain txt
+  fromCql _ = Left "Domain: Text expected"
diff --git a/services/galley/src/Galley/Data/Types.hs b/services/galley/src/Galley/Data/Types.hs
index 16a5e9f3f61..19cb9bd2123 100644
--- a/services/galley/src/Galley/Data/Types.hs
+++ b/services/galley/src/Galley/Data/Types.hs
@@ -100,7 +100,7 @@ instance Cql Scope where
   toCql ReusableCode = CqlInt 1
 
   fromCql (CqlInt 1) = return ReusableCode
-  fromCql _ = fail "unknown Scope"
+  fromCql _ = Left "unknown Scope"
 
 toCode :: Key -> Scope -> (Value, Int32, ConvId) -> Code
 toCode k s (val, ttl, cnv) =
diff --git a/services/galley/src/Galley/External.hs b/services/galley/src/Galley/External.hs
index 22b76e9a0af..4b8b7994a82 100644
--- a/services/galley/src/Galley/External.hs
+++ b/services/galley/src/Galley/External.hs
@@ -22,7 +22,6 @@ where
 
 import Bilge.Request
 import Bilge.Retry (httpHandlers)
-import Control.Exception (fromException)
 import Control.Lens
 import Control.Retry
 import Data.ByteString.Conversion.To
diff --git a/services/galley/src/Galley/Intra/Client.hs b/services/galley/src/Galley/Intra/Client.hs
index 9c36265711e..f8f67405579 100644
--- a/services/galley/src/Galley/Intra/Client.hs
+++ b/services/galley/src/Galley/Intra/Client.hs
@@ -27,7 +27,6 @@ where
 import Bilge hiding (getHeader, options, statusCode)
 import Bilge.RPC
 import Brig.Types.Client
-import Brig.Types.Client.Prekey (LastPrekey, Prekey)
 import Brig.Types.Intra
 import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..))
 import Brig.Types.User.Auth (LegalHoldLogin (..))
diff --git a/services/galley/src/Galley/Intra/Push.hs b/services/galley/src/Galley/Intra/Push.hs
index 27a4944fcc1..8e3381e2c9d 100644
--- a/services/galley/src/Galley/Intra/Push.hs
+++ b/services/galley/src/Galley/Intra/Push.hs
@@ -50,7 +50,7 @@ where
 import Bilge hiding (options)
 import Bilge.RPC
 import Bilge.Retry
-import Control.Lens (makeLenses, set, view, (&), (.~), (^.))
+import Control.Lens (makeLenses, set, view, (.~), (^.))
 import Control.Monad.Catch
 import Control.Retry
 import Data.Aeson (Object)
diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs
index 9e2dd2cd3b4..d2ec99fd311 100644
--- a/services/galley/src/Galley/Intra/User.hs
+++ b/services/galley/src/Galley/Intra/User.hs
@@ -30,7 +30,6 @@ import Bilge hiding (getHeader, options, statusCode)
 import Bilge.RPC
 import Brig.Types.Connection (ConnectionsStatusRequest (..), Relation (..), UserIds (..))
 import Brig.Types.Intra
-import Brig.Types.Intra (ConnectionStatus (..), ReAuthUser (..))
 import Brig.Types.User (User)
 import Control.Monad.Catch (throwM)
 import Data.ByteString.Char8 (pack)
@@ -40,7 +39,7 @@ import Data.Id
 import Galley.App
 import Galley.Intra.Util
 import Imports
-import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..))
+import Network.HTTP.Client (HttpExceptionContent (..))
 import qualified Network.HTTP.Client.Internal as Http
 import Network.HTTP.Types.Method
 import Network.HTTP.Types.Status
diff --git a/services/galley/test/integration/API/SQS.hs b/services/galley/test/integration/API/SQS.hs
index afd7f1f7663..a52e7dae200 100644
--- a/services/galley/test/integration/API/SQS.hs
+++ b/services/galley/test/integration/API/SQS.hs
@@ -19,7 +19,7 @@
 -- instead.
 module API.SQS where
 
-import Control.Exception (SomeAsyncException, asyncExceptionFromException)
+import Control.Exception (asyncExceptionFromException)
 import Control.Lens hiding ((.=))
 import Control.Monad.Catch hiding (bracket)
 import qualified Data.ByteString.Base64 as B64
diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs
index b66c6887d1a..01481bfa563 100644
--- a/services/galley/test/integration/API/Teams/LegalHold.hs
+++ b/services/galley/test/integration/API/Teams/LegalHold.hs
@@ -36,7 +36,7 @@ import qualified Cassandra.Exec as Cql
 import qualified Control.Concurrent.Async as Async
 import Control.Concurrent.Chan
 import Control.Concurrent.Timeout hiding (threadDelay)
-import Control.Exception (SomeAsyncException, asyncExceptionFromException)
+import Control.Exception (asyncExceptionFromException)
 import Control.Lens
 import Control.Monad.Catch
 import Control.Retry (RetryPolicy, RetryStatus, exponentialBackoff, limitRetries, retrying)
@@ -83,7 +83,6 @@ import Test.QuickCheck.Instances ()
 import Test.Tasty
 import qualified Test.Tasty.Cannon as WS
 import Test.Tasty.HUnit
-import Test.Tasty.HUnit (assertBool)
 import TestHelpers
 import TestSetup
 import qualified Wire.API.Team.Feature as Public
diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs
index 8892fa136ee..9f8c2a98c16 100644
--- a/services/galley/test/integration/API/Util.hs
+++ b/services/galley/test/integration/API/Util.hs
@@ -27,7 +27,6 @@ import Brig.Types.Team.Invitation
 import Brig.Types.User.Auth (CookieLabel (..))
 import Control.Lens hiding (from, to, (#), (.=))
 import Control.Monad.Catch (MonadCatch)
-import Control.Monad.Fail (MonadFail)
 import Control.Retry (constantDelay, limitRetries, retrying)
 import Data.Aeson hiding (json)
 import Data.Aeson.Lens (key, _String)
@@ -1264,7 +1263,7 @@ randomUserWithClient lk = do
 newNonce :: TestM (Id ())
 newNonce = randomId
 
-fromBS :: (HasCallStack, FromByteString a, Monad m) => ByteString -> m a
+fromBS :: (HasCallStack, FromByteString a, MonadFail m) => ByteString -> m a
 fromBS = maybe (fail "fromBS: no parse") return . fromByteString
 
 convRange :: Maybe (Either [ConvId] ConvId) -> Maybe Int32 -> Request -> Request
diff --git a/services/galley/test/integration/TestSetup.hs b/services/galley/test/integration/TestSetup.hs
index 090124ddfd5..2b0dd87a939 100644
--- a/services/galley/test/integration/TestSetup.hs
+++ b/services/galley/test/integration/TestSetup.hs
@@ -39,7 +39,6 @@ import Bilge (Manager, MonadHttp (..), Request, withResponse)
 import qualified Cassandra as Cql
 import Control.Lens (makeLenses, view)
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
-import Control.Monad.Fail (MonadFail)
 import Data.Aeson
 import qualified Galley.Aws as Aws
 import Galley.Options (Opts)
diff --git a/services/gundeck/src/Gundeck/API/Public.hs b/services/gundeck/src/Gundeck/API/Public.hs
index b2457fab223..273dc640e0f 100644
--- a/services/gundeck/src/Gundeck/API/Public.hs
+++ b/services/gundeck/src/Gundeck/API/Public.hs
@@ -40,7 +40,6 @@ import Network.Wai
 import Network.Wai.Predicate hiding (setStatus)
 import Network.Wai.Routing hiding (route)
 import Network.Wai.Utilities
-import Network.Wai.Utilities.Response (json, setStatus)
 import Network.Wai.Utilities.Swagger
 import Wire.API.Notification (NotificationId)
 import qualified Wire.API.Notification as Public
diff --git a/services/gundeck/src/Gundeck/Instances.hs b/services/gundeck/src/Gundeck/Instances.hs
index e162984af34..b96d011c2ed 100644
--- a/services/gundeck/src/Gundeck/Instances.hs
+++ b/services/gundeck/src/Gundeck/Instances.hs
@@ -50,8 +50,8 @@ instance Cql Transport where
     2 -> return APNSSandbox
     3 -> return APNSVoIP
     4 -> return APNSVoIPSandbox
-    n -> fail $ "unexpected transport: " ++ show n
-  fromCql _ = fail "transport: int expected"
+    n -> Left $ "unexpected transport: " ++ show n
+  fromCql _ = Left "transport: int expected"
 
 instance Cql ConnId where
   ctype = Tagged BlobColumn
@@ -59,25 +59,25 @@ instance Cql ConnId where
   toCql (ConnId c) = CqlBlob (Bytes.fromStrict c)
 
   fromCql (CqlBlob b) = return . ConnId $ Bytes.toStrict b
-  fromCql _ = fail "ConnId: Blob expected"
+  fromCql _ = Left "ConnId: Blob expected"
 
 instance Cql EndpointArn where
   ctype = Tagged TextColumn
   toCql = CqlText . toText
-  fromCql (CqlText txt) = either fail return (fromText txt)
-  fromCql _ = fail "EndpointArn: Text expected"
+  fromCql (CqlText txt) = either Left return (fromText txt)
+  fromCql _ = Left "EndpointArn: Text expected"
 
 instance Cql Token where
   ctype = Tagged TextColumn
   toCql = CqlText . tokenText
   fromCql (CqlText txt) = Right (Token txt)
-  fromCql _ = fail "Token: Text expected"
+  fromCql _ = Left "Token: Text expected"
 
 instance Cql AppName where
   ctype = Tagged TextColumn
   toCql = CqlText . appNameText
   fromCql (CqlText txt) = Right (AppName txt)
-  fromCql _ = fail "App: Text expected"
+  fromCql _ = Left "App: Text expected"
 
 instance ToText (Id a) where
   toText = Text.decodeUtf8 . Uuid.toASCIIBytes . toUUID
diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs
index c1f07844c19..a06252abd71 100644
--- a/services/gundeck/src/Gundeck/Push.hs
+++ b/services/gundeck/src/Gundeck/Push.hs
@@ -67,7 +67,6 @@ import Network.HTTP.Types
 import Network.Wai.Utilities
 import System.Logger.Class (msg, val, (+++), (.=), (~~))
 import qualified System.Logger.Class as Log
-import UnliftIO.Concurrent (forkIO)
 import qualified Wire.API.Push.Token as Public
 
 push :: [Push] -> Gundeck ()
diff --git a/services/gundeck/src/Gundeck/Push/Native/Types.hs b/services/gundeck/src/Gundeck/Push/Native/Types.hs
index 70f391a6c7f..e007bbe2fec 100644
--- a/services/gundeck/src/Gundeck/Push/Native/Types.hs
+++ b/services/gundeck/src/Gundeck/Push/Native/Types.hs
@@ -44,7 +44,6 @@ import Control.Lens (Lens', makeLenses, view, (^.))
 import Data.Id (ClientId, ConnId, UserId)
 import Gundeck.Aws.Arn
 import Gundeck.Types
-import Gundeck.Types.Push.V2 (PushToken)
 import Imports
 
 -- | Native push address information of a device.
diff --git a/services/gundeck/src/Gundeck/Push/Websocket.hs b/services/gundeck/src/Gundeck/Push/Websocket.hs
index 6cfdab100ef..df7426efdae 100644
--- a/services/gundeck/src/Gundeck/Push/Websocket.hs
+++ b/services/gundeck/src/Gundeck/Push/Websocket.hs
@@ -47,7 +47,7 @@ import Gundeck.Types.Notification
 import Gundeck.Types.Presence
 import Gundeck.Util
 import Imports
-import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..))
+import Network.HTTP.Client (HttpExceptionContent (..))
 import qualified Network.HTTP.Client.Internal as Http
 import Network.HTTP.Types (StdMethod (POST), status200, status410)
 import qualified Network.URI as URI
diff --git a/services/gundeck/src/Gundeck/Util/DelayQueue.hs b/services/gundeck/src/Gundeck/Util/DelayQueue.hs
index 0e9013ac87b..80130fe4580 100644
--- a/services/gundeck/src/Gundeck/Util/DelayQueue.hs
+++ b/services/gundeck/src/Gundeck/Util/DelayQueue.hs
@@ -32,7 +32,6 @@ where
 
 import Data.OrdPSQ (OrdPSQ)
 import qualified Data.OrdPSQ as PSQ
-import Data.Tuple (swap)
 import Imports hiding (length)
 
 data DelayQueue k v = DelayQueue
diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs
index 7cc5984ceaa..e995ed9648e 100644
--- a/services/gundeck/test/integration/API.hs
+++ b/services/gundeck/test/integration/API.hs
@@ -27,7 +27,7 @@ import Bilge.Assert
 import qualified Cassandra as Cql
 import Control.Arrow ((&&&))
 import Control.Concurrent.Async (Async, async, concurrently_, forConcurrently_, wait)
-import Control.Lens (view, (%~), (.~), (<&>), (^.), (^?), _2)
+import Control.Lens (view, (%~), (.~), (^.), (^?), _2)
 import Control.Retry (constantDelay, limitRetries, recoverAll, retrying)
 import Data.Aeson hiding (json)
 import Data.Aeson.Lens
diff --git a/services/gundeck/test/integration/TestSetup.hs b/services/gundeck/test/integration/TestSetup.hs
index 47e41b27ac2..2d31de313a7 100644
--- a/services/gundeck/test/integration/TestSetup.hs
+++ b/services/gundeck/test/integration/TestSetup.hs
@@ -39,7 +39,6 @@ import Bilge (HttpT (..), Manager, MonadHttp, Request, runHttpT)
 import qualified Cassandra as Cql
 import Control.Lens (makeLenses, (^.))
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
-import Control.Monad.Fail (MonadFail)
 import Imports
 import qualified System.Logger as Log
 import Test.Tasty (TestName, TestTree)
diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs
index b9af844e549..521830c0312 100644
--- a/services/spar/src/Spar/App.hs
+++ b/services/spar/src/Spar/App.hs
@@ -76,7 +76,6 @@ import SAML2.WebSSO
 import qualified SAML2.WebSSO as SAML
 import Servant
 import qualified Servant.Multipart as Multipart
-import Servant.Server (errBody, errReasonPhrase)
 import Spar.API.Swagger ()
 import qualified Spar.Data as Data
 import Spar.Error
diff --git a/services/spar/src/Spar/Data/Instances.hs b/services/spar/src/Spar/Data/Instances.hs
index f2d2cb2c57a..28f7623b267 100644
--- a/services/spar/src/Spar/Data/Instances.hs
+++ b/services/spar/src/Spar/Data/Instances.hs
@@ -46,28 +46,28 @@ instance Cql SAML.XmlText where
   toCql = CqlText . SAML.unsafeFromXmlText
 
   fromCql (CqlText t) = pure $ SAML.mkXmlText t
-  fromCql _ = fail "XmlText: expected CqlText"
+  fromCql _ = Left "XmlText: expected CqlText"
 
 instance Cql (SignedCertificate) where
   ctype = Tagged BlobColumn
   toCql = CqlBlob . cs . renderKeyInfo
 
   fromCql (CqlBlob t) = parseKeyInfo False (cs t)
-  fromCql _ = fail "SignedCertificate: expected CqlBlob"
+  fromCql _ = Left "SignedCertificate: expected CqlBlob"
 
 instance Cql (URIRef Absolute) where
   ctype = Tagged TextColumn
   toCql = CqlText . SAML.renderURI
 
   fromCql (CqlText t) = parseURI' t
-  fromCql _ = fail "URI: expected CqlText"
+  fromCql _ = Left "URI: expected CqlText"
 
 instance Cql SAML.NameID where
   ctype = Tagged TextColumn
   toCql = CqlText . cs . SAML.encodeElem
 
   fromCql (CqlText t) = SAML.decodeElem (cs t)
-  fromCql _ = fail "NameID: expected CqlText"
+  fromCql _ = Left "NameID: expected CqlText"
 
 deriving instance Cql SAML.Issuer
 
@@ -88,8 +88,8 @@ instance Cql VerdictFormatCon where
   fromCql (CqlInt i) = case i of
     0 -> return VerdictFormatConWeb
     1 -> return VerdictFormatConMobile
-    n -> fail $ "unexpected VerdictFormatCon: " ++ show n
-  fromCql _ = fail "member-status: int expected"
+    n -> Left $ "unexpected VerdictFormatCon: " ++ show n
+  fromCql _ = Left "member-status: int expected"
 
 fromVerdictFormat :: VerdictFormat -> VerdictFormatRow
 fromVerdictFormat VerdictFormatWeb = (VerdictFormatConWeb, Nothing, Nothing)
diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs
index 6685464cf07..46648b0c3f7 100644
--- a/services/spar/src/Spar/Intra/Brig.hs
+++ b/services/spar/src/Spar/Intra/Brig.hs
@@ -70,7 +70,6 @@ import Data.Id (Id (Id), TeamId, UserId)
 import Data.Ix
 import Data.Misc (PlainTextPassword)
 import Data.String.Conversions
-import Data.String.Conversions (cs)
 import Imports
 import Network.HTTP.Types.Method
 import qualified Network.Wai.Utilities.Error as Wai
diff --git a/services/spar/src/Spar/Scim/Swagger.hs b/services/spar/src/Spar/Scim/Swagger.hs
index 60a20e52df4..2a97cf9824d 100644
--- a/services/spar/src/Spar/Scim/Swagger.hs
+++ b/services/spar/src/Spar/Scim/Swagger.hs
@@ -30,7 +30,7 @@ module Spar.Scim.Swagger
   )
 where
 
-import Control.Lens (mapped, (&), (.~), (?~))
+import Control.Lens (mapped, (.~), (?~))
 import Data.Id (ScimTokenId, TeamId)
 import Data.Proxy (Proxy (Proxy))
 import Data.Swagger hiding (Header (..))
diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs
index efa304135e7..2fc47398a19 100644
--- a/services/spar/src/Spar/Types.hs
+++ b/services/spar/src/Spar/Types.hs
@@ -32,7 +32,6 @@ import Data.Id (ScimTokenId, TeamId, UserId)
 import Data.Json.Util
 import Data.Proxy (Proxy (Proxy))
 import Data.String.Conversions
-import Data.String.Conversions (ST)
 import qualified Data.Text as ST
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time
diff --git a/services/spar/test-integration/Test/Spar/AppSpec.hs b/services/spar/test-integration/Test/Spar/AppSpec.hs
index d49246c7b8e..341750a4c1e 100644
--- a/services/spar/test-integration/Test/Spar/AppSpec.hs
+++ b/services/spar/test-integration/Test/Spar/AppSpec.hs
@@ -30,7 +30,6 @@ import Data.Id
 import qualified Data.List as List
 import Data.String.Conversions
 import Imports
-import SAML2.Util ((-/))
 import SAML2.WebSSO as SAML
 import qualified SAML2.WebSSO.Test.MockResponse as SAML
 import qualified Servant
diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs
index 808e1d3f2e9..a49edaba146 100644
--- a/services/spar/test-integration/Test/Spar/DataSpec.hs
+++ b/services/spar/test-integration/Test/Spar/DataSpec.hs
@@ -27,7 +27,6 @@ import Cassandra
 import Control.Lens
 import Control.Monad.Except
 import Data.Kind (Type)
-import Data.Typeable (Typeable)
 import Data.UUID as UUID
 import Data.UUID.V4 as UUID
 import Imports
diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs
index 2f49c730e60..93daf8dbfe0 100644
--- a/services/spar/test-integration/Util/Core.hs
+++ b/services/spar/test-integration/Util/Core.hs
@@ -135,7 +135,6 @@ import Control.Exception
 import Control.Lens hiding ((.=))
 import Control.Monad.Catch
 import Control.Monad.Except
-import Control.Monad.Fail (MonadFail)
 import Control.Retry
 import Crypto.Random.Types (MonadRandom)
 import Data.Aeson as Aeson hiding (json)
diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs
index 5a28a8df5f1..313e4d0af0f 100644
--- a/services/spar/test-integration/Util/Scim.hs
+++ b/services/spar/test-integration/Util/Scim.hs
@@ -37,7 +37,6 @@ import qualified SAML2.WebSSO as SAML
 import SAML2.WebSSO.Types (IdPId, idpId)
 import Spar.Data as Data
 import qualified Spar.Intra.Brig as Intra
-import Spar.Scim (CreateScimToken (..), CreateScimTokenResponse (..), ScimTokenList (..))
 import Spar.Scim.Types
 import Spar.Scim.User (synthesizeScimUser, validateScimUser')
 import Spar.Types (IdP, IdPMetadataInfo (..), ScimToken (..), ScimTokenInfo (..))
diff --git a/stack-deps.nix b/stack-deps.nix
index d29487c53ba..ba6c69fd34a 100644
--- a/stack-deps.nix
+++ b/stack-deps.nix
@@ -17,5 +17,5 @@ pkgs.haskell.lib.buildStackProject {
     snappy
     zlib
   ];
-  ghc = pkgs.haskell.compiler.ghc865;
+  ghc = pkgs.haskell.compiler.ghc884;
 }
diff --git a/stack.yaml b/stack.yaml
index d417313b894..1281ef0a8a4 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-14.27
+resolver: lts-16.14
 
 packages:
 - libs/api-bot
@@ -55,7 +55,6 @@ nix:
 allow-newer: true
 
 extra-deps:
-- swagger2-2.4
 - git: https://github.com/fimad/prometheus-haskell
   commit: 2e3282e5fb27ba8d989c271a0a989823fad7ec43
   subdirs:
@@ -64,7 +63,7 @@ extra-deps:
   # a version > 1.0.0 of wai-middleware-prometheus is available
   # (required: https://github.com/fimad/prometheus-haskell/pull/45)
 - git: https://github.com/wireapp/saml2-web-sso
-  commit: 687d9ac8ac2994aff8436189c6ecce29faad8500  # master (May 18, 2020)
+  commit: 43c74bd44698e062abaa090c56de5272e66cee27  # master (Sep 24, 2020)
 
 - git: https://github.com/kim/hs-collectd
   commit: 885da222be2375f78c7be36127620ed772b677c9
@@ -75,10 +74,6 @@ extra-deps:
 - git: https://gitlab.com/twittner/wai-routing
   commit: 7e996a93fec5901767f845a50316b3c18e51a61d
 
-# Includes the changes from <https://gitlab.com/twittner/cql-io/merge_requests/14>
-# - git: https://gitlab.com/twittner/cql-io.git
-#   commit: 8b91d053c469887a427e8c075cef43139fa189c4
-
 #  Our fork of multihash with relaxed upper bounds
 - git: https://github.com/wireapp/haskell-multihash.git
   commit: 300a6f46384bfca33e545c8bab52ef3717452d12
@@ -88,7 +83,7 @@ extra-deps:
   commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25
 
 - git: https://github.com/wireapp/bloodhound
-  commit: 7d3ccf8039912829b26b8e47cc4eaabc98cb571a # (2020-05-25) branch: feature/reindex
+  commit: 8c2b6f77bf6cd2506ea0ad3c1cd1251c9f42545b # (2020-05-25) branch: wire-fork-ghc-8.8
 
 # For bloodhound
 - deriving-aeson-0.2.5@sha256:a1efa4ab7ff94f73e6d2733a9d4414cb4c3526761295722cff28027b5b3da1a4,1277
@@ -124,7 +119,7 @@ extra-deps:
   commit: 7546a1a25635ef65183e3d44c1052285e8401608    # master (Jul 21, 2016)
 
 - git: https://github.com/wireapp/hsaml2
-  commit: fe08618e81dee9b7a25f10f5b9d26d1ff1837c79    # master (Mar 25, 2020)
+  commit: 2ff7b0c11a9d510f1ec411f436bc134b216ebd4a   # pull-upstream (Aug 20, 2020)
 
 - git: https://github.com/wireapp/http-client
   commit: 9100baeddbd15d93dc58a826ae812dafff29d5fd    # master (Jun 16, 2020)
@@ -136,19 +131,13 @@ extra-deps:
 
 # Dropped from upstream snapshot
 - template-0.2.0.10
-- HaskellNet-0.5.1
-- HaskellNet-SSL-0.3.4.1
+- HaskellNet-0.5.2
 - snappy-0.2.0.2
 - smtp-mail-0.2.0.0
-- stm-containers-1.1.0.4
-- redis-io-1.0.0
+- stm-containers-1.1.0.4 # Latest: lts-15.16
 - redis-resp-1.0.0
-- hedgehog-quickcheck-0.1.1
-
-# Only in nightly
-- stm-hamt-1.2.0.4
-- optics-th-0.2
-- primitive-unlifted-0.1.2.0
+- stm-hamt-1.2.0.4 # Latest: lts-15.16
+- primitive-unlifted-0.1.2.0 # Latest: lts-15.16
 
 # Not on stackage
 - currency-codes-3.0.0.1
@@ -163,6 +152,7 @@ extra-deps:
 - base58-bytestring-0.1.0
 - stompl-0.5.0
 - pattern-trie-0.1.0
+- markov-chain-usage-model-0.0.0
 
 # Not latest as latst one breaks wai-routing
 - wai-route-0.4.0
@@ -171,8 +161,29 @@ extra-deps:
 - QuickCheck-2.14
 - splitmix-0.0.4 # needed for QuickCheck
 
-# Newer than the one one stackage
-- polysemy-1.3.0.0
+- HsOpenSSL-x509-system-0.1.0.3@sha256:f4958ee0eec555c5c213662eff6764bddefe5665e2afcfd32733ce3801a9b687,1774 # Latest: lts-14.27
+- cql-4.0.2@sha256:a0006a5ac13d6f86d5eff28c11be80928246309f217ea6d5f5c8a76a5d16b48b,3157 # Latest: lts-14.27
+- cql-io-1.1.1@sha256:897ef0811b227c8b1a269b29b9c1ebfb09c46f00d66834e2e8c6f19ea7f90f7d,4611 # Latest: lts-14.27
+- primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963 # Latest: lts-15.16
+- text-format-0.3.2@sha256:2a3fc17cf87120fcfdbca62a0da59759755549285841cdc1483081c35fb3d115,1814 # Latest: lts-14.27
+- hex-0.2.0@sha256:197d2561d2e216c4ead035b4911dabc6e678ac6257cb71b64e324c822f6f9f5a,726 # Latest: lts-14.27
+
+# Not in the upstream snapshot and not using latest version on hackage due to
+# breaking change
+- quickcheck-state-machine-0.6.0
+- servant-multipart-0.11.5@sha256:1633f715b5b53d648a1da69839bdc5046599f4f7244944d4bbf852dba38d8f4b,2319
+
+# Dependencies on upstream source
+
+# Required for GHC 8.8, but not released to hackage yet
+- git: https://github.com/dpwright/HaskellNet-SSL
+  commit: ca84ef29a93eaef7673fa58056cdd8dae1568d2d # master (Sep 14, 2020)
+
+# Forks with pending PRs
+- git: https://gitlab.com/axeman/wai-predicates.git
+  commit: 999d195b27104b9b39174f5ce18f5214b018a177 # ghc-8.8 (Sep 14, 2020, PR: https://gitlab.com/twittner/wai-predicates/-/merge_requests/1)
+- git: https://gitlab.com/axeman/redis-io.git
+  commit: a0f39b1c517df21ad284ff91ecb062cbe41a4ad1 # ghc-8.8 (Sep 21 , 2020, https://gitlab.com/twittner/redis-io/-/merge_requests/5)
 
 ############################################################
 # Development tools
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 1d2d2035253..c85507bf2fc 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -4,13 +4,6 @@
 #   https://docs.haskellstack.org/en/stable/lock_files
 
 packages:
-- completed:
-    hackage: swagger2-2.4@sha256:3fde8c2c6bc091738cba62e63c29d690b711848560d86e82615516869f76140b,4415
-    pantry-tree:
-      size: 2192
-      sha256: f4ae95200dfc2f44699a39f533dd6889107aff61f52e988c13edad8fcb30faef
-  original:
-    hackage: swagger2-2.4
 - completed:
     subdir: wai-middleware-prometheus
     name: wai-middleware-prometheus
@@ -29,12 +22,12 @@ packages:
     version: '0.18'
     git: https://github.com/wireapp/saml2-web-sso
     pantry-tree:
-      size: 4601
-      sha256: 58cd6e1435b4ad530b99de3f9c7ffbf7d8644ebc75f2da22b2521e4347a92701
-    commit: 687d9ac8ac2994aff8436189c6ecce29faad8500
+      size: 4657
+      sha256: c1c5ff18a9c8996aa33dd571662033928cda4ae4ebcda98b6777f8ebd0cc7102
+    commit: 43c74bd44698e062abaa090c56de5272e66cee27
   original:
     git: https://github.com/wireapp/saml2-web-sso
-    commit: 687d9ac8ac2994aff8436189c6ecce29faad8500
+    commit: 43c74bd44698e062abaa090c56de5272e66cee27
 - completed:
     name: collectd
     version: 0.0.0.2
@@ -90,17 +83,6 @@ packages:
   original:
     git: https://github.com/wireapp/hspec-wai
     commit: 0a5142cd3ba48116ff059c041348b817fb7bdb25
-- completed:
-    name: bloodhound
-    version: 0.17.0.0
-    git: https://github.com/wireapp/bloodhound
-    pantry-tree:
-      size: 4343
-      sha256: f3d35894f570e67a68303e71134a722909151f4de232093375a63b7935a4b761
-    commit: 7d3ccf8039912829b26b8e47cc4eaabc98cb571a
-  original:
-    git: https://github.com/wireapp/bloodhound
-    commit: 7d3ccf8039912829b26b8e47cc4eaabc98cb571a
 - completed:
     hackage: deriving-aeson-0.2.5@sha256:a1efa4ab7ff94f73e6d2733a9d4414cb4c3526761295722cff28027b5b3da1a4,1277
     pantry-tree:
@@ -252,11 +234,11 @@ packages:
     git: https://github.com/wireapp/hsaml2
     pantry-tree:
       size: 3918
-      sha256: a90ad3e25ab6ba579ea4d347c8734f92f73e323303c91d53729ddc8784774f72
-    commit: fe08618e81dee9b7a25f10f5b9d26d1ff1837c79
+      sha256: c2f2849bc28cc7fb8a4ec843dbc7606df179915dc54c5cc2aa2e30b974ef3d61
+    commit: 2ff7b0c11a9d510f1ec411f436bc134b216ebd4a
   original:
     git: https://github.com/wireapp/hsaml2
-    commit: fe08618e81dee9b7a25f10f5b9d26d1ff1837c79
+    commit: 2ff7b0c11a9d510f1ec411f436bc134b216ebd4a
 - completed:
     subdir: http-client
     name: http-client
@@ -317,19 +299,12 @@ packages:
   original:
     hackage: template-0.2.0.10
 - completed:
-    hackage: HaskellNet-0.5.1@sha256:53f2cfffb140740691296f905a70143c859b571eea3f5cf5f7a4642851d9e38a,1584
+    hackage: HaskellNet-0.5.2@sha256:77fb8466fcbeb76f17366ffd7deb37550b6ea08a4d08bf721d0b597c2573336d,2069
     pantry-tree:
-      size: 1437
-      sha256: e0806ea13b946dfc785bf9580e126cfcb8d3c6f21e1fbe313374745c3a8a8b99
+      size: 1499
+      sha256: 20f0361675729e606fb37b8a1865f4bd49d952f2d0148693b62f68fadf5801d5
   original:
-    hackage: HaskellNet-0.5.1
-- completed:
-    hackage: HaskellNet-SSL-0.3.4.1@sha256:3ca14dd69460a380cf69aed40654fb10c4c03e344632b6a9986568c87feda157,1843
-    pantry-tree:
-      size: 577
-      sha256: 33fbfd0d8bbaa689f0169d442861dafcdcd4fe795a4b42aa0bedbfa41aa65b23
-  original:
-    hackage: HaskellNet-SSL-0.3.4.1
+    hackage: HaskellNet-0.5.2
 - completed:
     hackage: snappy-0.2.0.2@sha256:2931b03c5fdab2dac8d7eadb3be2f4ef8906666e43f1f1db65a06efd57ea701b,1591
     pantry-tree:
@@ -351,13 +326,6 @@ packages:
       sha256: 059c5a2d657d392aca0a887648f57380d6321734dc8879c056a44d4414308ac6
   original:
     hackage: stm-containers-1.1.0.4
-- completed:
-    hackage: redis-io-1.0.0@sha256:8885d41408ec7305d7503e21bd3f334fb02fb2367d26b9998d8a6fcbccf8339b,2734
-    pantry-tree:
-      size: 855
-      sha256: ed28c921459e22410513f00d97c9915bcba7f7b083a8b80d067fc5c5114a9db1
-  original:
-    hackage: redis-io-1.0.0
 - completed:
     hackage: redis-resp-1.0.0@sha256:c134ac23e79d57071fdc8559e2b2e72280ea11786a8ba4118c10ed506dc7d991,1615
     pantry-tree:
@@ -365,13 +333,6 @@ packages:
       sha256: c63020c2f2ca4f92c4747959a2e89e84bdd929d1ea1458c75552ee3f7aaa00fc
   original:
     hackage: redis-resp-1.0.0
-- completed:
-    hackage: hedgehog-quickcheck-0.1.1@sha256:7f4d4197d65314b0117857ff7e530d84f456b124e93024952bf9b01d8c1cc1b2,1552
-    pantry-tree:
-      size: 407
-      sha256: 2052d8dae458f1832b598a8de139eb91dfb23432a52fec16e9d48f90909fdc17
-  original:
-    hackage: hedgehog-quickcheck-0.1.1
 - completed:
     hackage: stm-hamt-1.2.0.4@sha256:7957497c022554b7599e790696d1a3e56359ad99e5da36a251894c626ca1f60a,3970
     pantry-tree:
@@ -379,13 +340,6 @@ packages:
       sha256: d9a8be48da86bd4a2ba9d52ea29b9a74f1b686d439ba1bbfba04ab1a002391da
   original:
     hackage: stm-hamt-1.2.0.4
-- completed:
-    hackage: optics-th-0.2@sha256:b4f6c5a3f134c697837190ed6da969dd284aefe79e43c3ef793093b607bb83b9,1929
-    pantry-tree:
-      size: 653
-      sha256: f6b5caed956d3761b35769ac518d3f0f407449dafe33154992386f02d9489bad
-  original:
-    hackage: optics-th-0.2
 - completed:
     hackage: primitive-unlifted-0.1.2.0@sha256:9c3df73af54ed19fb3f4874da19334863cc414b22e578e27b5f52beeac4a60dd,1360
     pantry-tree:
@@ -477,6 +431,13 @@ packages:
       sha256: 9cf57bcb24b5da4d9ab314750810dce6c28ae082348e0afd60bdb12afdeeca6f
   original:
     hackage: pattern-trie-0.1.0
+- completed:
+    hackage: markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
+    pantry-tree:
+      size: 432
+      sha256: 6871bd9281acf589296d0998a3d62892b036040ab10e74e8a0f356f68c194f4f
+  original:
+    hackage: markov-chain-usage-model-0.0.0
 - completed:
     hackage: wai-route-0.4.0@sha256:ee52f13d2945e4a56147e91e515e184f840654f2e3d9071c73bec3d8aa1f4444,2119
     pantry-tree:
@@ -499,12 +460,94 @@ packages:
   original:
     hackage: splitmix-0.0.4
 - completed:
-    hackage: polysemy-1.3.0.0@sha256:fa76e96a883fd1c4bdbad792a0a9d88f59f84817651aea5c71d9b4f74e42c5b6,6141
+    hackage: HsOpenSSL-x509-system-0.1.0.3@sha256:f4958ee0eec555c5c213662eff6764bddefe5665e2afcfd32733ce3801a9b687,1774
+    pantry-tree:
+      size: 503
+      sha256: 2a097abbccc0382ebb565c8ab9932628f33471607c2174303c3c930d7685bd18
+  original:
+    hackage: HsOpenSSL-x509-system-0.1.0.3@sha256:f4958ee0eec555c5c213662eff6764bddefe5665e2afcfd32733ce3801a9b687,1774
+- completed:
+    hackage: cql-4.0.2@sha256:a0006a5ac13d6f86d5eff28c11be80928246309f217ea6d5f5c8a76a5d16b48b,3157
+    pantry-tree:
+      size: 1281
+      sha256: 8cc6e57c6a794188ae79415cee38bd29e1c07f7426cfa533c9a57523c0a2ed23
+  original:
+    hackage: cql-4.0.2@sha256:a0006a5ac13d6f86d5eff28c11be80928246309f217ea6d5f5c8a76a5d16b48b,3157
+- completed:
+    hackage: cql-io-1.1.1@sha256:897ef0811b227c8b1a269b29b9c1ebfb09c46f00d66834e2e8c6f19ea7f90f7d,4611
+    pantry-tree:
+      size: 2067
+      sha256: 7ced76ae95b51fa1669b4fcaeec3825b5cb8cf1f4e37c53d0bddf6234742eba8
+  original:
+    hackage: cql-io-1.1.1@sha256:897ef0811b227c8b1a269b29b9c1ebfb09c46f00d66834e2e8c6f19ea7f90f7d,4611
+- completed:
+    hackage: primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
+    pantry-tree:
+      size: 1105
+      sha256: e7c1d26202b80d1fca2ef780ec7fe76ede1275f4d9a996c6d44c08d8de1c45db
+  original:
+    hackage: primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
+- completed:
+    hackage: text-format-0.3.2@sha256:2a3fc17cf87120fcfdbca62a0da59759755549285841cdc1483081c35fb3d115,1814
+    pantry-tree:
+      size: 1029
+      sha256: 2db26ddb77184186e0d5b2b020bdfbeb044c168024767b1fa3691682ca618896
+  original:
+    hackage: text-format-0.3.2@sha256:2a3fc17cf87120fcfdbca62a0da59759755549285841cdc1483081c35fb3d115,1814
+- completed:
+    hackage: hex-0.2.0@sha256:197d2561d2e216c4ead035b4911dabc6e678ac6257cb71b64e324c822f6f9f5a,726
+    pantry-tree:
+      size: 197
+      sha256: 1e5aba0165fb8ffa93d1516a87026a59c245750ca5f2ed42bd53b8328620f98e
+  original:
+    hackage: hex-0.2.0@sha256:197d2561d2e216c4ead035b4911dabc6e678ac6257cb71b64e324c822f6f9f5a,726
+- completed:
+    hackage: quickcheck-state-machine-0.6.0@sha256:3e4f8df0f6b5d415e3c8840dc75034a63e37f56f5f8cfa1035ded16345235ac4,3825
+    pantry-tree:
+      size: 1926
+      sha256: ae502fd7f4c6680294149bed482d1896904c1259d5ae614093da01e0731ec92e
+  original:
+    hackage: quickcheck-state-machine-0.6.0
+- completed:
+    hackage: servant-multipart-0.11.5@sha256:1633f715b5b53d648a1da69839bdc5046599f4f7244944d4bbf852dba38d8f4b,2319
+    pantry-tree:
+      size: 333
+      sha256: b3e1fd2ad2e654475be000c2f0ac6f717b5499436fa73eec50ceccddf352dcec
+  original:
+    hackage: servant-multipart-0.11.5@sha256:1633f715b5b53d648a1da69839bdc5046599f4f7244944d4bbf852dba38d8f4b,2319
+- completed:
+    name: HaskellNet-SSL
+    version: 0.3.4.2
+    git: https://github.com/dpwright/HaskellNet-SSL
+    pantry-tree:
+      size: 786
+      sha256: c6a64c9e64bc834842756be28eaac2d842f0dde3753542bfa0cfd87ae5cf0bc5
+    commit: ca84ef29a93eaef7673fa58056cdd8dae1568d2d
+  original:
+    git: https://github.com/dpwright/HaskellNet-SSL
+    commit: ca84ef29a93eaef7673fa58056cdd8dae1568d2d
+- completed:
+    name: wai-predicates
+    version: 0.10.0
+    git: https://gitlab.com/axeman/wai-predicates.git
+    pantry-tree:
+      size: 1585
+      sha256: 8675a538bbbfb171b9d565831f333e443118ea5a70b1be8bffa635cb847d04fa
+    commit: 999d195b27104b9b39174f5ce18f5214b018a177
+  original:
+    git: https://gitlab.com/axeman/wai-predicates.git
+    commit: 999d195b27104b9b39174f5ce18f5214b018a177
+- completed:
+    name: redis-io
+    version: 1.0.0
+    git: https://gitlab.com/axeman/redis-io.git
     pantry-tree:
-      size: 4309
-      sha256: 3d2fb15ddda9053f6bfd4b0810a79a9542505acb5e7e528856ec3cd86d6df066
+      size: 912
+      sha256: 3e8093b581c621df7ecbf2f6f79686afdea8bfeb56f0e546fff1e9d86de3bf80
+    commit: a0f39b1c517df21ad284ff91ecb062cbe41a4ad1
   original:
-    hackage: polysemy-1.3.0.0
+    git: https://gitlab.com/axeman/redis-io.git
+    commit: a0f39b1c517df21ad284ff91ecb062cbe41a4ad1
 - completed:
     hackage: ormolu-0.1.2.0@sha256:24e6512750576978b6f045c1e53a7aad28ab61960f738a3c74fb0bc2beaf4030,6237
     pantry-tree:
@@ -528,7 +571,7 @@ packages:
     hackage: headroom-0.2.1.0
 snapshots:
 - completed:
-    size: 524996
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml
-    sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0
-  original: lts-14.27
+    size: 532382
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/14.yaml
+    sha256: 1ef27e36f38824abafc43224ca612211b3828fa9ffd31ba0fc2867ae2e19ba90
+  original: lts-16.14
diff --git a/tools/bonanza/bonanza.cabal b/tools/bonanza/bonanza.cabal
index c49b73b1b88..d504e7f8743 100644
--- a/tools/bonanza/bonanza.cabal
+++ b/tools/bonanza/bonanza.cabal
@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.31.2.
+-- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 8d08766e828f1eb6b5314808808037082ec748509c5640b48410a0691beeaa1a
+-- hash: c65bea2c25598cbdee588334b4a36a838abbe0612536a104ef9be32b01c3078b
 
 name:           bonanza
 version:        3.6.0
@@ -71,6 +71,7 @@ library
     , lens-aeson
     , mtl
     , network
+    , network-bsd
     , optparse-applicative >=0.11
     , protobuf >=0.2.1.1
     , resourcet
@@ -78,7 +79,7 @@ library
     , snappy
     , snappy-framing
     , text
-    , time >=1.5 && <1.9
+    , time >=1.5
     , types-common >=0.14.1
     , unordered-containers
     , vector
diff --git a/tools/bonanza/package.yaml b/tools/bonanza/package.yaml
index b544e420999..82d5320f845 100644
--- a/tools/bonanza/package.yaml
+++ b/tools/bonanza/package.yaml
@@ -40,12 +40,13 @@ library:
   - lens-aeson
   - mtl
   - network
+  - network-bsd
   - optparse-applicative >=0.11
   - protobuf >=0.2.1.1
   - scientific
   - snappy
   - snappy-framing
-  - time >=1.5 && <1.9
+  - time >=1.5
   - types-common >=0.14.1
   - unordered-containers
   - vector
diff --git a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs
index dccf2a3c018..9401e30261c 100644
--- a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs
+++ b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs
@@ -376,23 +376,24 @@ instance Arbitrary (ParseInput (NginzLogRecord)) where
     where
       genFields :: Gen [(Text, CommonLogField)]
       genFields =
-        mapM
-          (\(f, g) -> f <$> g)
-          [ ((,) "status", genIntField),
-            ((,) "body_bytes_sent", genIntField),
-            ((,) "http_referer", genStringField),
-            ((,) "http_user_agent", genStringField),
-            ((,) "http_x_forwarded_for", genIPv4Field),
-            ((,) "separator", genEmptyField),
-            ((,) "connection", genIntField),
-            ((,) "request_time", genDoubleField),
-            ((,) "upstream_response_time", genDoubleField),
-            ((,) "upstream_cache_status", genStringField),
-            ((,) "user", genStringField),
-            ((,) "zconn", genStringField),
-            ((,) "request", genStringField),
-            ((,) "proxy_protocol_addr", genIPv4Field)
-          ]
+        sequence $
+          map
+            (\(f, g) -> (f,) <$> g)
+            [ ("status", genIntField),
+              ("body_bytes_sent", genIntField),
+              ("http_referer", genStringField),
+              ("http_user_agent", genStringField),
+              ("http_x_forwarded_for", genIPv4Field),
+              ("separator", genEmptyField),
+              ("connection", genIntField),
+              ("request_time", genDoubleField),
+              ("upstream_response_time", genDoubleField),
+              ("upstream_cache_status", genStringField),
+              ("user", genStringField),
+              ("zconn", genStringField),
+              ("request", genStringField),
+              ("proxy_protocol_addr", genIPv4Field)
+            ]
       genIntField :: Gen CommonLogField
       genIntField =
         maybe CEmpty (CField . Number . fromIntegral . getNonNegative)
diff --git a/tools/db/find-undead/src/Work.hs b/tools/db/find-undead/src/Work.hs
index f60e30f9719..70d1675aa79 100644
--- a/tools/db/find-undead/src/Work.hs
+++ b/tools/db/find-undead/src/Work.hs
@@ -139,5 +139,5 @@ instance Cql AccountStatus where
     1 -> return Suspended
     2 -> return Deleted
     3 -> return Ephemeral
-    n -> fail $ "unexpected account status: " ++ show n
-  fromCql _ = fail "account status: int expected"
+    n -> Left $ "unexpected account status: " ++ show n
+  fromCql _ = Left "account status: int expected"
diff --git a/tools/makedeb/src/System/MakeDeb.hs b/tools/makedeb/src/System/MakeDeb.hs
index 8211c7000a9..6729bcfc71b 100644
--- a/tools/makedeb/src/System/MakeDeb.hs
+++ b/tools/makedeb/src/System/MakeDeb.hs
@@ -30,10 +30,10 @@ where
 import Data.Text (pack)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
-import Filesystem.Path.CurrentOS (decodeString, encodeString)
+import Filesystem.Path.CurrentOS (FilePath, decodeString, encodeString)
 import Imports hiding (FilePath)
 import Options.Applicative
-import Shelly
+import Shelly hiding (FilePath)
 import System.MakeDeb.FileUtils
 
 data MakeDebOpts = MakeDebOpts
@@ -99,19 +99,19 @@ options =
 
 makeDeb :: MakeDebOpts -> IO ()
 makeDeb opts = shelly . silently . withTmpDir $ \tmp -> do
-  void . escaping False $ cmd "cp" "-R" "-L" (deb opts </> "*") tmp
-  let opts' = opts {deb = tmp}
+  void . escaping False $ run "cp" ["-R", "-L", Text.pack $ encodeString (deb opts) </> "*", Text.pack tmp]
+  let opts' = opts {deb = decodeString tmp}
   substitute opts'
   package opts'
 
 package :: MakeDebOpts -> Sh ()
 package MakeDebOpts {..} = do
   let f = name <> "_" <> version <> "+" <> build <> "_" <> arch
-  cmd "dpkg-deb" "-b" deb (out </> fromText f <.> "deb")
+  run_ "dpkg-deb" ["-b", Text.pack $ encodeString deb, Text.pack $ encodeString out </> fromText f <.> "deb"]
 
 substitute :: MakeDebOpts -> Sh ()
 substitute MakeDebOpts {..} = flip traverseFiles (encodeString deb) $ \fname -> do
-  mime <- cmd "file" "--brief" "--mime" (decodeString fname)
+  mime <- run "file" ["--brief", "--mime", Text.pack fname]
   when ("text/plain" `Text.isPrefixOf` mime) $
     replace
       [ ("<<VERSION_NUMBER>>", version),
diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs
index 4368489f85b..1e20b506dc4 100644
--- a/tools/stern/src/Stern/API.hs
+++ b/tools/stern/src/Stern/API.hs
@@ -29,13 +29,10 @@ where
 
 import Brig.Types
 import Brig.Types.Intra
-import Control.Applicative ((<|>))
 import Control.Error
 import Control.Lens ((^.))
-import Control.Monad (liftM, void, when)
 import Data.Aeson hiding (Error, json)
 import Data.Aeson.Types (emptyArray)
-import Data.ByteString (ByteString)
 import Data.ByteString.Conversion
 import Data.ByteString.Lazy (fromStrict)
 import Data.Handle (Handle)
@@ -45,7 +42,7 @@ import Data.Predicate
 import Data.Range
 import Data.Swagger.Build.Api hiding (Response, def, min, response)
 import qualified Data.Swagger.Build.Api as Doc
-import Data.Text (Text, unpack)
+import Data.Text (unpack)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import qualified Galley.Types.Teams.SearchVisibility as Team
diff --git a/tools/stern/src/Stern/API/Predicates.hs b/tools/stern/src/Stern/API/Predicates.hs
index 1d48ddb128d..5992d1254bb 100644
--- a/tools/stern/src/Stern/API/Predicates.hs
+++ b/tools/stern/src/Stern/API/Predicates.hs
@@ -23,7 +23,6 @@ module Stern.API.Predicates
 where
 
 import Brig.Types
-import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as Char8
 import Data.ByteString.Conversion
 import qualified Data.Char as Char
diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs
index fc5132def11..e5fd8e80382 100644
--- a/tools/stern/src/Stern/App.hs
+++ b/tools/stern/src/Stern/App.hs
@@ -24,7 +24,6 @@
 module Stern.App where
 
 import qualified Bilge
-import qualified Bilge.IO as Bilge (withResponse)
 import Bilge.RPC (HasRequestId (..))
 import Control.Error
 import Control.Lens (makeLenses, set, view, (^.))
@@ -32,7 +31,6 @@ import Control.Monad.Catch (MonadCatch, MonadThrow)
 import Control.Monad.IO.Class
 import Control.Monad.Reader.Class
 import Control.Monad.Trans.Class
-import Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
 import Data.ByteString.Conversion (toByteString')
 import Data.Default (def)
 import Data.Id (UserId)
diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs
index bb8a891512f..8fc0645b991 100644
--- a/tools/stern/src/Stern/Intra.hs
+++ b/tools/stern/src/Stern/Intra.hs
@@ -67,7 +67,6 @@ import Control.Lens (view, (^.))
 import Control.Monad.Reader
 import Data.Aeson hiding (Error)
 import Data.Aeson.Types (emptyArray)
-import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Conversion
 import Data.Handle (Handle)
@@ -75,7 +74,7 @@ import qualified Data.HashMap.Strict as M
 import Data.Id
 import Data.Int
 import Data.List.Split (chunksOf)
-import Data.Text (Text, strip)
+import Data.Text (strip)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Text.Lazy (pack)
 import Galley.Types

From 32f7adc1541eedd9f2a463f3b353d59e5d3b6b3a Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Tue, 29 Sep 2020 11:57:32 +0200
Subject: [PATCH 09/11] =?UTF-8?q?limit=20list=20of=20SFT=20servers=20to=20?=
 =?UTF-8?q?5=20(configurable),=20independent=20of=20the=20amount=20of=20se?=
 =?UTF-8?q?rvers=20=E2=80=A6=20(#1206)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

limit list of SFT servers to 6, independent of the amount of servers in the SRV record.

Co-authored-by: Akshay Mankar <akshay@wire.com>
---
 libs/dns-util/src/Wire/Network/DNS/SRV.hs     |  4 +-
 services/brig/brig.cabal                      |  3 +-
 services/brig/package.yaml                    |  3 +-
 services/brig/src/Brig/Calling.hs             | 83 +++++++++++++++++--
 services/brig/src/Brig/Calling/API.hs         | 25 +++---
 services/brig/src/Brig/Options.hs             |  8 +-
 services/brig/test/integration/API/Calling.hs |  2 +-
 services/brig/test/unit/Test/Brig/Calling.hs  | 53 ++++++++++--
 8 files changed, 144 insertions(+), 37 deletions(-)

diff --git a/libs/dns-util/src/Wire/Network/DNS/SRV.hs b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
index 27105010929..168a75cdbc5 100644
--- a/libs/dns-util/src/Wire/Network/DNS/SRV.hs
+++ b/libs/dns-util/src/Wire/Network/DNS/SRV.hs
@@ -68,7 +68,7 @@ data SrvEntry = SrvEntry
     srvWeight :: !Word16,
     srvTarget :: !SrvTarget
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Ord)
 
 data SrvTarget = SrvTarget
   { -- | the hostname on which the service is offered
@@ -76,7 +76,7 @@ data SrvTarget = SrvTarget
     -- | the port on which the service is offered
     srvTargetPort :: !Word16
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Ord)
 
 data SrvResponse
   = SrvNotAvailable
diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index 5ec599d4eca..9644c25c0bd 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0efba75abb2e931761d20c36d7c690eb2cf9711711c4b002dfd2cd5ff7bd60ee
+-- hash: 7c9aee98315a9a56aa48fcb0af9a9e82954d9913fc94cafa512a0811f40b2ad3
 
 name:           brig
 version:        1.35.0
@@ -450,6 +450,7 @@ test-suite brig-tests
     , bloodhound
     , brig
     , brig-types
+    , containers
     , dns
     , dns-util
     , imports
diff --git a/services/brig/package.yaml b/services/brig/package.yaml
index 8e6e3f711be..4fabcbba96d 100644
--- a/services/brig/package.yaml
+++ b/services/brig/package.yaml
@@ -144,10 +144,11 @@ tests:
     - bloodhound
     - brig
     - brig-types
+    - containers
     - dns
     - dns-util
-    - polysemy
     - imports
+    - polysemy
     - retry
     - tasty
     - tasty-hunit
diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs
index 61fdf80e98f..ef2ee3f04f1 100644
--- a/services/brig/src/Brig/Calling.hs
+++ b/services/brig/src/Brig/Calling.hs
@@ -17,15 +17,40 @@
 -- 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 Brig.Calling where
-
-import Brig.Options (SFTOptions (..), defSftDiscoveryIntervalSeconds, defSftServiceName)
+module Brig.Calling
+  ( getRandomSFTServers,
+    mkSFTDomain,
+    SFTServers, -- See NOTE SFTServers
+    mkSFTServers,
+    SFTEnv (..),
+    Discovery (..),
+    Env (..),
+    mkSFTEnv,
+    newEnv,
+    sftDiscoveryLoop,
+    discoverSFTServers,
+    discoveryToMaybe,
+    randomize,
+    startSFTServiceDiscovery,
+    turnServers,
+    turnTokenTTL,
+    turnConfigTTL,
+    turnSecret,
+    turnSHA512,
+    turnPrng,
+  )
+where
+
+import Brig.Options (SFTOptions (..), defSftDiscoveryIntervalSeconds, defSftListLength, defSftServiceName)
 import qualified Brig.Options as Opts
 import Brig.PolyLog
 import Brig.Types (TurnURI)
 import Control.Lens
-import Data.List.NonEmpty
+import Control.Monad.Random.Class (MonadRandom)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.List1
+import Data.Range
 import Data.Time.Clock (DiffTime, diffTimeToPicoseconds)
 import Imports
 import qualified Network.DNS as DNS
@@ -33,17 +58,58 @@ import OpenSSL.EVP.Digest (Digest)
 import Polysemy
 import qualified System.Logger as Log
 import System.Random.MWC (GenIO, createSystemRandom)
+import System.Random.Shuffle
 import Wire.Network.DNS.Effect
 import Wire.Network.DNS.SRV
 
+-- | NOTE SFTServers:
+-- Retrieving SFTServers should give a 1) randomized and 2) limited list of servers.
+-- Random as a (poor) way of "load balancing" for clients
+-- And limited since client currently try contacting all servers returned
+-- (and we don't want them to open 100 parallel connections unnecessarily)
+-- Therefore, we hide the constructor from the module export.
+newtype SFTServers = SFTServers (NonEmpty SrvEntry)
+  deriving (Eq, Show)
+
+mkSFTServers :: NonEmpty SrvEntry -> SFTServers
+mkSFTServers = SFTServers
+
+type MaximumSFTServers = 100
+
+-- | According to RFC2782, the SRV Entries are supposed to be tried in order of
+-- priority and weight, but we internally agreed to randomize the list of
+-- available servers for poor man's "load balancing" purposes.
+-- FUTUREWORK: be smarter about list orderding depending on how much capacity SFT servers have.
+-- randomizedSftEntries <- liftIO $ mapM randomize sftSrvEntries
+--
+-- Currently (Sept 2020) the client initiating an SFT call will try all
+-- servers in this list. Limit this list to a smaller subset in case many
+-- SFT servers are advertised in a given environment.
+getRandomSFTServers :: MonadRandom m => Range 1 MaximumSFTServers Int -> SFTServers -> m (NonEmpty SrvEntry)
+getRandomSFTServers limit (SFTServers list) = subsetSft limit <$> randomize list
+
+subsetSft :: Range 1 100 Int -> NonEmpty a -> NonEmpty a
+subsetSft l entries = do
+  let entry1 = NonEmpty.head entries
+  let entryTail = take (fromRange l - 1) (NonEmpty.tail entries)
+  entry1 :| entryTail
+
+-- | Note: Even though 'shuffleM' works only for [a], input is NonEmpty so it's
+-- safe to NonEmpty.fromList; ideally, we'd have 'shuffleM' for 'NonEmpty'
+randomize :: (MonadRandom m) => NonEmpty a -> m (NonEmpty a)
+randomize xs = NonEmpty.fromList <$> shuffleM (NonEmpty.toList xs)
+
 data SFTEnv = SFTEnv
   { -- | Starts off as `NotDiscoveredYet`, once it has servers, it should never
     -- go back to `NotDiscoveredYet` and continue having stale values if
-    -- subsequent discovries fail
-    sftServers :: IORef (Discovery (NonEmpty SrvEntry)),
+    -- subsequent discoveries fail
+    sftServers :: IORef (Discovery SFTServers),
     sftDomain :: DNS.Domain,
     -- | Microseconds, as expected by 'threadDelay'
-    sftDiscoveryInterval :: Int
+    sftDiscoveryInterval :: Int,
+    -- | maximum amount of servers to give out,
+    -- even if more are in the SRV record
+    sftListLength :: Range 1 100 Int
   }
 
 data Discovery a
@@ -77,7 +143,7 @@ sftDiscoveryLoop SFTEnv {..} = forever $ do
   servers <- discoverSFTServers sftDomain
   case servers of
     Nothing -> pure ()
-    Just es -> atomicWriteIORef sftServers (Discovered es)
+    Just es -> atomicWriteIORef sftServers (Discovered (SFTServers es))
   threadDelay sftDiscoveryInterval
 
 mkSFTEnv :: SFTOptions -> IO SFTEnv
@@ -86,6 +152,7 @@ mkSFTEnv opts =
     <$> newIORef NotDiscoveredYet
     <*> pure (mkSFTDomain opts)
     <*> pure (diffTimeToMicroseconds (fromMaybe defSftDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts)))
+    <*> pure (fromMaybe defSftListLength (Opts.sftListLength opts))
 
 startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO ()
 startSFTServiceDiscovery logger =
diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs
index 1bcb262f42b..efae6b41812 100644
--- a/services/brig/src/Brig/Calling/API.hs
+++ b/services/brig/src/Brig/Calling/API.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BlockArguments #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <opensource@wire.com>
@@ -26,7 +28,6 @@ import Brig.Calling
 import qualified Brig.Calling as Calling
 import Brig.Calling.Internal
 import Control.Lens
-import Control.Monad.Random.Class
 import Data.ByteString.Conversion (toByteString')
 import Data.ByteString.Lens
 import Data.Id
@@ -46,7 +47,6 @@ import Network.Wai.Utilities hiding (code, message)
 import Network.Wai.Utilities.Swagger (document)
 import OpenSSL.EVP.Digest (Digest, hmacBS)
 import qualified System.Random.MWC as MWC
-import System.Random.Shuffle
 import qualified Wire.API.Call.Config as Public
 import Wire.Network.DNS.SRV (srvTarget)
 
@@ -122,19 +122,16 @@ newConfig env mSftEnv limit = do
   srvs <- for finalUris $ \uri -> do
     u <- liftIO $ genUsername tTTL prng
     pure $ Public.rtcIceServer (uri :| []) u (computeCred sha secret u)
-  sftSrvEntries <- maybe (pure Nothing) ((fmap discoveryToMaybe) . readIORef . sftServers) mSftEnv
-  -- According to RFC2782, the SRV Entries are supposed to be tried in order of
-  -- priority and weight, but we internally agreed to randomize the list of
-  -- available servers for poor man's "load balancing" purposes.
-  -- FUTUREWORK: be smarter about list orderding depending on how much capacity SFT servers have.
-  randomizedSftEntries <- liftIO $ mapM randomize sftSrvEntries
-  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> randomizedSftEntries) cTTL
+  sftEntries <- case mSftEnv of
+    Nothing -> pure Nothing
+    Just actualSftEnv -> do
+      sftSrvEntries <- fmap discoveryToMaybe . readIORef . sftServers $ actualSftEnv
+
+      let subsetLength = Calling.sftListLength actualSftEnv
+      liftIO $ mapM (getRandomSFTServers subsetLength) sftSrvEntries
+
+  pure $ Public.rtcConfiguration srvs (sftServerFromSrvTarget . srvTarget <$$> sftEntries) cTTL
   where
-    -- NOTE: even though `shuffleM` works only for [a], input is List1 so it's
-    --       safe to pattern match; ideally, we'd have `shuffleM` for `NonEmpty`
-    randomize :: (MonadRandom m, MonadFail m) => NonEmpty a -> m (NonEmpty a)
-    randomize xs = NonEmpty.fromList <$> shuffleM (NonEmpty.toList xs)
-    --
     limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI
     limitedList uris lim =
       -- assuming limitServers is safe with respect to the length of its return value
diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
index 2e6937862bc..7a9ba2046f2 100644
--- a/services/brig/src/Brig/Options.hs
+++ b/services/brig/src/Brig/Options.hs
@@ -33,6 +33,7 @@ import Data.Aeson.Types (typeMismatch)
 import qualified Data.Char as Char
 import Data.Domain (Domain)
 import Data.Id
+import Data.Range
 import Data.Scientific (toBoundedInteger)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
@@ -524,7 +525,8 @@ newtype DomainsBlockedForRegistration = DomainsBlockedForRegistration [Domain]
 data SFTOptions = SFTOptions
   { sftBaseDomain :: !DNS.Domain,
     sftSRVServiceName :: !(Maybe ByteString), -- defaults to defSftServiceName if unset
-    sftDiscoveryIntervalSeconds :: !(Maybe DiffTime) -- defaults to defSftDiscoveryIntervalSeconds
+    sftDiscoveryIntervalSeconds :: !(Maybe DiffTime), -- defaults to defSftDiscoveryIntervalSeconds
+    sftListLength :: !(Maybe (Range 1 100 Int)) -- defaults to defSftListLength
   }
   deriving (Show, Generic)
 
@@ -534,6 +536,7 @@ instance FromJSON SFTOptions where
       <$> (asciiOnly =<< o .: "sftBaseDomain")
       <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName")
       <*> (secondsToDiffTime <$$> o .:? "sftDiscoveryIntervalSeconds")
+      <*> (o .:? "sftListLength")
     where
       asciiOnly :: Text -> Y.Parser ByteString
       asciiOnly t =
@@ -562,6 +565,9 @@ defSftServiceName = "_sft"
 defSftDiscoveryIntervalSeconds :: DiffTime
 defSftDiscoveryIntervalSeconds = secondsToDiffTime 10
 
+defSftListLength :: Range 1 100 Int
+defSftListLength = unsafeRange 5
+
 instance FromJSON Timeout where
   parseJSON (Y.Number n) =
     let defaultV = 3600
diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs
index 1f693223de9..d84af24dd73 100644
--- a/services/brig/test/integration/API/Calling.hs
+++ b/services/brig/test/integration/API/Calling.hs
@@ -93,7 +93,7 @@ testSFT b opts = do
       "when SFT discovery is not enabled, sft_servers shouldn't be returned"
       Nothing
       (cfg ^. rtcConfSftServers)
-  withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001)) $ do
+  withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing) $ do
     cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationV2 uid b)
     -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests
     let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443")
diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs
index 02248bbef0b..b5b752459cd 100644
--- a/services/brig/test/unit/Test/Brig/Calling.hs
+++ b/services/brig/test/unit/Test/Brig/Calling.hs
@@ -24,6 +24,9 @@ import Brig.Options
 import Brig.PolyLog
 import Control.Retry
 import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Range
+import qualified Data.Set as Set
 import Imports
 import Network.DNS
 import Polysemy
@@ -40,7 +43,7 @@ data FakeDNSEnv = FakeDNSEnv
   }
 
 newFakeDNSEnv :: (Domain -> SrvResponse) -> IO FakeDNSEnv
-newFakeDNSEnv lookupFn = do
+newFakeDNSEnv lookupFn =
   FakeDNSEnv lookupFn <$> newIORef []
 
 runFakeDNSLookup :: Member (Embed IO) r => FakeDNSEnv -> Sem (DNSLookup ': r) a -> Sem r a
@@ -61,6 +64,7 @@ recordLogs LogRecorder {..} = interpret $ \(PolyLog lvl msg) ->
 ignoreLogs :: Sem (PolyLog ': r) a -> Sem r a
 ignoreLogs = interpret $ \(PolyLog _ _) -> pure ()
 
+{-# ANN tests ("HLint: ignore" :: String) #-}
 tests :: TestTree
 tests =
   testGroup "Calling" $
@@ -69,12 +73,12 @@ tests =
             assertEqual
               "should use the service name to form domain"
               "_foo._tcp.example.com."
-              (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing)),
+              (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing Nothing)),
           testCase "when service name is not provided" $
             assertEqual
               "should assume service name to be 'sft'"
               "_sft._tcp.example.com."
-              (mkSFTDomain (SFTOptions "example.com" Nothing Nothing))
+              (mkSFTDomain (SFTOptions "example.com" Nothing Nothing Nothing))
         ],
       testGroup "sftDiscoveryLoop" $
         [ testCase "when service can be discovered" $ void testDiscoveryLoopWhenSuccessful,
@@ -86,6 +90,11 @@ tests =
         [ testCase "when service is available" testSFTDiscoverWhenAvailable,
           testCase "when service is not available" testSFTDiscoverWhenNotAvailable,
           testCase "when dns lookup fails" testSFTDiscoverWhenDNSFails
+        ],
+      testGroup "getRandomSFTServers" $
+        [ testCase "more servers in SRV than limit" testSFTManyServers,
+          testCase "fewer servers in SRV than limit" testSFTFewerServers
+          -- the randomization part is not (yet?) tested here.
         ]
     ]
 
@@ -94,9 +103,9 @@ testDiscoveryLoopWhenSuccessful = do
   let entry1 = SrvEntry 0 0 (SrvTarget "sft1.foo.example.com." 443)
       entry2 = SrvEntry 0 0 (SrvTarget "sft2.foo.example.com." 443)
       entry3 = SrvEntry 0 0 (SrvTarget "sft3.foo.example.com." 443)
-      returnedEntries = (entry1 :| [entry2, entry3])
+      returnedEntries = entry1 :| [entry2, entry3]
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries)
-  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001))
+  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001) Nothing)
 
   discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
@@ -105,13 +114,13 @@ testDiscoveryLoopWhenSuccessful = do
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
-  assertEqual "servers should be the ones read from DNS" (Discovered returnedEntries) actualServers
+  assertEqual "servers should be the ones read from DNS" (Discovered (mkSFTServers returnedEntries)) actualServers
   pure sftEnv
 
 testDiscoveryLoopWhenUnsuccessful :: IO ()
 testDiscoveryLoopWhenUnsuccessful = do
   fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvNotAvailable)
-  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001))
+  sftEnv <- mkSFTEnv (SFTOptions "foo.example.com" Nothing (Just 0.001) Nothing)
 
   discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   -- We wait for at least two lookups to be sure that the lookup loop looped at
@@ -153,11 +162,11 @@ testDiscoveryLoopWhenURLsChange = do
   discoveryLoop <- Async.async $ runM . ignoreLogs . runFakeDNSLookup fakeDNSEnv $ sftDiscoveryLoop sftEnv
   void $ retryEvery10MicrosWhileN 2000 (== 0) (length <$> readIORef (fakeLookupCalls fakeDNSEnv))
   -- We don't want to stop the loop before it has written to the sftServers IORef
-  void $ retryEvery10MicrosWhileN 2000 (== Discovered newEntries) (readIORef (sftServers sftEnv))
+  void $ retryEvery10MicrosWhileN 2000 (== Discovered (mkSFTServers newEntries)) (readIORef (sftServers sftEnv))
   Async.cancel discoveryLoop
 
   actualServers <- readIORef (sftServers sftEnv)
-  assertEqual "servers should get overwritten" (Discovered newEntries) actualServers
+  assertEqual "servers should get overwritten" (Discovered (mkSFTServers newEntries)) actualServers
 
 testSFTDiscoverWhenAvailable :: IO ()
 testSFTDiscoverWhenAvailable = do
@@ -198,6 +207,32 @@ testSFTDiscoverWhenDNSFails = do
   assertEqual "should warn about it in the logs" [(Log.Error, "DNS Lookup failed for SFT Discovery, Error=IllegalDomain\n")]
     =<< readIORef (recordedLogs logRecorder)
 
+testSFTManyServers :: IO ()
+testSFTManyServers = do
+  let entry1 = SrvEntry 0 0 (SrvTarget "sft1.foo.example.com." 443)
+      entry2 = SrvEntry 0 0 (SrvTarget "sft2.foo.example.com." 443)
+      entry3 = SrvEntry 0 0 (SrvTarget "sft3.foo.example.com." 443)
+      entry4 = SrvEntry 0 0 (SrvTarget "sft4.foo.example.com." 443)
+      entry5 = SrvEntry 0 0 (SrvTarget "sft5.foo.example.com." 443)
+      entry6 = SrvEntry 0 0 (SrvTarget "sft6.foo.example.com." 443)
+      entry7 = SrvEntry 0 0 (SrvTarget "sft7.foo.example.com." 443)
+      entries = entry1 :| [entry2, entry3, entry4, entry5, entry6, entry7]
+      sftServers = mkSFTServers entries
+  someServers <- getRandomSFTServers (unsafeRange 3) sftServers
+  assertEqual "should return only 3 servers" 3 (length someServers)
+
+testSFTFewerServers :: IO ()
+testSFTFewerServers = do
+  let entry1 = SrvEntry 0 0 (SrvTarget "sft1.foo.example.com." 443)
+      entry2 = SrvEntry 0 0 (SrvTarget "sft2.foo.example.com." 443)
+      entry3 = SrvEntry 0 0 (SrvTarget "sft3.foo.example.com." 443)
+      entry4 = SrvEntry 0 0 (SrvTarget "sft4.foo.example.com." 443)
+      entries = entry1 :| [entry2, entry3, entry4]
+      sftServers = mkSFTServers entries
+
+  allServers <- getRandomSFTServers (unsafeRange 10) sftServers
+  assertEqual "should return all of them" (Set.fromList $ NonEmpty.toList allServers) (Set.fromList $ NonEmpty.toList entries)
+
 retryEvery10MicrosWhileN :: (MonadIO m) => Int -> (a -> Bool) -> m a -> m a
 retryEvery10MicrosWhileN n f m =
   retrying

From 913e90ebfb1d2c89910b22a894f7fd1bc531acf4 Mon Sep 17 00:00:00 2001
From: Tiago Manuel Ventura Loureiro <tiago.loureiro@gmail.com>
Date: Fri, 2 Oct 2020 14:50:38 +0200
Subject: [PATCH 10/11] Use mutable content for non-voip notifications and
 update limits (#1212)

* Use mutable content for non-voip notifications and update limits

Co-authored-by: Matthias Fischmann <mf@zerobuzz.net>
---
 .../src/Gundeck/Push/Native/Serialise.hs      | 52 ++++++++-----------
 1 file changed, 22 insertions(+), 30 deletions(-)

diff --git a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs
index ac084dc1898..d911856eb2f 100644
--- a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs
+++ b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs
@@ -21,11 +21,10 @@ module Gundeck.Push.Native.Serialise
   )
 where
 
-import Control.Lens ((^.), (^?), _Just)
+import Control.Lens ((^.))
 import Data.Aeson (Value, object, (.=))
 import Data.Aeson.Text (encodeToTextBuilder)
 import qualified Data.ByteString as BS
-import Data.Json.Util
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Builder as LTB
@@ -38,24 +37,24 @@ serialise m a = do
   rs <- prepare m a
   case rs of
     Left failure -> return $! Left $! failure
-    Right (v, prio, aps) -> case renderText (a ^. addrTransport) aps prio v of
+    Right (v, prio) -> case renderText (a ^. addrTransport) prio v of
       Nothing -> return $ Left PayloadTooLarge
       Just txt -> return $ Right txt
 
-prepare :: NativePush -> Address -> IO (Either Failure (Value, Priority, Maybe ApsData))
+prepare :: NativePush -> Address -> IO (Either Failure (Value, Priority))
 prepare m a = case m of
-  NativePush nid prio aps ->
+  NativePush nid prio _aps ->
     let o =
           object
             [ "type" .= ("notice" :: Text),
               "data" .= object ["id" .= nid],
               "user" .= (a ^. addrUser)
             ]
-     in return $ Right (o, prio, aps)
+     in return $ Right (o, prio)
 
 -- | Assemble a final SNS JSON string for transmission.
-renderText :: Transport -> Maybe ApsData -> Priority -> Value -> Maybe LT.Text
-renderText t aps prio x = case t of
+renderText :: Transport -> Priority -> Value -> Maybe LT.Text
+renderText t prio x = case t of
   GCM -> trim "GCM" (jsonString gcmJson)
   APNS -> trim "APNS" (jsonString stdApnsJson)
   APNSSandbox -> trim "APNS_SANDBOX" (jsonString stdApnsJson)
@@ -69,7 +68,7 @@ renderText t aps prio x = case t of
         ]
     stdApnsJson =
       object
-        [ "aps" .= apsDict prio,
+        [ "aps" .= apsDict,
           "data" .= x
         ]
     voipApnsJson =
@@ -77,23 +76,15 @@ renderText t aps prio x = case t of
         [ "aps" .= object [],
           "data" .= x
         ]
-    apsDict HighPriority =
-      object $
-        "alert"
-          .= object
-            ( "loc-key" .= (aps ^? _Just . apsLocKey)
-                # "loc-args" .= (aps ^? _Just . apsLocArgs)
-                # []
-            )
-          # "sound"
-          .= (aps ^? _Just . apsSound)
-          # "content-available"
-          .= '1'
-          # []
-    apsDict LowPriority =
-      object $
-        "content-available" .= '1'
-          # []
+    -- https://developer.apple.com/documentation/usernotifications/modifying_content_in_newly_delivered_notifications
+    -- Must contain `mutable-content: 1` and include an alert dictionary with title, subtitle, or body information.
+    -- Since we have no useful data here, we send a default payload that gets overridden by the client
+    apsDict =
+      object
+        [ "alert" .= object ["title" .= ("New message" :: Text)],
+          "mutable-content" .= '1'
+        ]
+
     maxLen = maxPayloadSize t
     -- see <https://github.com/wireapp/wire-server/issues/341>.
     trim k j =
@@ -102,12 +93,13 @@ renderText t aps prio x = case t of
             then Nothing
             else Just $! jsonString $! object [k .= j']
 
+-- | APNS: Check size at https://developer.apple.com/documentation/usernotifications/setting_up_a_remote_notification_server/generating_a_remote_notification
 maxPayloadSize :: Transport -> Int64
 maxPayloadSize GCM = 4096
-maxPayloadSize APNS = 2048
-maxPayloadSize APNSSandbox = 2048
-maxPayloadSize APNSVoIP = 4096
-maxPayloadSize APNSVoIPSandbox = 4096
+maxPayloadSize APNS = 4096
+maxPayloadSize APNSSandbox = 4096
+maxPayloadSize APNSVoIP = 5120
+maxPayloadSize APNSVoIPSandbox = 5120
 
 gcmPriority :: Priority -> Text
 gcmPriority LowPriority = "normal"

From 28b131d499ff51ad7366ed3837bfa33daa818e91 Mon Sep 17 00:00:00 2001
From: jschaul <jschaul@users.noreply.github.com>
Date: Mon, 5 Oct 2020 15:19:49 +0200
Subject: [PATCH 11/11] Add changelog

---
 CHANGELOG.md | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 05411c73826..3277084cda8 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,29 @@
+# 2020-10-05
+
+## Release Notes
+
+With this release, the `setCookieDomain` configuration (under `brig`/`config`.`optSettings`) no longer has any effect, and can be removed.
+
+## Security improvements
+
+* Authentication cookies are set to the specific DNS name of the backend server (like nginz-https.example.com), instead of a wildcard domain (like *.example.com). This is achieved by leaving the domain empty in the Set-Cookie header, but changing the code to allow clients with old cookies to continue using them until they get renewed. (#1102)
+
+## Bug Fixes
+
+* Match users on email in SCIM search: Manage invited user by SCIM when SSO is enabled (#1207)
+
+## New Features
+
+* Amount of SFT servers returned on /calls/config/v2 can be limited (default 5, configurable) (#1206)
+* Allow SCIM without SAML (#1200)
+
+## Internal changes
+
+* Cargohold: Log more about AWS errors, ease compatibility testing (#1205, #1210)
+* GHC upgrade to 8.8.4 (#1204)
+* Preparation for APNS notification on iOS 13 devices: Use mutable content for non-voip notifications and update limits (#1212)
+* Cleanup: remove unused scim_user table (#1211)
+
 # 2020-09-04
 
 ## Release Notes