From c3237f53eba895268f9f842acb9bc6772df06020 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 26 Aug 2020 10:22:29 +0200 Subject: [PATCH 1/5] Cleanup data Invitation, InvitationRequest. - drop irName, which carried the inviter name, but was never used. - fix test suite where we used irName wrong, and then ignored it. - give irEmail, irPhone, inIdentity, inPhone less ambiguous names. - shuffle record fields. - swagger. - move around validateHandle and some other helpers. --- libs/wire-api/src/Wire/API/Team/Invitation.hs | 54 +++++++------- services/brig/src/Brig/API/Public.hs | 38 +++------- services/brig/src/Brig/API/User.hs | 53 ++++++++------ services/brig/src/Brig/API/Util.hs | 37 ++++++++-- services/brig/src/Brig/Team/API.hs | 51 +++++++++---- services/brig/src/Brig/Team/DB.hs | 33 ++++++--- services/brig/test/integration/API/Team.hs | 72 +++++++++---------- .../brig/test/integration/API/Team/Util.hs | 13 ++-- services/galley/test/integration/API/Util.hs | 11 ++- services/spar/test-integration/Util/Core.hs | 11 ++- 10 files changed, 218 insertions(+), 155 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Invitation.hs b/libs/wire-api/src/Wire/API/Team/Invitation.hs index 20b8e71b9a1..1473300149e 100644 --- a/libs/wire-api/src/Wire/API/Team/Invitation.hs +++ b/libs/wire-api/src/Wire/API/Team/Invitation.hs @@ -44,12 +44,11 @@ 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) @@ -57,42 +56,40 @@ data InvitationRequest = 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" diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 28a939ab53e..ef9158eff73 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/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 diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 3861d3dc63e..5811b062a2e 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/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) diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index a82fd2130bf..2831f49df5e 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/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 . -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 diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index b5684696593..2c496518175 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -25,7 +25,7 @@ import Brig.API.Error import Brig.API.Handler import Brig.API.User (fetchUserIdentity) import qualified Brig.API.User as API -import Brig.App (currentTime, settings) +import Brig.App (AppIO, currentTime, settings) import qualified Brig.Data.Blacklist as Blacklist import Brig.Data.UserKey import qualified Brig.Data.UserKey as Data @@ -59,7 +59,7 @@ import Network.Wai.Utilities hiding (code, message) import Network.Wai.Utilities.Swagger (document) import qualified Network.Wai.Utilities.Swagger as Doc import qualified Wire.API.Team.Invitation as Public -import qualified Wire.API.User as Public (InvitationCode) +import qualified Wire.API.User as Public routesPublic :: Routes Doc.ApiBuilder Handler () routesPublic = do @@ -204,18 +204,27 @@ createInvitationH (_ ::: uid ::: tid ::: req) = do addHeader "Location" $ "/teams/" <> toByteString' tid <> "/invitations/" <> toByteString' iid +data CreateInvitationInviter = CreateInvitationInviter + { inviterUid :: UserId, + inviterEmail :: Email + } + deriving (Eq, Show) + createInvitation :: UserId -> TeamId -> Public.InvitationRequest -> Handler Public.Invitation createInvitation uid tid body = do - idt <- maybe (throwStd noIdentity) return =<< lift (fetchUserIdentity uid) - from <- maybe (throwStd noEmail) return (emailIdentity idt) let inviteePerms = Team.rolePermissions inviteeRole inviteeRole = fromMaybe Team.defaultRole . irRole $ body - ensurePermissionToAddUser uid tid inviteePerms + inviter <- do + idt <- maybe (throwStd noIdentity) return =<< lift (fetchUserIdentity uid) + from <- maybe (throwStd noEmail) return (emailIdentity idt) + ensurePermissionToAddUser uid tid inviteePerms + pure $ CreateInvitationInviter uid from + -- FUTUREWORK: These validations are nearly copy+paste from accountCreation and -- sendActivationCode. Refactor this to a single place -- Validate e-mail - email <- either (const $ throwStd invalidEmail) return (Email.validateEmail (irEmail body)) + email <- either (const $ throwStd invalidEmail) return (Email.validateEmail (irInviteeEmail body)) let uke = userEmailKey email blacklistedEm <- lift $ Blacklist.exists uke when blacklistedEm $ @@ -224,7 +233,7 @@ createInvitation uid tid body = do when emailTaken $ throwStd emailExists -- Validate phone - phone <- for (irPhone body) $ \p -> do + phone <- for (irInviteePhone body) $ \p -> do validatedPhone <- maybe (throwStd invalidPhone) return =<< lift (Phone.validatePhone p) let ukp = userPhoneKey validatedPhone blacklistedPh <- lift $ Blacklist.exists ukp @@ -238,14 +247,32 @@ createInvitation uid tid body = do pending <- lift $ DB.countInvitations tid when (fromIntegral pending >= maxSize) $ throwStd tooManyTeamInvitations - doInvite inviteeRole email from (irLocale body) (irInviteeName body) phone + + lift $ doInvite inviteeRole inviter (irLocale body) email (irInviteeName body) phone where - doInvite role toEmail from lc toName toPhone = lift $ do + doInvite :: + Team.Role -> + CreateInvitationInviter -> + Maybe Public.Locale -> + Email -> + Maybe Public.Name -> + Maybe Public.Phone -> + AppIO Invitation + doInvite role inviter lc toEmail toName toPhone = do now <- liftIO =<< view currentTime timeout <- setTeamInvitationTimeout <$> view settings - (newInv, code) <- DB.insertInvitation tid role toEmail now (Just uid) toName toPhone timeout - void $ sendInvitationMail toEmail tid from code lc - return newInv + (newInv, code) <- + DB.insertInvitation + tid + role + now + (Just $ inviterUid inviter) + toEmail + toName + toPhone + timeout + newInv <$ sendInvitationMail toEmail tid (inviterEmail inviter) code lc + deleteInvitationH :: JSON ::: UserId ::: TeamId ::: InvitationId -> Handler Response deleteInvitationH (_ ::: uid ::: tid ::: iid) = do diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index 1dcb15bef6c..f98728598c2 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -81,18 +81,18 @@ insertInvitation :: MonadClient m => TeamId -> Role -> - Email -> UTCTime -> Maybe UserId -> + Email -> Maybe Name -> Maybe Phone -> -- | The timeout for the invitation code. Timeout -> m (Invitation, InvitationCode) -insertInvitation t role email (toUTCTimeMillis -> now) minviter inviteeName phone timeout = do +insertInvitation t role (toUTCTimeMillis -> now) minviter email inviteeName phone timeout = do iid <- liftIO mkInvitationId code <- liftIO mkInvitationCode - let inv = Invitation t role iid email now minviter inviteeName phone + let inv = Invitation t role iid now minviter email inviteeName phone retry x5 . batch $ do setType BatchLogged setConsistency Quorum @@ -114,8 +114,8 @@ lookupInvitation t r = fmap toInvitation <$> retry x1 (query1 cqlInvitation (params Quorum (t, r))) where - cqlInvitation :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, Email, UTCTimeMillis, Maybe UserId, Maybe Name, Maybe Phone) - cqlInvitation = "SELECT team, role, id, email, created_at, created_by, name, phone FROM team_invitation WHERE team = ? AND id = ?" + cqlInvitation :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone) + cqlInvitation = "SELECT team, role, id, created_at, created_by, email, name, phone FROM team_invitation WHERE team = ? AND id = ?" lookupInvitationByCode :: MonadClient m => InvitationCode -> m (Maybe Invitation) lookupInvitationByCode i = @@ -151,10 +151,10 @@ lookupInvitations team start (fromRange -> size) = do { result = invs, hasMore = more } - cqlSelect :: PrepQuery R (Identity TeamId) (TeamId, Maybe Role, InvitationId, Email, UTCTimeMillis, Maybe UserId, Maybe Name, Maybe Phone) - cqlSelect = "SELECT team, role, id, email, created_at, created_by, name, phone FROM team_invitation WHERE team = ? ORDER BY id ASC" - cqlSelectFrom :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, Email, UTCTimeMillis, Maybe UserId, Maybe Name, Maybe Phone) - cqlSelectFrom = "SELECT team, role, id, email, created_at, created_by, name, phone FROM team_invitation WHERE team = ? AND id > ? ORDER BY id ASC" + cqlSelect :: PrepQuery R (Identity TeamId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone) + cqlSelect = "SELECT team, role, id, created_at, created_by, email, name, phone FROM team_invitation WHERE team = ? ORDER BY id ASC" + cqlSelectFrom :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone) + cqlSelectFrom = "SELECT team, role, id, created_at, created_by, email, name, phone FROM team_invitation WHERE team = ? AND id > ? ORDER BY id ASC" deleteInvitation :: MonadClient m => TeamId -> InvitationId -> m () deleteInvitation t i = do @@ -231,5 +231,16 @@ countInvitations t = -- | brig used to not store the role, so for migration we allow this to be empty and fill in the -- default here. -toInvitation :: (TeamId, Maybe Role, InvitationId, Email, UTCTimeMillis, Maybe UserId, Maybe Name, Maybe Phone) -> Invitation -toInvitation (t, r, i, e, tm, minviter, inviteeName, p) = Invitation t (fromMaybe Team.defaultRole r) i e tm minviter inviteeName p +toInvitation :: + ( TeamId, + Maybe Role, + InvitationId, + UTCTimeMillis, + Maybe UserId, + Email, + Maybe Name, + Maybe Phone + ) -> + Invitation +toInvitation (t, r, i, tm, minviter, e, inviteeName, p) = + Invitation t (fromMaybe Team.defaultRole r) i tm minviter e inviteeName p diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 8b7f1b16a92..1a83cdad7af 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -132,7 +132,7 @@ testUpdateEvents brig cannon = do (alice, tid) <- createUserWithTeam brig inviteeEmail <- randomEmail -- invite and register Bob - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest inviteeEmail inv <- responseJsonError =<< postInvitation brig tid alice invite Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) rsp2 <- @@ -162,8 +162,7 @@ testUpdateEvents brig cannon = do testInvitationEmail :: Brig -> Http () testInvitationEmail brig = do (inviter, tid) <- createUserWithTeam brig - invitee <- randomEmail - let invite = stdInvitationRequest invitee (Name "Bob") Nothing Nothing + invite <- stdInvitationRequest <$> randomEmail void $ postInvitation brig tid inviter invite testInvitationEmailLookup :: Brig -> Http () @@ -172,12 +171,12 @@ testInvitationEmailLookup brig = do -- expect no invitation to be found for an email before that person is invited headInvitationByEmail brig email 404 (uid, tid) <- createUserWithTeam brig - let invite = stdInvitationRequest email (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest email void $ postInvitation brig tid uid invite -- expect an invitation to be found querying with email after invite headInvitationByEmail brig email 200 (uid2, tid2) <- createUserWithTeam brig - let invite2 = stdInvitationRequest email (Name "Bob2") Nothing Nothing + let invite2 = stdInvitationRequest email void $ postInvitation brig tid2 uid2 invite2 -- expect a 409 conflict result for a second team inviting the same user headInvitationByEmail brig email 409 @@ -186,7 +185,7 @@ testInvitationEmailLookupRegister :: Brig -> Http () testInvitationEmailLookupRegister brig = do email <- randomEmail (owner, tid) <- createUserWithTeam brig - let invite = stdInvitationRequest email (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest email void $ postInvitation brig tid owner invite inv :: Invitation <- responseJsonError =<< postInvitation brig tid owner invite -- expect an invitation to be found querying with email after invite @@ -201,7 +200,7 @@ testInvitationEmailLookupNginz brig nginz = do -- expect no invitation to be found for an email before that person is invited headInvitationByEmail nginz email 404 (uid, tid) <- createUserWithTeam brig - let invite = stdInvitationRequest email (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest email void $ postInvitation brig tid uid invite -- expect an invitation to be found querying with email after invite headInvitationByEmail nginz email 200 @@ -215,13 +214,11 @@ testInvitationTooManyPending :: Brig -> TeamSizeLimit -> Http () testInvitationTooManyPending brig (TeamSizeLimit limit) = do (inviter, tid) <- createUserWithTeam brig emails <- replicateConcurrently (fromIntegral limit) randomEmail - let invite e = stdInvitationRequest e (Name "Bob") Nothing Nothing - pooledForConcurrentlyN_ 16 emails $ \email -> - postInvitation brig tid inviter (invite email) - e <- randomEmail + pooledForConcurrentlyN_ 16 emails $ postInvitation brig tid inviter . stdInvitationRequest + email <- randomEmail -- TODO: If this test takes longer to run than `team-invitation-timeout`, then some of the -- invitations have likely expired already and this test will actually _fail_ - postInvitation brig tid inviter (invite e) !!! do + postInvitation brig tid inviter (stdInvitationRequest email) !!! do const 403 === statusCode const (Just "too-many-team-invitations") === fmap Error.label . responseJsonMaybe @@ -245,13 +242,13 @@ testInvitationRoles brig galley = do -- owner creates a member alice. alice :: UserId <- do aliceEmail <- randomEmail - let invite = stdInvitationRequest aliceEmail (Name "Alice") Nothing (Just Team.RoleAdmin) + let invite = stdInvitationRequest' Nothing (Just Team.RoleAdmin) aliceEmail inv :: Invitation <- responseJsonError =<< postInvitation brig tid owner invite registerInvite brig tid inv aliceEmail -- alice creates a external partner bob. success! bob only has externalPartner perms. do bobEmail <- randomEmail - let invite = stdInvitationRequest bobEmail (Name "Bob") Nothing (Just Team.RoleExternalPartner) + let invite = stdInvitationRequest' Nothing (Just Team.RoleExternalPartner) bobEmail inv :: Invitation <- responseJsonError =<< ( postInvitation brig tid alice invite Galley -> Http () testInvitationEmailAccepted brig galley = do inviteeEmail <- randomEmail - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing - void $ createAndVerifyInvitation (accept (irEmail invite)) invite brig galley + let invite = stdInvitationRequest inviteeEmail + void $ createAndVerifyInvitation (accept (irInviteeEmail invite)) invite brig galley -- | Related: 'testDomainsBlockedForRegistration'. When we remove the customer-specific -- extension of domain blocking, this test will fail to compile (so you will know it's time to @@ -283,18 +280,18 @@ testInvitationEmailAccepted brig galley = do testInvitationEmailAcceptedInBlockedDomain :: Opt.Opts -> Brig -> Galley -> Http () testInvitationEmailAcceptedInBlockedDomain opts brig galley = do inviteeEmail :: Email <- randomEmail - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest inviteeEmail replacementBrigApp = withDomainsBlockedForRegistration opts [emailDomain inviteeEmail] - void $ createAndVerifyInvitation' (Just replacementBrigApp) (accept (irEmail invite)) invite brig galley + void $ createAndVerifyInvitation' (Just replacementBrigApp) (accept (irInviteeEmail invite)) invite brig galley testInvitationEmailAndPhoneAccepted :: Brig -> Galley -> Http () testInvitationEmailAndPhoneAccepted brig galley = do inviteeEmail <- randomEmail inviteePhone <- randomPhone -- Prepare the extended invitation - let stdInvite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let stdInvite = stdInvitationRequest inviteeEmail inviteeName = Name "Invited Member" - extInvite = stdInvite {irPhone = Just inviteePhone, irInviteeName = Just inviteeName} + extInvite = stdInvite {irInviteePhone = Just inviteePhone, irInviteeName = Just inviteeName} -- Register the same (pre verified) phone number let phoneReq = RequestBodyLBS . encode $ object ["phone" .= fromPhone inviteePhone] post (brig . path "/activate/send" . contentJson . body phoneReq) !!! (const 200 === statusCode) @@ -304,7 +301,7 @@ testInvitationEmailAndPhoneAccepted brig galley = do liftIO $ assertEqual "Wrong name in profile" (Just inviteeName) (userDisplayName . selfUser <$> profile) liftIO $ assertEqual "Wrong name in invitation" (Just inviteeName) (inInviteeName invitation) liftIO $ assertEqual "Wrong phone number in profile" (Just inviteePhone) (join (userPhone . selfUser <$> profile)) - liftIO $ assertEqual "Wrong phone number in invitation" (Just inviteePhone) (inPhone invitation) + liftIO $ assertEqual "Wrong phone number in invitation" (Just inviteePhone) (inInviteePhone invitation) -- | FUTUREWORK: this is an alternative helper to 'createPopulatedBindingTeam'. it has been -- added concurrently, and the two should probably be consolidated. @@ -391,7 +388,7 @@ testCreateTeam brig galley aws = do liftIO $ assertBool "Member not part of the team" (uid == mem ^. Team.userId) -- Verify that the user cannot send invitations before activating their account inviteeEmail <- randomEmail - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest inviteeEmail postInvitation brig (team ^. Team.teamId) uid invite !!! const 403 === statusCode -- Verify that the team is still in status "pending" team2 <- getTeam galley (team ^. Team.teamId) @@ -427,7 +424,7 @@ testCreateTeamPreverified brig galley aws = do liftIO $ assertEqual "Team should already be active" Team.Active (Team.tdStatus team2) -- Verify that the user can already send invitations before activating their account inviteeEmail <- randomEmail - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest inviteeEmail postInvitation brig (team ^. Team.teamId) uid invite !!! const 201 === statusCode testInvitationNoPermission :: Brig -> Http () @@ -435,7 +432,7 @@ testInvitationNoPermission brig = do (_, tid) <- createUserWithTeam brig alice <- userId <$> randomUser brig email <- randomEmail - let invite = stdInvitationRequest email (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest email postInvitation brig tid alice invite !!! do const 403 === statusCode const (Just "insufficient-permissions") === fmap Error.label . responseJsonMaybe @@ -475,9 +472,9 @@ testTeamNoPassword brig = do testInvitationCodeExists :: Brig -> Http () testInvitationCodeExists brig = do - email <- randomEmail (uid, tid) <- createUserWithTeam brig - let invite email_ = stdInvitationRequest email_ (Name "Bob") Nothing Nothing + let invite email = stdInvitationRequest email + email <- randomEmail rsp <- postInvitation brig tid uid (invite email) responseJsonMaybe rsp Just invCode <- getInvitationCode brig tid invId @@ -557,14 +554,14 @@ testInvitationTooManyMembers brig galley (TeamSizeLimit limit) = do pooledForConcurrentlyN_ 16 [1 .. limit -1] $ \_ -> do void $ createTeamMember brig galley creator tid Team.fullPermissions SearchUtil.refreshIndex brig - em <- randomEmail - let invite = stdInvitationRequest em (Name "Bob") Nothing Nothing - inv <- responseJsonError =<< postInvitation brig tid creator invite + let invite email = stdInvitationRequest email + email <- randomEmail + inv <- responseJsonError =<< postInvitation brig tid creator (invite email) Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) post ( brig . path "/register" . contentJson - . body (accept em inviteeCode) + . body (accept email inviteeCode) ) !!! do const 403 === statusCode @@ -575,7 +572,7 @@ testInvitationPaging brig = do before <- liftIO $ toUTCTimeMillis . addUTCTime (-1) <$> getCurrentTime (uid, tid) <- createUserWithTeam brig let total = 5 - invite email = stdInvitationRequest email (Name "Bob") Nothing Nothing + invite email = stdInvitationRequest email emails <- replicateM total $ do email <- randomEmail postInvitation brig tid uid (invite email) !!! const 201 === statusCode @@ -596,7 +593,7 @@ testInvitationPaging brig = do validateInv :: Invitation -> Assertion validateInv inv = do assertEqual "tid" tid (inTeam inv) - assertBool "email" (inIdentity inv `elem` emails) + assertBool "email" (inInviteeEmail inv `elem` emails) -- (the output list is not ordered chronologically and emails are unique, so we just -- check whether the email is one of the valid ones.) assertBool "timestamp" (inCreatedAt inv > before && inCreatedAt inv < after1ms) @@ -611,7 +608,7 @@ testInvitationInfo :: Brig -> Http () testInvitationInfo brig = do email <- randomEmail (uid, tid) <- createUserWithTeam brig - let invite = stdInvitationRequest email (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest email inv <- responseJsonError =<< postInvitation brig tid uid invite Just invCode <- getInvitationCode brig tid (inInvitation inv) Just invitation <- getInvitation brig invCode @@ -628,7 +625,7 @@ testInvitationInfoExpired :: Brig -> Opt.Timeout -> Http () testInvitationInfoExpired brig timeout = do email <- randomEmail (uid, tid) <- createUserWithTeam brig - let invite = stdInvitationRequest email (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest email inv <- responseJsonError =<< postInvitation brig tid uid invite -- Note: This value must be larger than the option passed as `team-invitation-timeout` awaitExpiry (round timeout + 5) tid (inInvitation inv) @@ -655,7 +652,7 @@ testSuspendTeam brig = do inviteeEmail2 <- randomEmail (inviter, tid) <- createUserWithTeam brig -- invite and register invitee - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest inviteeEmail inv <- responseJsonError =<< postInvitation brig tid inviter invite Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) rsp2 <- @@ -667,7 +664,8 @@ testSuspendTeam brig = do responseJsonMaybe rsp2 -- invite invitee2 (don't register) - let invite2 = stdInvitationRequest inviteeEmail2 (Name "Bob") Nothing Nothing + let invite2 = stdInvitationRequest inviteeEmail2 + inv2 <- responseJsonError =<< postInvitation brig tid inviter invite2 Just _ <- getInvitationCode brig tid (inInvitation inv2) -- suspend team diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index 0ea886afe16..107ac430dba 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -84,7 +84,7 @@ createPopulatedBindingTeamWithNames brig names = do (inviter, tid) <- createUserWithTeam' brig invitees <- forM names $ \name -> do inviteeEmail <- randomEmail - let invite = stdInvitationRequest inviteeEmail name Nothing Nothing + let invite = stdInvitationRequest inviteeEmail inv <- responseJsonError =<< postInvitation brig tid (userId inviter) invite Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) rsp2 <- @@ -170,7 +170,7 @@ inviteAndRegisterUser :: m User inviteAndRegisterUser u tid brig = do inviteeEmail <- randomEmail - let invite = stdInvitationRequest inviteeEmail (Name "Bob") Nothing Nothing + let invite = stdInvitationRequest inviteeEmail inv <- responseJsonError =<< postInvitation brig tid u invite Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) rspInvitee <- @@ -437,9 +437,12 @@ isActivatedUser uid brig = do Just (_ : _) -> True _ -> False -stdInvitationRequest :: Email -> Name -> Maybe Locale -> Maybe Team.Role -> InvitationRequest -stdInvitationRequest e inviterName loc role = - InvitationRequest e inviterName loc role Nothing Nothing +stdInvitationRequest :: Email -> InvitationRequest +stdInvitationRequest = stdInvitationRequest' Nothing Nothing + +stdInvitationRequest' :: Maybe Locale -> Maybe Team.Role -> Email -> InvitationRequest +stdInvitationRequest' loc role email = + InvitationRequest loc role Nothing email Nothing setTeamTeamSearchVisibilityAvailable :: HasCallStack => Galley -> TeamId -> TeamFeatureStatusValue -> Http () setTeamTeamSearchVisibilityAvailable galley tid status = diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 5ecf9cb02d6..8560878e4dd 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -292,8 +292,7 @@ addUserToTeamWithRole' :: HasCallStack => Maybe Role -> UserId -> TeamId -> Test addUserToTeamWithRole' role inviter tid = do brig <- view tsBrig inviteeEmail <- randomEmail - let name = Name $ fromEmail inviteeEmail - let invite = InvitationRequest inviteeEmail name Nothing role Nothing Nothing + let invite = InvitationRequest Nothing role Nothing inviteeEmail Nothing invResponse <- postInvitation tid inviter invite inv <- responseJsonError invResponse Just inviteeCode <- getInvitationCode tid (inInvitation inv) @@ -301,7 +300,7 @@ addUserToTeamWithRole' role inviter tid = do post ( brig . path "/register" . contentJson - . body (acceptInviteBody name inviteeEmail inviteeCode) + . body (acceptInviteBody inviteeEmail inviteeCode) ) return (inv, r) @@ -326,11 +325,11 @@ makeOwner owner mem tid = do !!! const 200 === statusCode -acceptInviteBody :: Name -> Email -> InvitationCode -> RequestBody -acceptInviteBody name email code = +acceptInviteBody :: Email -> InvitationCode -> RequestBody +acceptInviteBody email code = RequestBodyLBS . encode $ object - [ "name" .= fromName name, + [ "name" .= Name "bob", "email" .= fromEmail email, "password" .= defPassword, "team_code" .= code diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 462f1d935b7..e3669d33953 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -358,7 +358,7 @@ inviteAndRegisterUser :: m User inviteAndRegisterUser brig u tid = do inviteeEmail <- randomEmail - let invite = TeamInvitation.InvitationRequest inviteeEmail (User.Name "Bob") Nothing Nothing Nothing Nothing + let invite = stdInvitationRequest inviteeEmail inv <- responseJsonError =<< postInvitation tid u invite Just inviteeCode <- getInvitationCode tid (TeamInvitation.inInvitation inv) rspInvitee <- @@ -1172,3 +1172,12 @@ checkErr status mlabel = do checkErrHspec :: HasCallStack => Int -> TestErrorLabel -> ResponseLBS -> Bool checkErrHspec status label resp = status == statusCode resp && responseJsonEither resp == Right label + +-- | copied from brig integration tests +stdInvitationRequest :: User.Email -> TeamInvitation.InvitationRequest +stdInvitationRequest = stdInvitationRequest' Nothing Nothing + +-- | copied from brig integration tests +stdInvitationRequest' :: Maybe User.Locale -> Maybe Galley.Role -> User.Email -> TeamInvitation.InvitationRequest +stdInvitationRequest' loc role email = + TeamInvitation.InvitationRequest loc role Nothing email Nothing From e27d21f6ac574d4a857cff2fcea8872bbbbb021d Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 27 Aug 2020 12:22:09 +0200 Subject: [PATCH 2/5] Fix harmless bug. --- services/galley/test/integration/API/Util.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 8560878e4dd..0ae437f2b31 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -243,9 +243,9 @@ bulkGetTeamMembersTruncated usr tid uids trnc = do ) getTeamMember :: HasCallStack => UserId -> TeamId -> UserId -> TestM TeamMember -getTeamMember usr tid mid = do +getTeamMember getter tid gettee = do g <- view tsGalley - r <- get (g . paths ["teams", toByteString' tid, "members", toByteString' mid] . zUser usr) TeamId -> UserId -> TestM TeamMember @@ -282,7 +282,7 @@ addUserToTeamWithRole role inviter tid = do let invitee :: User = responseJsonUnsafe rsp2 inviteeId = Brig.Types.userId invitee let invmeta = Just (inviter, inCreatedAt inv) - mem <- getTeamMember inviteeId tid inviteeId + mem <- getTeamMember inviter tid inviteeId liftIO $ assertEqual "Member has no/wrong invitation metadata" invmeta (mem ^. Team.invitation) let zuid = parseSetCookie <$> getHeader "Set-Cookie" rsp2 liftIO $ assertEqual "Wrong cookie" (Just "zuid") (setCookieName <$> zuid) From 3f24e3805064a8ae8d7fbbd02c22e015c1c4e53c Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 27 Aug 2020 12:23:20 +0200 Subject: [PATCH 3/5] Remove confused TODO. --- services/galley/test/integration/API/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 0ae437f2b31..8892fa136ee 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -278,7 +278,7 @@ addUserToTeam' u t = snd <$> addUserToTeamWithRole' Nothing u t addUserToTeamWithRole :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM TeamMember addUserToTeamWithRole role inviter tid = do - (inv, rsp2) <- addUserToTeamWithRole' role inviter tid -- TODO: Date: Thu, 27 Aug 2020 13:07:06 +0200 Subject: [PATCH 4/5] Separate Id creation and DB effects better. --- services/brig/src/Brig/Team/API.hs | 7 +++++-- services/brig/src/Brig/Team/DB.hs | 4 ++-- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 2c496518175..4a6f2e2a971 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -248,9 +248,11 @@ createInvitation uid tid body = do when (fromIntegral pending >= maxSize) $ throwStd tooManyTeamInvitations - lift $ doInvite inviteeRole inviter (irLocale body) email (irInviteeName body) phone + iid <- liftIO DB.mkInvitationId + lift $ doInvite iid inviteeRole inviter (irLocale body) email (irInviteeName body) phone where doInvite :: + InvitationId -> Team.Role -> CreateInvitationInviter -> Maybe Public.Locale -> @@ -258,11 +260,12 @@ createInvitation uid tid body = do Maybe Public.Name -> Maybe Public.Phone -> AppIO Invitation - doInvite role inviter lc toEmail toName toPhone = do + doInvite iid role inviter lc toEmail toName toPhone = do now <- liftIO =<< view currentTime timeout <- setTeamInvitationTimeout <$> view settings (newInv, code) <- DB.insertInvitation + iid tid role now diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index f98728598c2..76a472b768b 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -79,6 +79,7 @@ data InvitationByEmail insertInvitation :: MonadClient m => + InvitationId -> TeamId -> Role -> UTCTime -> @@ -89,8 +90,7 @@ insertInvitation :: -- | The timeout for the invitation code. Timeout -> m (Invitation, InvitationCode) -insertInvitation t role (toUTCTimeMillis -> now) minviter email inviteeName phone timeout = do - iid <- liftIO mkInvitationId +insertInvitation iid t role (toUTCTimeMillis -> now) minviter email inviteeName phone timeout = do code <- liftIO mkInvitationCode let inv = Invitation t role iid now minviter email inviteeName phone retry x5 . batch $ do From 6b6d15199f7c488f5696fbd4ac1b49847d7fd43f Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 28 Aug 2020 10:04:34 +0200 Subject: [PATCH 5/5] ormolu --- services/brig/src/Brig/Team/API.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 4a6f2e2a971..ee5d7366761 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -276,7 +276,6 @@ createInvitation uid tid body = do timeout newInv <$ sendInvitationMail toEmail tid (inviterEmail inviter) code lc - deleteInvitationH :: JSON ::: UserId ::: TeamId ::: InvitationId -> Handler Response deleteInvitationH (_ ::: uid ::: tid ::: iid) = do empty <$ deleteInvitation uid tid iid