Refactor Invitations

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

@@ -44,55 +44,52 @@ import Wire.API.User.Profile (Locale, Name)
 -- InvitationRequest
 
 data InvitationRequest = InvitationRequest
-  { irEmail :: Email,
-    irName :: Name,
-    irLocale :: Maybe Locale,
+  { irLocale :: Maybe Locale,
     irRole :: Maybe Role,
     irInviteeName :: Maybe Name,
-    irPhone :: Maybe Phone
+    irInviteeEmail :: Email,
+    irInviteePhone :: Maybe Phone
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform InvitationRequest)
 
 modelTeamInvitationRequest :: Doc.Model
 modelTeamInvitationRequest = Doc.defineModel "TeamInvitationRequest" $ do
   Doc.description "A request to join a team on Wire."
-  Doc.property "inviter_name" Doc.string' $
-    Doc.description "Name of the inviter (1 - 128 characters)"
-  Doc.property "email" Doc.string' $
-    Doc.description "Email of the invitee"
   Doc.property "locale" Doc.string' $ do
     Doc.description "Locale to use for the invitation."
     Doc.optional
   Doc.property "role" typeRole $ do
-    Doc.description "Role of the invited user"
+    Doc.description "Role of the invitee (invited user)."
     Doc.optional
   Doc.property "name" Doc.string' $ do
-    Doc.description "Name of the invitee (1 - 128 characters)"
+    Doc.description "Name of the invitee (1 - 128 characters)."
     Doc.optional
+  Doc.property "email" Doc.string' $
+    Doc.description "Email of the invitee."
   Doc.property "phone" Doc.string' $ do
-    Doc.description "Phone number of the invitee, in the E.164 format"
+    Doc.description "Phone number of the invitee, in the E.164 format."
     Doc.optional
+  Doc.property "inviter_name" Doc.string' $
+    Doc.description "DEPRECATED - WILL BE IGNORED IN FAVOR OF REQ AUTH DATA - Name of the inviter (1 - 128 characters)."
 
 instance ToJSON InvitationRequest where
   toJSON i =
     object $
-      [ "email" .= irEmail i,
-        "inviter_name" .= irName i,
-        "locale" .= irLocale i,
+      [ "locale" .= irLocale i,
         "role" .= irRole i,
         "name" .= irInviteeName i,
-        "phone" .= irPhone i
+        "email" .= irInviteeEmail i,
+        "phone" .= irInviteePhone i
       ]
 
 instance FromJSON InvitationRequest where
   parseJSON = withObject "invitation-request" $ \o ->
     InvitationRequest
-      <$> o .: "email"
-      <*> o .: "inviter_name"
-      <*> o .:? "locale"
+      <$> o .:? "locale"
       <*> o .:? "role"
       <*> o .:? "name"
+      <*> o .: "email"
       <*> o .:? "phone"
 
 --------------------------------------------------------------------------------
@@ -102,22 +99,19 @@ data Invitation = Invitation
   { inTeam :: TeamId,
     inRole :: Role,
     inInvitation :: InvitationId,
-    inIdentity :: Email,
     inCreatedAt :: UTCTimeMillis,
     -- | this is always 'Just' for new invitations, but for
     -- migration it is allowed to be 'Nothing'.
     inCreatedBy :: Maybe UserId,
+    inInviteeEmail :: Email,
     inInviteeName :: Maybe Name,
-    inPhone :: Maybe Phone
+    inInviteePhone :: Maybe Phone
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Invitation)
 
--- | This is *not* the swagger model for the 'TeamInvitation' type (which does not exist), but
--- for the use of 'Invitation' under @/teams/{tid}/invitations@.
---
--- TODO: swagger should be replaced by something more type-safe at some point so this will be
--- forcibly resolved and won't happen again.
+-- | (This is *not* the swagger model for the 'TeamInvitation' type (which does not exist),
+-- but for the use of 'Invitation' under @/teams/{tid}/invitations@.)
 modelTeamInvitation :: Doc.Model
 modelTeamInvitation = Doc.defineModel "TeamInvitation" $ do
   Doc.description "An invitation to join a team on Wire"
@@ -128,13 +122,13 @@ modelTeamInvitation = Doc.defineModel "TeamInvitation" $ do
     Doc.optional
   Doc.property "id" Doc.bytes' $
     Doc.description "UUID used to refer the invitation"
-  Doc.property "email" Doc.string' $
-    Doc.description "Email of the invitee"
   Doc.property "created_at" Doc.dateTime' $
     Doc.description "Timestamp of invitation creation"
   Doc.property "created_by" Doc.bytes' $ do
     Doc.description "ID of the inviting user"
     Doc.optional
+  Doc.property "email" Doc.string' $
+    Doc.description "Email of the invitee"
   Doc.property "name" Doc.string' $ do
     Doc.description "Name of the invitee (1 - 128 characters)"
     Doc.optional
@@ -148,11 +142,11 @@ instance ToJSON Invitation where
       [ "team" .= inTeam i,
         "role" .= inRole i,
         "id" .= inInvitation i,
-        "email" .= inIdentity i,
         "created_at" .= inCreatedAt i,
         "created_by" .= inCreatedBy i,
+        "email" .= inInviteeEmail i,
         "name" .= inInviteeName i,
-        "phone" .= inPhone i
+        "phone" .= inInviteePhone i
       ]
 
 instance FromJSON Invitation where
@@ -162,9 +156,9 @@ instance FromJSON Invitation where
       -- clients, when leaving "role" empty, can leave the default role choice to us
       <*> o .:? "role" .!= defaultRole
       <*> o .: "id"
-      <*> o .: "email"
       <*> o .: "created_at"
       <*> o .:? "created_by"
+      <*> o .: "email"
       <*> o .:? "name"
       <*> o .:? "phone"
 

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

@@ -31,6 +31,7 @@ import Brig.API.IdMapping (resolveOpaqueUserId)
 import qualified Brig.API.Properties as API
 import Brig.API.Types
 import qualified Brig.API.User as API
+import qualified Brig.API.Util as API
 import Brig.App
 import qualified Brig.Calling.API as Calling
 import qualified Brig.Data.User as Data
@@ -1136,32 +1137,14 @@ changeLocaleH (u ::: conn ::: req) = do
   lift $ API.changeLocale u conn l
   return empty
 
-data CheckHandleResp
-  = CheckHandleInvalid
-  | CheckHandleFound
-  | CheckHandleNotFound
-
+-- | (zusr are is ignored by this handler, ie. checking handles is allowed as long as you have
+-- *any* account.)
 checkHandleH :: UserId ::: Text -> Handler Response
-checkHandleH (uid ::: hndl) = do
-  checkHandle uid hndl >>= \case
-    CheckHandleInvalid -> throwE (StdError invalidHandle)
-    CheckHandleFound -> pure $ setStatus status200 empty
-    CheckHandleNotFound -> pure $ setStatus status404 empty
-
-checkHandle :: UserId -> Text -> Handler CheckHandleResp
-checkHandle _ uhandle = do
-  handle <- validateHandle uhandle
-  owner <- lift $ API.lookupHandle handle
-  if
-      | isJust owner ->
-        -- Handle is taken (=> getHandleInfo will return 200)
-        return CheckHandleFound
-      | API.isBlacklistedHandle handle ->
-        -- Handle is free but cannot be taken
-        return CheckHandleInvalid
-      | otherwise ->
-        -- Handle is free and can be taken
-        return CheckHandleNotFound
+checkHandleH (_uid ::: hndl) = do
+  API.checkHandle hndl >>= \case
+    API.CheckHandleInvalid -> throwE (StdError invalidHandle)
+    API.CheckHandleFound -> pure $ setStatus status200 empty
+    API.CheckHandleNotFound -> pure $ setStatus status404 empty
 
 checkHandlesH :: JSON ::: UserId ::: JsonRequest Public.CheckHandles -> Handler Response
 checkHandlesH (_ ::: _ ::: req) = do
@@ -1193,7 +1176,7 @@ changeHandleH (u ::: conn ::: req) = do
 
 changeHandle :: UserId -> ConnId -> Public.HandleUpdate -> Handler ()
 changeHandle u conn (Public.HandleUpdate h) = do
-  handle <- validateHandle h
+  handle <- API.validateHandle h
   API.changeHandle u conn handle !>> changeHandleError
 
 beginPasswordResetH :: JSON ::: JsonRequest Public.NewPasswordReset -> Handler Response
@@ -1357,9 +1340,6 @@ deprecatedCompletePasswordResetH (_ ::: k ::: req) = do
 
 -- Utilities
 
-validateHandle :: Text -> Handler Handle
-validateHandle = maybe (throwE (StdError invalidHandle)) return . parseHandle
-
 ifNothing :: Utilities.Error -> Maybe a -> Handler a
 ifNothing e = maybe (throwStd e) return
 

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

@@ -28,6 +28,8 @@ module Brig.API.User
     changeEmail,
     changePhone,
     changeHandle,
+    CheckHandleResp (..),
+    checkHandle,
     lookupHandle,
     changeManagedBy,
     changeAccountStatus,
@@ -36,7 +38,6 @@ module Brig.API.User
     Data.lookupAccount,
     Data.lookupStatus,
     lookupAccountsByIdentity,
-    lookupSelfProfile,
     lookupProfile,
     lookupProfiles,
     Data.lookupName,
@@ -84,7 +85,9 @@ module Brig.API.User
 where
 
 import qualified Brig.API.Error as Error
+import qualified Brig.API.Handler as API (Handler)
 import Brig.API.Types
+import Brig.API.Util (fetchUserIdentity, validateHandle)
 import Brig.App
 import qualified Brig.Code as Code
 import Brig.Data.Activation (ActivationEvent (..))
@@ -183,7 +186,7 @@ createUser new@NewUser {..} = do
       _ -> return Nothing
   (teamEmailInvited, joinedTeamInvite) <- case teamInvitation of
     Just (inv, invInfo) -> do
-      let em = Team.inIdentity inv
+      let em = Team.inInviteeEmail inv
       acceptTeamInvitation account inv invInfo (userEmailKey em) (EmailIdentity em)
       Team.TeamName nm <- lift $ Intra.getTeamName (Team.inTeam inv)
       return (True, Just $ CreateUserTeam (Team.inTeam inv) nm)
@@ -261,7 +264,7 @@ createUser new@NewUser {..} = do
       lift (Team.lookupInvitationInfo c) >>= \case
         Just ii -> do
           inv <- lift $ Team.lookupInvitation (Team.iiTeam ii) (Team.iiInvId ii)
-          case (inv, Team.inIdentity <$> inv) of
+          case (inv, Team.inInviteeEmail <$> inv) of
             (Just invite, Just em)
               | e == userEmailKey em -> do
                 _ <- ensureMemberCanJoin (Team.iiTeam ii)
@@ -382,6 +385,33 @@ changeHandle uid conn hdl = do
         throwE ChangeHandleExists
       lift $ Intra.onUserEvent uid (Just conn) (handleUpdated uid hdl)
 
+--------------------------------------------------------------------------------
+-- Check Handle
+
+data CheckHandleResp
+  = CheckHandleInvalid
+  | CheckHandleFound
+  | CheckHandleNotFound
+
+checkHandle :: Text -> API.Handler CheckHandleResp
+checkHandle uhandle = do
+  xhandle <- validateHandle uhandle
+  owner <- lift $ lookupHandle xhandle
+  if
+      | isJust owner ->
+        -- Handle is taken (=> getHandleInfo will return 200)
+        return CheckHandleFound
+      | isBlacklistedHandle xhandle ->
+        -- Handle is free but cannot be taken
+        --
+        -- FUTUREWORK: i wonder if this is correct?  isn't this the error for malformed
+        -- handles?  shouldn't we throw not-found here?  or should there be a fourth case
+        -- 'CheckHandleBlacklisted'?
+        return CheckHandleInvalid
+      | otherwise ->
+        -- Handle is free and can be taken
+        return CheckHandleNotFound
+
 --------------------------------------------------------------------------------
 -- Check Handles
 
@@ -1029,12 +1059,6 @@ getEmailForProfile profileOwner (EmailVisibleIfOnSameTeam' (Just (viewerTeamId,
 getEmailForProfile _ (EmailVisibleIfOnSameTeam' Nothing) = Nothing
 getEmailForProfile _ EmailVisibleToSelf' = Nothing
 
--- | Obtain a profile for a user as he can see himself.
-lookupSelfProfile :: UserId -> AppIO (Maybe SelfProfile)
-lookupSelfProfile = fmap (fmap mk) . Data.lookupAccount
-  where
-    mk a = SelfProfile (accountUser a)
-
 -- | Find user accounts for a given identity, both activated and those
 -- currently pending activation.
 lookupAccountsByIdentity :: Either Email Phone -> AppIO [UserAccount]
@@ -1067,14 +1091,3 @@ phonePrefixDelete = Blacklist.deletePrefix
 
 phonePrefixInsert :: ExcludedPrefix -> AppIO ()
 phonePrefixInsert = Blacklist.insertPrefix
-
--------------------------------------------------------------------------------
--- Utilities
-
--- TODO: Move to a util module or similar
-fetchUserIdentity :: UserId -> AppIO (Maybe UserIdentity)
-fetchUserIdentity uid =
-  lookupSelfProfile uid
-    >>= maybe
-      (throwM $ UserProfileNotFound uid)
-      (return . userIdentity . selfUser)

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

@@ -15,17 +15,30 @@
 -- 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.API.Util where
+module Brig.API.Util
+  ( fetchUserIdentity,
+    isFederationEnabled,
+    lookupProfilesMaybeFilterSameTeamOnly,
+    lookupSelfProfile,
+    validateHandle,
+    viewFederationDomain,
+  )
+where
 
+import qualified Brig.API.Error as Error
 import Brig.API.Handler
-import Brig.App (Env, settings)
+import Brig.API.Types
+import Brig.App (AppIO, Env, settings)
 import qualified Brig.Data.User as Data
 import Brig.Options (enableFederationWithDomain)
 import Brig.Types
+import Brig.Types.Intra (accountUser)
 import Control.Lens (view)
-import Control.Monad
+import Control.Monad.Catch (throwM)
+import Control.Monad.Trans.Except (throwE)
 import Data.Domain (Domain)
-import Data.Id as Id
+import Data.Handle (Handle, parseHandle)
+import Data.Id
 import Data.Maybe
 import Imports
 
@@ -36,6 +49,22 @@ lookupProfilesMaybeFilterSameTeamOnly self us = do
     Just team -> filter (\x -> profileTeam x == Just team) us
     Nothing -> us
 
+fetchUserIdentity :: UserId -> AppIO (Maybe UserIdentity)
+fetchUserIdentity uid =
+  lookupSelfProfile uid
+    >>= maybe
+      (throwM $ UserProfileNotFound uid)
+      (return . userIdentity . selfUser)
+
+-- | Obtain a profile for a user as he can see himself.
+lookupSelfProfile :: UserId -> AppIO (Maybe SelfProfile)
+lookupSelfProfile = fmap (fmap mk) . Data.lookupAccount
+  where
+    mk a = SelfProfile (accountUser a)
+
+validateHandle :: Text -> Handler Handle
+validateHandle = maybe (throwE (Error.StdError Error.invalidHandle)) return . parseHandle
+
 --------------------------------------------------------------------------------
 -- Federation