[chore] Simplify email types

changelog.d/5-internal/refactor-email

@@ -0,0 +1 @@
+Factored out our Email type in favour of EmailAddress from email-validate.

hack/bin/integration-teardown-federation.sh

@@ -12,6 +12,8 @@ export NAMESPACE_2="$NAMESPACE-fed2"
 # these don't matter for destruction but have to be set.
 export FEDERATION_DOMAIN_1="."
 export FEDERATION_DOMAIN_2="."
+export FEDERATION_DOMAIN_BASE_1="."
+export FEDERATION_DOMAIN_BASE_2="."
 
 KUBERNETES_VERSION_MAJOR="$(kubectl version -o json | jq -r .serverVersion.major)"
 KUBERNETES_VERSION_MINOR="$(kubectl version -o json | jq -r .serverVersion.minor)"

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

@@ -68,4 +68,4 @@ testCaseUserAccount = testCase "UserAcccount" $ do
     json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"email\":\"[email protected]\",\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000000-0000-0001-0000-000100000000\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000100000001\"}"
 
     json2 :: LByteString
-    json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"@\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000000-0000-0000-0000-000000000001\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000000000001\"}"
+    json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"a@b\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000000-0000-0000-0000-000000000001\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000000000001\"}"

libs/hscim/server/Main.hs

@@ -68,7 +68,7 @@ mkUserDB = do
             E.value =
               maybe
                 (error "couldn't parse email")
-                EmailAddress2
+                EmailAddress
                 (emailAddress "[email protected]"),
             E.primary = Nothing
           }

libs/hscim/src/Web/Scim/Schema/User/Email.hs

@@ -21,24 +21,24 @@ import Data.Aeson
 import Data.Text hiding (dropWhile)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import GHC.Generics (Generic)
-import Text.Email.Validate
-import Web.Scim.Schema.Common
+import qualified Text.Email.Validate as Email
+import Web.Scim.Schema.Common hiding (value)
 
-newtype EmailAddress2 = EmailAddress2
-  {unEmailAddress :: EmailAddress}
+newtype EmailAddress = EmailAddress
+  {unEmailAddress :: Email.EmailAddress}
   deriving (Show, Eq)
 
-instance FromJSON EmailAddress2 where
-  parseJSON = withText "Email" $ \e -> case emailAddress (encodeUtf8 e) of
+instance FromJSON EmailAddress where
+  parseJSON = withText "Email" $ \e -> case Email.emailAddress (encodeUtf8 e) of
     Nothing -> fail "Invalid email"
-    Just some -> pure $ EmailAddress2 some
+    Just some -> pure $ EmailAddress some
 
-instance ToJSON EmailAddress2 where
-  toJSON (EmailAddress2 e) = String $ decodeUtf8 . toByteString $ e
+instance ToJSON EmailAddress where
+  toJSON (EmailAddress e) = String $ decodeUtf8 . Email.toByteString $ e
 
 data Email = Email
-  { typ :: Maybe Text,
-    value :: EmailAddress2,
+  { typ :: Maybe Text, -- Work, private, and so on
+    value :: EmailAddress,
     primary :: Maybe ScimBool
   }
   deriving (Show, Eq, Generic)
@@ -48,3 +48,6 @@ instance FromJSON Email where
 
 instance ToJSON Email where
   toJSON = genericToJSON serializeOptions
+
+emailToEmailAddress :: Email -> Email.EmailAddress
+emailToEmailAddress = unEmailAddress . value

libs/hscim/test/Test/Schema/UserSpec.hs

@@ -251,7 +251,7 @@ completeUser =
               Email.value =
                 maybe
                   (error "couldn't parse email")
-                  EmailAddress2
+                  EmailAddress
                   (emailAddress "[email protected]"),
               Email.primary = Nothing
             }

libs/imports/default.nix

@@ -7,6 +7,7 @@
 , bytestring
 , containers
 , deepseq
+, either
 , extra
 , gitignoreSource
 , lib
@@ -26,6 +27,7 @@ mkDerivation {
     bytestring
     containers
     deepseq
+    either
     extra
     mtl
     text

libs/imports/imports.cabal

@@ -73,6 +73,7 @@ library
     , bytestring
     , containers
     , deepseq
+    , either
     , extra
     , mtl
     , text

libs/imports/src/Imports.hs

@@ -37,6 +37,7 @@ module Imports
     module Data.Monoid,
     module Data.Maybe,
     module Data.Either,
+    module Data.Either.Combinators,
     module Data.Foldable,
     module Data.Traversable,
     module Data.Tuple,
@@ -110,6 +111,7 @@ module Imports
     -- * Extra Helpers
     whenM,
     unlessM,
+    catMaybesToList,
 
     -- * Functor
     (<$$>),
@@ -147,6 +149,7 @@ import Data.ByteString (ByteString)
 import Data.ByteString.Lazy qualified
 import Data.Char
 import Data.Either
+import Data.Either.Combinators hiding (fromLeft, fromRight, isLeft, isRight)
 import Data.Foldable
 import Data.Function
 import Data.Functor
@@ -382,3 +385,6 @@ infix 4 <$$>
 (<$$$>) = fmap . fmap . fmap
 
 infix 4 <$$$>
+
+catMaybesToList :: Maybe (Maybe a) -> [a]
+catMaybesToList = catMaybes . maybeToList

libs/wire-api/default.nix

@@ -32,7 +32,6 @@
 , data-default
 , deriving-aeson
 , deriving-swagger2
-, either
 , email-validate
 , errors
 , extended
@@ -143,7 +142,6 @@ mkDerivation {
     data-default
     deriving-aeson
     deriving-swagger2
-    either
     email-validate
     errors
     extended
@@ -228,7 +226,6 @@ mkDerivation {
     containers
     crypton
     currency-codes
-    either
     filepath
     hex
     hspec

libs/wire-api/src/Wire/API/Allowlists.hs

@@ -25,6 +25,7 @@ module Wire.API.Allowlists
 where
 
 import Data.Aeson
+import Data.Text.Encoding (decodeUtf8)
 import Imports
 import Wire.API.User.Identity
 
@@ -36,6 +37,6 @@ instance FromJSON AllowlistEmailDomains
 
 -- | Consult the whitelist settings in brig's config file and verify that the provided
 -- email address is whitelisted.
-verify :: Maybe AllowlistEmailDomains -> Email -> Bool
-verify (Just (AllowlistEmailDomains allowed)) email = emailDomain email `elem` allowed
+verify :: Maybe AllowlistEmailDomains -> EmailAddress -> Bool
+verify (Just (AllowlistEmailDomains allowed)) email = (decodeUtf8 . domainPart $ email) `elem` allowed
 verify Nothing (_) = True

libs/wire-api/src/Wire/API/OAuth.hs

@@ -26,7 +26,6 @@ import Data.Aeson.Types qualified as A
 import Data.ByteArray (convert)
 import Data.ByteString.Conversion
 import Data.ByteString.Lazy (fromStrict, toStrict)
-import Data.Either.Combinators (mapLeft)
 import Data.HashMap.Strict qualified as HM
 import Data.Id as Id
 import Data.Json.Util

libs/wire-api/src/Wire/API/Provider.hs

@@ -61,7 +61,7 @@ import Imports
 import Wire.API.Conversation.Code as Code
 import Wire.API.Provider.Service (ServiceToken (..))
 import Wire.API.Provider.Service.Tag (ServiceTag (..))
-import Wire.API.User.Identity (Email)
+import Wire.API.User.EmailAddress
 import Wire.API.User.Profile (Name)
 import Wire.Arbitrary (Arbitrary, GenericUniform (..))
 
@@ -72,7 +72,7 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..))
 data Provider = Provider
   { providerId :: ProviderId,
     providerName :: Name,
-    providerEmail :: Email,
+    providerEmail :: EmailAddress,
     providerUrl :: HttpsUrl,
     providerDescr :: Text
   }
@@ -103,7 +103,7 @@ newtype ProviderProfile = ProviderProfile Provider
 -- | Input data for registering a new provider.
 data NewProvider = NewProvider
   { newProviderName :: Name,
-    newProviderEmail :: Email,
+    newProviderEmail :: EmailAddress,
     newProviderUrl :: HttpsUrl,
     newProviderDescr :: Range 1 1024 Text,
     -- | If none provided, a password is generated.
@@ -168,7 +168,7 @@ instance ToSchema UpdateProvider where
 -- | Successful response upon activating an email address (or possibly phone
 -- number in the future) of a provider.
 newtype ProviderActivationResponse = ProviderActivationResponse
-  {activatedProviderIdentity :: Email}
+  {activatedProviderIdentity :: EmailAddress}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
   deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ProviderActivationResponse
@@ -184,7 +184,7 @@ instance ToSchema ProviderActivationResponse where
 
 -- | Input data for a provider login request.
 data ProviderLogin = ProviderLogin
-  { providerLoginEmail :: Email,
+  { providerLoginEmail :: EmailAddress,
     providerLoginPassword :: PlainTextPassword6
   }
   deriving stock (Eq, Show, Generic)
@@ -218,7 +218,7 @@ instance ToSchema DeleteProvider where
 -- Password Change/Reset
 
 -- | The payload for initiating a password reset.
-newtype PasswordReset = PasswordReset {email :: Email}
+newtype PasswordReset = PasswordReset {email :: EmailAddress}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary)
   deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema PasswordReset
@@ -264,7 +264,7 @@ instance ToSchema PasswordChange where
         <*> newPassword .= field "new_password" schema
 
 -- | The payload for updating an email address
-newtype EmailUpdate = EmailUpdate {email :: Email}
+newtype EmailUpdate = EmailUpdate {email :: EmailAddress}
   deriving stock (Eq, Show, Generic)
   deriving newtype (Arbitrary)
   deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema EmailUpdate

libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs

@@ -241,7 +241,7 @@ type AccountAPI =
            ( "users"
                :> QueryParam' [Optional, Strict] "ids" (CommaSeparatedList UserId)
                :> QueryParam' [Optional, Strict] "handles" (CommaSeparatedList Handle)
-               :> QueryParam' [Optional, Strict] "email" (CommaSeparatedList Email) -- don't rename to `emails`, for backwards compat!
+               :> QueryParam' [Optional, Strict] "email" (CommaSeparatedList EmailAddress) -- don't rename to `emails`, for backwards compat!
                :> QueryParam'
                     [ Optional,
                       Strict,
@@ -262,29 +262,29 @@ type AccountAPI =
            "iGetUserActivationCode"
            ( "users"
                :> "activation-code"
-               :> QueryParam' [Required, Strict] "email" Email
+               :> QueryParam' [Required, Strict] "email" EmailAddress
                :> Get '[Servant.JSON] GetActivationCodeResp
            )
     :<|> Named
            "iGetUserPasswordResetCode"
            ( "users"
                :> "password-reset-code"
-               :> QueryParam' [Required, Strict] "email" Email
+               :> QueryParam' [Required, Strict] "email" EmailAddress
                :> Get '[Servant.JSON] GetPasswordResetCodeResp
            )
     :<|> Named
            "iRevokeIdentity"
            ( Summary "This endpoint can lead to the following events being sent: UserIdentityRemoved event to target user"
                :> "users"
                :> "revoke-identity"
-               :> QueryParam' [Required, Strict] "email" Email
+               :> QueryParam' [Required, Strict] "email" EmailAddress
                :> Post '[Servant.JSON] NoContent
            )
     :<|> Named
            "iHeadBlacklist"
            ( "users"
                :> "blacklist"
-               :> QueryParam' [Required, Strict] "email" Email
+               :> QueryParam' [Required, Strict] "email" EmailAddress
                :> MultiVerb
                     'GET
                     '[Servant.JSON]
@@ -297,14 +297,14 @@ type AccountAPI =
            "iDeleteBlacklist"
            ( "users"
                :> "blacklist"
-               :> QueryParam' [Required, Strict] "email" Email
+               :> QueryParam' [Required, Strict] "email" EmailAddress
                :> Delete '[Servant.JSON] NoContent
            )
     :<|> Named
            "iPostBlacklist"
            ( "users"
                :> "blacklist"
-               :> QueryParam' [Required, Strict] "email" Email
+               :> QueryParam' [Required, Strict] "email" EmailAddress
                :> Post '[Servant.JSON] NoContent
            )
     :<|> Named
@@ -534,7 +534,7 @@ type InvitationByEmail =
     ( "teams"
         :> "invitations"
         :> "by-email"
-        :> QueryParam' [Required, Strict] "email" Email
+        :> QueryParam' [Required, Strict] "email" EmailAddress
         :> Get '[Servant.JSON] Invitation
     )
 
@@ -738,7 +738,7 @@ type ProviderAPI =
       ( Summary "Retrieve activation code via api instead of email (for testing only)"
           :> "provider"
           :> "activation-code"
-          :> QueryParam' '[Required, Strict] "email" Email
+          :> QueryParam' '[Required, Strict] "email" EmailAddress
           :> MultiVerb1 'GET '[JSON] (Respond 200 "" Code.KeyValuePair)
       )
   )

libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs

@@ -43,7 +43,7 @@ import Imports hiding (head)
 import Test.QuickCheck (Arbitrary)
 import Wire.API.Connection (Relation)
 import Wire.API.Team.Member (NewListType)
-import Wire.API.User.Identity (Email, Phone)
+import Wire.API.User.Identity (EmailAddress, Phone)
 import Wire.API.User.Profile (Name)
 import Wire.Arbitrary (GenericUniform (..))
 
@@ -62,7 +62,7 @@ data EJPDResponseItemRoot = EJPDResponseItemRoot
     ejpdResponseRootTeamId :: Maybe TeamId,
     ejpdResponseRootName :: Name,
     ejpdResponseRootHandle :: Maybe Handle,
-    ejpdResponseRootEmail :: Maybe Email,
+    ejpdResponseRootEmail :: Maybe EmailAddress,
     ejpdResponseRootPhone :: Maybe Phone,
     ejpdResponseRootPushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance.
     ejpdResponseRootContacts :: Maybe (Set EJPDContact),
@@ -78,7 +78,7 @@ data EJPDResponseItemLeaf = EJPDResponseItemLeaf
     ejpdResponseLeafTeamId :: Maybe TeamId,
     ejpdResponseLeafName :: Name,
     ejpdResponseLeafHandle :: Maybe Handle,
-    ejpdResponseLeafEmail :: Maybe Email,
+    ejpdResponseLeafEmail :: Maybe EmailAddress,
     ejpdResponseLeafPhone :: Maybe Phone,
     ejpdResponseLeafPushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance.
     ejpdResponseLeafConversations :: Maybe (Set EJPDConvInfo),

libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs

@@ -25,7 +25,6 @@ import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Attoparsec.ByteString qualified as AB
 import Data.ByteString qualified as BS
 import Data.ByteString.Base64.URL qualified as Base64Url
-import Data.Either.Combinators (mapLeft)
 import Data.OpenApi qualified as S
 import Data.Proxy
 import Data.Schema

libs/wire-api/src/Wire/API/Routes/MultiVerb.hs

@@ -55,7 +55,6 @@ import Control.Lens hiding (Context, (<|))
 import Data.ByteString.Builder
 import Data.ByteString.Lazy qualified as LBS
 import Data.CaseInsensitive qualified as CI
-import Data.Either.Combinators (leftToMaybe)
 import Data.HashMap.Strict.InsOrd (InsOrdHashMap, unionWith)
 import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
 import Data.Kind

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -1637,7 +1637,7 @@ type TeamsAPI =
                :> "teams"
                :> "invitations"
                :> "by-email"
-               :> QueryParam' '[Required, Strict, Description "Email address"] "email" Email
+               :> QueryParam' '[Required, Strict, Description "Email address"] "email" EmailAddress
                :> MultiVerb
                     'HEAD
                     '[JSON]

libs/wire-api/src/Wire/API/Team/Export.hs

@@ -28,18 +28,18 @@ import Data.Json.Util (UTCTimeMillis)
 import Data.Misc (HttpsUrl)
 import Data.Vector (fromList)
 import Imports
-import Test.QuickCheck (Arbitrary)
+import Test.QuickCheck
 import Wire.API.Team.Role (Role)
 import Wire.API.User (Name)
-import Wire.API.User.Identity (Email)
+import Wire.API.User.Identity (EmailAddress)
 import Wire.API.User.Profile (ManagedBy)
 import Wire.API.User.RichInfo (RichInfo)
-import Wire.Arbitrary (GenericUniform (GenericUniform))
+import Wire.Arbitrary
 
 data TeamExportUser = TeamExportUser
   { tExportDisplayName :: Name,
     tExportHandle :: Maybe Handle,
-    tExportEmail :: Maybe Email,
+    tExportEmail :: Maybe EmailAddress,
     tExportRole :: Maybe Role,
     tExportCreatedOn :: Maybe UTCTimeMillis,
     tExportInvitedBy :: Maybe Handle,