WPB-26474: extends code to meetings

changelog.d/5-internal/WPB-26474-code-store-meetings

@@ -0,0 +1 @@
+Extend the conversation Code store to support meeting access codes in addition to conversation codes. Adds a backwards-compatible `target` column to the `conversation_codes` Postgres table (defaults to `'conv'`); the Cassandra store continues to serve conversation codes only. Foundational work for meeting access codes.

libs/wire-subsystems/postgres-migrations/20260619120000-conversation-codes-target.sql

@@ -0,0 +1,4 @@
+-- Distinguish conversation codes from meeting codes. Existing rows refer to
+-- conversations, so the default is 'conv'. Meeting codes store 'meeting'.
+ALTER TABLE conversation_codes
+  ADD COLUMN target text DEFAULT 'conv' NOT NULL;

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

@@ -20,7 +20,6 @@
 module Wire.CodeStore where
 
 import Data.Code
-import Data.Id
 import Data.Misc
 import Imports
 import Polysemy
@@ -31,8 +30,8 @@ data CodeStore m a where
   CreateCode :: Code -> Maybe Password -> CodeStore m ()
   GetCode :: Key -> CodeStore m (Maybe (Code, Maybe Password))
   DeleteCode :: Key -> CodeStore m ()
-  MakeKey :: ConvId -> CodeStore m Key
-  GenerateCode :: ConvId -> Timeout -> CodeStore m Code
+  MakeKey :: CodeReferent -> CodeStore m Key
+  GenerateCode :: CodeReferent -> Timeout -> CodeStore m Code
   GetConversationCodeURI :: Maybe Text -> CodeStore m (Maybe HttpsUrl)
 
 makeSem ''CodeStore

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

@@ -47,10 +47,14 @@ interpretCodeStoreToCassandra = interpret $ \case
     embedClientInput $ insertCode code mPw
   DeleteCode k -> do
     embedClientInput $ deleteCode k
-  MakeKey cid -> do
-    Code.mkKey cid
-  GenerateCode cid t -> do
-    Code.generate cid t
+  MakeKey ref -> case ref of
+    CodeReferentConv _ -> Code.mkKey ref
+    CodeReferentMeeting _ ->
+      error "CodeStore.Cassandra.MakeKey: meetings are not supported on cassandra"
+  GenerateCode ref t -> case ref of
+    CodeReferentConv _ -> Code.generate ref t
+    CodeReferentMeeting _ ->
+      error "CodeStore.Cassandra.GenerateCode: meetings are not supported on cassandra"
   GetConversationCodeURI mbHost -> do
     convCodeURI <- input
     case convCodeURI of
@@ -65,14 +69,21 @@ insertCode :: Code -> Maybe Password -> Client ()
 insertCode c mPw = do
   let k = codeKey c
   let v = codeValue c
-  let cnv = codeConversation c
+  let cnv = convReferent (codeReferent c)
   let t = round (codeTTL c)
   retry x5 (write Cql.insertCode (params LocalQuorum (k, v, cnv, mPw, t)))
+  where
+    -- Cassandra only stores conversation codes; meeting codes never reach here
+    -- because 'GenerateCode' errors out for meetings above.
+    convReferent (CodeReferentConv cid) = cid
+    convReferent CodeReferentMeeting {} =
+      error "CodeStore.Cassandra.insertCode: meetings are not supported on cassandra"
 
 -- | Lookup a conversation by code.
 lookupCode :: Key -> Client (Maybe (Code, Maybe Password))
 lookupCode k =
-  fmap (toCode k) <$> retry x1 (query1 Cql.lookupCode (params LocalQuorum (Identity k)))
+  fmap (toCode k . (\(val, ttl, cnv, mPw) -> (val, ttl, CodeReferentConv cnv, mPw)))
+    <$> retry x1 (query1 Cql.lookupCode (params LocalQuorum (Identity k)))
 
 -- | Delete a code associated with the given conversation key
 deleteCode :: Key -> Client ()

libs/wire-subsystems/src/Wire/CodeStore/Code.hs

@@ -19,6 +19,8 @@
 
 module Wire.CodeStore.Code
   ( Code (..),
+    CodeReferent (..),
+    codeConvId,
     toCode,
     generate,
     mkKey,
@@ -36,48 +38,67 @@ import OpenSSL.EVP.Digest (digestBS, getDigestByName)
 import OpenSSL.Random (randBytes)
 import Wire.API.Password (Password)
 
+-- | The conversation or meeting a 'Code' refers to. Since both 'ConvId' and
+-- 'MeetingId' are 'Id' values over a 'UUID', they are stored in a single uuid
+-- column on the database, disambiguated by this constructor.
+data CodeReferent
+  = CodeReferentConv ConvId
+  | CodeReferentMeeting MeetingId
+  deriving (Eq, Show, Generic)
+
 data Code = Code
   { codeKey :: !Key,
     codeValue :: !Value,
     codeTTL :: !Timeout,
-    codeConversation :: !ConvId,
+    codeReferent :: !CodeReferent,
     codeHasPassword :: !Bool
   }
   deriving (Eq, Show, Generic)
 
-toCode :: Key -> (Value, Int32, ConvId, Maybe Password) -> (Code, Maybe Password)
-toCode k (val, ttl, cnv, mPw) =
+toCode :: Key -> (Value, Int32, CodeReferent, Maybe Password) -> (Code, Maybe Password)
+toCode k (val, ttl, ref, mPw) =
   ( Code
       { codeKey = k,
         codeValue = val,
         codeTTL = Timeout (fromIntegral ttl),
-        codeConversation = cnv,
+        codeReferent = ref,
         codeHasPassword = isJust mPw
       },
     mPw
   )
 
+-- | Extract the 'ConvId' from a 'Code' that refers to a conversation.
+-- Returns 'Nothing' for codes that refer to a meeting.
+codeConvId :: Code -> Maybe ConvId
+codeConvId c = case codeReferent c of
+  CodeReferentConv cid -> Just cid
+  CodeReferentMeeting _ -> Nothing
+
 -- Note on key/value used for a conversation Code
 --
 -- For similar reasons to those given for Codes used for verification, Password reset, etc
 -- (see services/brig/src/Brig/Code.hs Note [Unique keys])
 -- The 'key' is a stable, truncated, base64 encoded sha256 hash of the conversation ID
 -- The 'value' is a base64 encoded, 120-bit random value (changing on each generation)
 
-generate :: (MonadIO m) => ConvId -> Timeout -> m Code
-generate cnv t = do
-  key <- mkKey cnv
+generate :: (MonadIO m) => CodeReferent -> Timeout -> m Code
+generate ref t = do
+  key <- mkKey ref
   val <- liftIO $ Value . unsafeRange . Ascii.encodeBase64Url <$> randBytes 15
   pure
     Code
       { codeKey = key,
         codeValue = val,
-        codeConversation = cnv,
+        codeReferent = ref,
         codeTTL = t,
         codeHasPassword = False
       }
 
-mkKey :: (MonadIO m) => ConvId -> m Key
-mkKey cnv = do
+mkKey :: (MonadIO m) => CodeReferent -> m Key
+mkKey (CodeReferentConv cid) = mkKeyId cid
+mkKey (CodeReferentMeeting mid) = mkKeyId mid
+
+mkKeyId :: (MonadIO m) => Id a -> m Key
+mkKeyId ident = do
   sha256 <- liftIO $ fromJust <$> getDigestByName "SHA256"
-  pure $ Key . unsafeRange . Ascii.encodeBase64Url . BS.take 15 $ digestBS sha256 (toByteString' cnv)
+  pure $ Key . unsafeRange . Ascii.encodeBase64Url . BS.take 15 $ digestBS sha256 (toByteString' ident)

libs/wire-subsystems/src/Wire/CodeStore/DualWrite.hs

@@ -28,6 +28,7 @@ import Polysemy.Input
 import Wire.CodeStore (CodeStore (..))
 import Wire.CodeStore qualified as CodeStore
 import Wire.CodeStore.Cassandra qualified as Cassandra
+import Wire.CodeStore.Code (CodeReferent (..))
 import Wire.CodeStore.Postgres qualified as Postgres
 import Wire.Postgres (PGConstraints)
 
@@ -48,9 +49,11 @@ interpretCodeStoreToCassandraAndPostgres = interpret $ \case
   DeleteCode k -> do
     Cassandra.interpretCodeStoreToCassandra $ CodeStore.deleteCode k
     Postgres.interpretCodeStoreToPostgres $ CodeStore.deleteCode k
-  MakeKey cid -> do
-    Cassandra.interpretCodeStoreToCassandra $ CodeStore.makeKey cid
-  GenerateCode cid t -> do
-    Cassandra.interpretCodeStoreToCassandra $ CodeStore.generateCode cid t
+  MakeKey ref -> case ref of
+    CodeReferentConv _ -> Cassandra.interpretCodeStoreToCassandra $ CodeStore.makeKey ref
+    CodeReferentMeeting _ -> Postgres.interpretCodeStoreToPostgres $ CodeStore.makeKey ref
+  GenerateCode ref t -> case ref of
+    CodeReferentConv _ -> Cassandra.interpretCodeStoreToCassandra $ CodeStore.generateCode ref t
+    CodeReferentMeeting _ -> Postgres.interpretCodeStoreToPostgres $ CodeStore.generateCode ref t
   GetConversationCodeURI mbHost -> do
     Cassandra.interpretCodeStoreToCassandra $ CodeStore.getConversationCodeURI mbHost

libs/wire-subsystems/src/Wire/CodeStore/Migration.hs

@@ -132,7 +132,7 @@ migrateCodeRow ::
   Sem r ()
 migrateCodeRow migOpts migCounter migDuration (k, v, ttl, cnv, mPw) =
   when (ttl > 0) $ do
-    let (code, _) = toCode k (v, ttl, cnv, mPw)
+    let (code, _) = toCode k (v, ttl, CodeReferentConv cnv, mPw)
         keyText = T.pack (show k)
     outcomeRef <- liftIO $ IORef.newIORef @Text "error"
     bracket

libs/wire-subsystems/src/Wire/CodeStore/Postgres.hs

@@ -21,6 +21,7 @@ module Wire.CodeStore.Postgres
 where
 
 import Data.Code
+import Data.Coerce (coerce)
 import Data.Id
 import Data.Map qualified as Map
 import Data.Misc (HttpsUrl)
@@ -48,10 +49,10 @@ interpretCodeStoreToPostgres = interpret $ \case
     insertCode code mPw
   DeleteCode k -> do
     deleteCode k
-  MakeKey cid -> do
-    Code.mkKey cid
-  GenerateCode cid t -> do
-    Code.generate cid t
+  MakeKey ref -> do
+    Code.mkKey ref
+  GenerateCode ref t -> do
+    Code.generate ref t
   GetConversationCodeURI mbHost -> do
     convCodeURI <- input
     pure $ case convCodeURI of
@@ -60,28 +61,37 @@ interpretCodeStoreToPostgres = interpret $ \case
 
 insertCode :: (PGConstraints r) => Code -> Maybe Password -> Sem r ()
 insertCode c password = do
-  runStatement (codeKey c, codeConversation c, password, codeValue c, round (codeTTL c)) insert
+  runStatement (codeKey c, cnv, password, codeValue c, round (codeTTL c), targetTxt) insert
   where
-    insert :: Hasql.Statement (Key, ConvId, Maybe Password, Value, Int32) ()
+    (cnv, targetTxt) = case codeReferent c of
+      CodeReferentConv cid -> (cid, "conv")
+      CodeReferentMeeting mid -> (coerce mid, "meeting")
+    insert :: Hasql.Statement (Key, ConvId, Maybe Password, Value, Int32, Text) ()
     insert =
       lmapPG
         [resultlessStatement|INSERT INTO conversation_codes
-                               (key, conversation, password, value, expires_at)
+                               (key, conversation, password, value, expires_at, target)
                              VALUES
-                               ($1 :: text, $2 :: uuid, $3 :: bytea?, $4 :: text, now() + make_interval(secs => $5 :: int))
+                               ($1 :: text, $2 :: uuid, $3 :: bytea?, $4 :: text, now() + make_interval(secs => $5 :: int), $6 :: text)
                              ON CONFLICT (key) DO UPDATE
                              SET conversation = ($2 :: uuid),
                                  password = ($3 :: bytea?),
                                  value = ($4 :: text),
-                                 expires_at = now() + make_interval(secs => $5 :: int)
+                                 expires_at = now() + make_interval(secs => $5 :: int),
+                                 target = ($6 :: text)
          |]
 
 lookupCode :: (PGConstraints r) => Key -> Sem r (Maybe (Code, Maybe Password))
 lookupCode k = do
   mRow <- runStatement k selectCode
-  pure $ fmap (toCode k) mRow
+  pure $ fmap (toCode k . mkReferent) mRow
   where
-    selectCode :: Hasql.Statement Key (Maybe (Value, Int32, ConvId, Maybe Password))
+    mkReferent (val, ttl, cnv, mPw, targetTxt) =
+      let ref = case targetTxt :: Text of
+            "meeting" -> CodeReferentMeeting (coerce cnv)
+            _ -> CodeReferentConv cnv
+       in (val, ttl, ref, mPw)
+    selectCode :: Hasql.Statement Key (Maybe (Value, Int32, ConvId, Maybe Password, Text))
     selectCode =
       dimapPG
         -- on the extraction of the remaining seconds of the TTL
@@ -94,7 +104,8 @@ lookupCode k = do
                           value :: text,
                           GREATEST(0, FLOOR(EXTRACT(EPOCH FROM (expires_at - now()))))::int4 AS ttl_secs,
                           conversation :: uuid,
-                          password :: bytea?
+                          password :: bytea?,
+                          target :: text
                         FROM conversation_codes
                         WHERE key = ($1 :: text) AND expires_at > now ()
                         |]

libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs

@@ -114,6 +114,7 @@ import Wire.BackendNotificationQueueAccess
 import Wire.BrigAPIAccess qualified as E
 import Wire.CodeStore
 import Wire.CodeStore qualified as E
+import Wire.CodeStore.Code (CodeReferent (..))
 import Wire.ConversationStore qualified as E
 import Wire.ConversationSubsystem.Action.Kick
 import Wire.ConversationSubsystem.Action.Leave
@@ -390,7 +391,7 @@ instance IsConversationAction 'ConversationDeleteTag where
         deleteGroup gidSub
       deleteGroup gidParent
 
-    key <- E.makeKey (tUnqualified lcnv)
+    key <- E.makeKey (CodeReferentConv (tUnqualified lcnv))
     E.deleteCode key
     case convTeam storedConv of
       Nothing -> E.deleteConversation (tUnqualified lcnv)
@@ -912,7 +913,7 @@ performConversationAccessData qusr lconv action = do
         && CodeAccess `notElem` cupAccess action
     )
     $ do
-      key <- E.makeKey (tUnqualified lcnv)
+      key <- E.makeKey (CodeReferentConv (tUnqualified lcnv))
       E.deleteCode key
 
   -- Determine bots and members to be removed

libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs

@@ -98,7 +98,7 @@ import Wire.API.Team.Member (HiddenPerm (..), TeamMember)
 import Wire.API.User
 import Wire.BrigAPIAccess (BrigAPIAccess)
 import Wire.CodeStore
-import Wire.CodeStore.Code (Code (codeConversation))
+import Wire.CodeStore.Code (codeConvId)
 import Wire.CodeStore.Code qualified as Data
 import Wire.ConversationStore qualified as ConversationStore
 import Wire.ConversationStore.MLS.Types
@@ -656,7 +656,8 @@ getConversationByReusableCode ::
   Sem r ConversationCoverView
 getConversationByReusableCode lusr key value = do
   c <- verifyReusableCode (RateLimitUser (tUnqualified lusr)) False Nothing (ConversationCode key value)
-  conv <- ConversationStore.getConversation (codeConversation c) >>= noteS @'ConvNotFound
+  codeCid <- noteS @'ConvNotFound (codeConvId c)
+  conv <- ConversationStore.getConversation codeCid >>= noteS @'ConvNotFound
   ensureConversationAccess (tUnqualified lusr) conv CodeAccess
   ensureGuestLinksEnabled (Data.convTeam conv)
   pure $ coverView c conv

libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs

@@ -529,11 +529,11 @@ addCode lusr mbZHost mZcon lcnv mReq = do
   ensureAccess conv CodeAccess
   ensureGuestsOrNonTeamMembersAllowed conv
   convUri <- getConversationCodeURI mbZHost
-  key <- E.makeKey (tUnqualified lcnv)
+  key <- E.makeKey (CodeReferentConv (tUnqualified lcnv))
   E.getCode key >>= \case
     Nothing -> do
       ttl <- inputs (realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds)
-      code <- E.generateCode (tUnqualified lcnv) (Timeout ttl)
+      code <- E.generateCode (CodeReferentConv (tUnqualified lcnv)) (Timeout ttl)
       mPw <- for (mReq >>= (.password)) $ HashPassword.hashPassword8 (RateLimitUser (tUnqualified lusr))
       E.createCode code mPw
       now <- Now.get
@@ -594,7 +594,7 @@ rmCode lusr zcon lcnv = do
   Query.ensureConvAdmin conv (tUnqualified lusr) mTeamMember
   ensureAccess conv CodeAccess
   let (bots, users) = localBotsAndUsers $ conv.localMembers
-  key <- E.makeKey (tUnqualified lcnv)
+  key <- E.makeKey (CodeReferentConv (tUnqualified lcnv))
   E.deleteCode key
   now <- Now.get
   let event = Event (tUntagged lcnv) Nothing (EventFromUser (tUntagged lusr)) now Nothing EdConvCodeDelete
@@ -621,7 +621,7 @@ getCode mbZHost lusr cnv = do
   Query.ensureGuestLinksEnabled (convTeam conv)
   ensureAccess conv CodeAccess
   ensureConvMember (conv.localMembers) (tUnqualified lusr)
-  key <- E.makeKey cnv
+  key <- E.makeKey (CodeReferentConv cnv)
   (c, mPw) <- E.getCode key >>= noteS @'CodeNotFound
   convUri <- getConversationCodeURI mbZHost
   pure $ mkConversationCodeInfo (isJust mPw) (codeKey c) (codeValue c) convUri
@@ -642,7 +642,8 @@ checkReusableCode ::
   Sem r ()
 checkReusableCode origIp convCode = do
   code <- verifyReusableCode (RateLimitIp origIp) False Nothing convCode
-  conv <- E.getConversation (codeConversation code) >>= noteS @'ConvNotFound
+  codeCid <- noteS @'ConvNotFound (codeConvId code)
+  conv <- E.getConversation codeCid >>= noteS @'ConvNotFound
   mapErrorS @'GuestLinksDisabled @'CodeNotFound $
     Query.ensureGuestLinksEnabled (convTeam conv)
 
@@ -761,7 +762,8 @@ joinConversationByReusableCode ::
   Sem r (UpdateResult Event)
 joinConversationByReusableCode lusr zcon req = do
   c <- verifyReusableCode (RateLimitUser (tUnqualified lusr)) True req.password req.code
-  conv <- E.getConversation (codeConversation c) >>= noteS @'ConvNotFound
+  codeCid <- noteS @'ConvNotFound (codeConvId c)
+  conv <- E.getConversation codeCid >>= noteS @'ConvNotFound
   Query.ensureGuestLinksEnabled (convTeam conv)
   joinConversation lusr zcon conv CodeAccess