[wip] wrap up the invitationcodestore

- port more functions to the store effect
- remove functions that are not needed anymore

TODO:
- actually swap out DB module functions with new functions from store
- move all remaining functions that are needed to make it work
- leave FUTUREWORK in DB module to make invitationcode store complete
- apply the same things for activationcode store i.e. (remove the old
  functions, move needed ones into subsystem, leave futurework for
  unneeded ones)

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

@@ -98,7 +98,7 @@ spec = do
           ("preferredLanguage", toJSON @Text mempty),
           ("locale", toJSON @Text mempty),
           ("password", toJSON @Text mempty),
-          ("emails", toJSON @[Email] mempty),
+          ("emails", toJSON @[EmailAddress] mempty),
           ("phoneNumbers", toJSON @[Phone] mempty),
           ("ims", toJSON @[IM] mempty),
           ("photos", toJSON @[Photo] mempty),

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

@@ -1,4 +1,6 @@
+{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -36,6 +38,7 @@ import Data.OpenApi qualified as S
 import Data.SOP
 import Data.Schema
 import Data.Text.Encoding qualified as TE
+import GHC.Records
 import Imports
 import Servant (FromHttpApiData (..), ToHttpApiData (..))
 import URI.ByteString
@@ -67,27 +70,27 @@ instance ToSchema InvitationRequest where
       InvitationRequest
         <$> locale
           .= optFieldWithDocModifier "locale" (description ?~ "Locale to use for the invitation.") (maybeWithDefault A.Null schema)
-        <*> role
+        <*> (getField @"role")
           .= optFieldWithDocModifier "role" (description ?~ "Role of the invitee (invited user).") (maybeWithDefault A.Null schema)
-        <*> inviteeName
+        <*> (getField @"inviteeName")
           .= optFieldWithDocModifier "name" (description ?~ "Name of the invitee (1 - 128 characters).") (maybeWithDefault A.Null schema)
-        <*> inviteeEmail
+        <*> (getField @"inviteeEmail")
           .= fieldWithDocModifier "email" (description ?~ "Email of the invitee.") schema
 
 --------------------------------------------------------------------------------
 -- Invitation
 
 data Invitation = Invitation
-  { inTeam :: TeamId,
-    inRole :: Role,
-    inInvitation :: InvitationId,
-    inCreatedAt :: UTCTimeMillis,
-    -- | this is always 'Just' for new invitations, but for
+  { team :: TeamId,
+    role :: Role,
+    invitationId :: InvitationId,
+    createdAt :: UTCTimeMillis,
+    -- | this is always 'Just' for newvitations, but for
     -- migration it is allowed to be 'Nothing'.
-    inCreatedBy :: Maybe UserId,
-    inInviteeEmail :: EmailAddress,
-    inInviteeName :: Maybe Name,
-    inInviteeUrl :: Maybe (URIRef Absolute)
+    createdBy :: Maybe UserId,
+    inviteeEmail :: EmailAddress,
+    inviteeName :: Maybe Name,
+    inviteeUrl :: Maybe (URIRef Absolute)
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Invitation)
@@ -99,22 +102,22 @@ instance ToSchema Invitation where
       "Invitation"
       (description ?~ "An invitation to join a team on Wire")
       $ Invitation
-        <$> inTeam
+        <$> (getField @"team")
           .= fieldWithDocModifier "team" (description ?~ "Team ID of the inviting team") schema
-        <*> inRole
+        <*> (getField @"role")
           -- clients, when leaving "role" empty, can leave the default role choice to us
           .= (fromMaybe defaultRole <$> optFieldWithDocModifier "role" (description ?~ "Role of the invited user") schema)
-        <*> inInvitation
+        <*> (getField @"invitationId")
           .= fieldWithDocModifier "id" (description ?~ "UUID used to refer the invitation") schema
-        <*> inCreatedAt
+        <*> (getField @"createdAt")
           .= fieldWithDocModifier "created_at" (description ?~ "Timestamp of invitation creation") schema
-        <*> inCreatedBy
+        <*> (getField @"createdBy")
           .= optFieldWithDocModifier "created_by" (description ?~ "ID of the inviting user") (maybeWithDefault A.Null schema)
-        <*> inInviteeEmail
+        <*> (getField @"inviteeEmail")
           .= fieldWithDocModifier "email" (description ?~ "Email of the invitee") schema
-        <*> inInviteeName
+        <*> (getField @"inviteeName")
           .= optFieldWithDocModifier "name" (description ?~ "Name of the invitee (1 - 128 characters)") (maybeWithDefault A.Null schema)
-        <*> (fmap (TE.decodeUtf8 . serializeURIRef') . inInviteeUrl)
+        <*> (fmap (TE.decodeUtf8 . serializeURIRef') . inviteeUrl)
           .= optFieldWithDocModifier "url" (description ?~ "URL of the invitation link to be sent to the invitee") (maybeWithDefault A.Null urlSchema)
     where
       urlSchema = parsedText "URIRef Absolute" (runParser (uriParser strictURIParserOptions) . TE.encodeUtf8)

libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs

@@ -67,7 +67,8 @@ data GalleyAPIAccess m a where
   AddTeamMember ::
     UserId ->
     TeamId ->
-    (Maybe (UserId, UTCTimeMillis), Role) ->
+    Maybe (UserId, UTCTimeMillis) ->
+    Role ->
     GalleyAPIAccess m Bool
   CreateTeam ::
     UserId ->

libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs

@@ -71,7 +71,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
           GetTeamConv id' id'' id'2 -> getTeamConv v id' id'' id'2
           NewClient id' ci -> newClient id' ci
           CheckUserCanJoinTeam id' -> checkUserCanJoinTeam id'
-          AddTeamMember id' id'' x0 -> addTeamMember id' id'' x0
+          AddTeamMember id' id'' a b -> addTeamMember id' id'' a b
           CreateTeam id' bnt id'' -> createTeam id' bnt id''
           GetTeamMember id' id'' -> getTeamMember id' id''
           GetTeamMembers id' -> getTeamMembers id'
@@ -234,9 +234,10 @@ addTeamMember ::
   ) =>
   UserId ->
   TeamId ->
-  (Maybe (UserId, UTCTimeMillis), Role) ->
+  Maybe (UserId, UTCTimeMillis) ->
+  Role ->
   Sem r Bool
-addTeamMember u tid (minvmeta, role) = do
+addTeamMember u tid minvmeta role = do
   debug $
     remote "galley"
       . msg (val "Adding member to team")

libs/wire-subsystems/src/Wire/InvitationCodeStore.hs

@@ -14,6 +14,7 @@
 --
 -- 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/>.
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -27,19 +28,22 @@ import Imports
 import Polysemy
 import Polysemy.TinyLog (TinyLog)
 import System.Logger.Message qualified as Log
-import Wire.API.Team.Role (Role)
-import Wire.API.User (Email, InvitationCode, Name)
+import Wire.API.Team.Invitation (Invitation (inviteeEmail))
+import Wire.API.Team.Invitation qualified as Public
+import Wire.API.Team.Role (Role, defaultRole)
+import Wire.API.User (EmailAddress, InvitationCode, Name)
 import Wire.Arbitrary (Arbitrary, GenericUniform (..))
+import Wire.GalleyAPIAccess (ShowOrHideInvitationUrl)
 import Wire.Sem.Logger qualified as Log
 
 data StoredInvitation = MkStoredInvitation
   { teamId :: TeamId,
-    mrole :: Maybe Role,
-    invId :: InvitationId,
+    role :: Maybe Role,
+    invitationId :: InvitationId,
     createdAt :: UTCTimeMillis,
-    mcreatedBy :: Maybe UserId,
-    email :: Email,
-    mname :: Maybe Name,
+    createdBy :: Maybe UserId,
+    email :: EmailAddress,
+    name :: Maybe Name,
     code :: InvitationCode
   }
   deriving (Show, Eq, Generic)
@@ -49,7 +53,7 @@ recordInstance ''StoredInvitation
 
 data StoredInvitationByTeam = MkStoredInvitationByTeam
   { teamId :: TeamId,
-    invId :: InvitationId,
+    invitationId :: InvitationId,
     code :: InvitationCode
     -- TODO(mangoiv): maybe we can drop this last element
   }
@@ -60,16 +64,23 @@ recordInstance ''StoredInvitationByTeam
 
 data InvitationCodeStore :: Effect where
   LookupInvitation :: TeamId -> InvitationId -> InvitationCodeStore m (Maybe StoredInvitation)
-  LookupInvitationCodesByEmail :: Email -> InvitationCodeStore m [StoredInvitationByTeam]
+  LookupInvitationInfo :: InvitationCode -> InvitationCodeStore m (Maybe (TeamId, InvitationId))
+  LookupInvitationCodesByEmail :: EmailAddress -> InvitationCodeStore m [StoredInvitationByTeam]
 
 makeSem ''InvitationCodeStore
 
-lookupInvitationByEmail :: (Member InvitationCodeStore r, Member TinyLog r) => Email -> Sem r (Maybe StoredInvitation)
-lookupInvitationByEmail email = runMaybeT do
-  MkStoredInvitationByTeam {teamId, invId} <- MaybeT $ lookupSingleInvitationCodeByEmail email
-  MaybeT $ lookupInvitation teamId invId
+-- TODO: account for show/hide?
+lookupInvitationByEmail :: (Member InvitationCodeStore r, Member TinyLog r) => ShowOrHideInvitationUrl -> EmailAddress -> Sem r (Maybe StoredInvitation)
+lookupInvitationByEmail _ email = runMaybeT do
+  MkStoredInvitationByTeam {teamId, invitationId} <- MaybeT $ lookupSingleInvitationCodeByEmail email
+  MaybeT $ lookupInvitation teamId invitationId
 
-lookupSingleInvitationCodeByEmail :: (Member TinyLog r, Member InvitationCodeStore r) => Email -> Sem r (Maybe StoredInvitationByTeam)
+lookupInvitationByCode :: (Member InvitationCodeStore r) => ShowOrHideInvitationUrl -> InvitationCode -> Sem r (Maybe StoredInvitation)
+lookupInvitationByCode _ code = runMaybeT do
+  (tid, iid) <- MaybeT $ lookupInvitationInfo code
+  MaybeT $ lookupInvitation tid iid
+
+lookupSingleInvitationCodeByEmail :: (Member TinyLog r, Member InvitationCodeStore r) => EmailAddress -> Sem r (Maybe StoredInvitationByTeam)
 lookupSingleInvitationCodeByEmail email = do
   invs <- lookupInvitationCodesByEmail email
   case invs of
@@ -82,3 +93,16 @@ lookupSingleInvitationCodeByEmail email = do
           . Log.field "email" (show email)
 
       pure Nothing
+
+invitationFromStored :: StoredInvitation -> Public.Invitation
+invitationFromStored MkStoredInvitation {..} =
+  Public.Invitation
+    { team = teamId,
+      role = fromMaybe defaultRole role,
+      invitationId = invitationId,
+      createdAt = createdAt,
+      createdBy = createdBy,
+      inviteeEmail = email,
+      inviteeName = name,
+      inviteeUrl = Nothing -- TODO: Huh?
+    }

libs/wire-subsystems/src/Wire/InvitationCodeStore/Cassandra.hs

@@ -15,11 +15,21 @@ interpretInvitationCodeStoreToCassandra casClient =
     runEmbedded (runClient casClient) . \case
       LookupInvitation tid iid -> embed $ lookupInvitationImpl tid iid
       LookupInvitationCodesByEmail email -> embed $ lookupInvitationCodesByEmailImpl email
+      LookupInvitationInfo code -> embed $ lookupInvitationInfoImpl code
 
-lookupInvitationCodesByEmailImpl :: Email -> Client [StoredInvitationByTeam]
+lookupInvitationInfoImpl :: InvitationCode -> Client (Maybe (TeamId, InvitationId))
+lookupInvitationInfoImpl code = retry x1 (query1 cql (params LocalQuorum (Identity code)))
+  where
+    cql :: PrepQuery R (Identity InvitationCode) (TeamId, InvitationId)
+    cql =
+      [sql| 
+      SELECT team, id FROM team_invitation_info WHERE code = ?
+      |]
+
+lookupInvitationCodesByEmailImpl :: EmailAddress -> Client [StoredInvitationByTeam]
 lookupInvitationCodesByEmailImpl email = map asRecord <$> retry x1 (query cql (params LocalQuorum (Identity email)))
   where
-    cql :: PrepQuery R (Identity Email) (TeamId, InvitationId, InvitationCode)
+    cql :: PrepQuery R (Identity EmailAddress) (TeamId, InvitationId, InvitationCode)
     cql =
       [sql| 
       SELECT team, invitation, code FROM team_invitation_email WHERE email = ?

libs/wire-subsystems/src/Wire/UserSubsystem.hs

@@ -60,7 +60,7 @@ data GetBy = MkGetBy
     -- | get accounds by 'UserId's
     getByUserIds :: ![UserId],
     -- | get accounds by 'Email's
-    getByEmail :: ![Email],
+    getByEmail :: ![EmailAddress],
     -- | get accounds by their 'Handle'
     getByHandle :: ![Handle]
   }

libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs

@@ -540,7 +540,7 @@ getAccountsByImpl (tSplit -> (domain, MkGetBy {includePendingInvitations, getByE
               Just ident -> case (accountStatus account, includePendingInvitations, emailIdentity ident) of
                 (PendingInvitation, False, _) -> notValid
                 (PendingInvitation, True, Just email) ->
-                  lookupInvitationByEmail email >>= \case
+                  lookupInvitationByEmail HideInvitationUrl email >>= \case
                     Nothing -> notValid
                     Just _ -> do
                       -- user invited via scim should expire together with its invitation

libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationCodeStore.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 module Wire.MockInterpreters.InvitationCodeStore where
 
@@ -13,6 +14,7 @@ import Wire.InvitationCodeStore
 inMemoryInvitationCodeStoreInterpreter :: forall r. (Member (State (Map (TeamId, InvitationId) StoredInvitation)) r) => InterpreterFor InvitationCodeStore r
 inMemoryInvitationCodeStoreInterpreter = interpret \case
   LookupInvitation tid iid -> gets (!? (tid, iid))
+  LookupInvitationInfo _iid -> todo
   LookupInvitationCodesByEmail em ->
     let c MkStoredInvitation {..}
           | email == em = Just MkStoredInvitationByTeam {..}