From 91487b2068fa83b5c0152a33203e8ef2590a89a5 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Wed, 31 May 2023 10:23:39 +0000 Subject: [PATCH] add new generation to GroupId --- libs/wire-api/src/Wire/API/MLS/Group.hs | 4 +++ .../src/Wire/API/MLS/Group/Serialisation.hs | 27 ++++++++++++++----- .../test/unit/Test/Wire/API/MLS/Group.hs | 11 +++++--- services/galley/src/Galley/API/Internal.hs | 2 +- .../src/Galley/API/MLS/SubConversation.hs | 5 ++-- services/galley/src/Galley/API/MLS/Util.hs | 2 +- .../src/Galley/Cassandra/Conversation.hs | 6 ++--- services/galley/test/integration/API/MLS.hs | 7 +++++ .../galley/test/integration/API/MLS/Util.hs | 4 +-- 9 files changed, 49 insertions(+), 19 deletions(-) diff --git a/libs/wire-api/src/Wire/API/MLS/Group.hs b/libs/wire-api/src/Wire/API/MLS/Group.hs index c659cec0798..fcb33a5e36f 100644 --- a/libs/wire-api/src/Wire/API/MLS/Group.hs +++ b/libs/wire-api/src/Wire/API/MLS/Group.hs @@ -44,3 +44,7 @@ instance ToSchema GroupId where GroupId <$> unGroupId .= named "GroupId" (Base64ByteString .= fmap fromBase64ByteString (unnamed schema)) + +newtype GroupIdGen = GroupIdGen {unGroupIdGen :: Word32} + deriving (Eq, Show, Generic, Ord) + deriving (Arbitrary) via (GenericUniform GroupIdGen) diff --git a/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs index 6ebfe46abcf..f735a8a40df 100644 --- a/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs @@ -17,7 +17,9 @@ module Wire.API.MLS.Group.Serialisation ( convToGroupId, + convToGroupId', groupIdToConv, + nextGenGroupId, ) where @@ -39,21 +41,25 @@ import Wire.API.MLS.SubConversation -- | Return the group ID associated to a conversation ID. Note that is not -- assumed to be stable over time or even consistent among different backends. -convToGroupId :: Qualified ConvOrSubConvId -> GroupId -convToGroupId qcs = GroupId . L.toStrict . runPut $ do +convToGroupId :: Qualified ConvOrSubConvId -> GroupIdGen -> GroupId +convToGroupId qcs gen = GroupId . L.toStrict . runPut $ do let cs = qUnqualified qcs subId = foldMap unSubConvId cs.subconv putWord64be 1 -- Version 1 of the GroupId format putLazyByteString . UUID.toByteString . toUUID $ cs.conv putWord8 $ fromIntegral (T.length subId) putByteString $ T.encodeUtf8 subId + maybe (pure ()) (const $ putWord32be (unGroupIdGen gen)) cs.subconv putLazyByteString . toByteString $ qDomain qcs -groupIdToConv :: GroupId -> Either String (Qualified ConvOrSubConvId) +convToGroupId' :: Qualified ConvOrSubConvId -> GroupId +convToGroupId' = flip convToGroupId (GroupIdGen 0) + +groupIdToConv :: GroupId -> Either String (Qualified ConvOrSubConvId, GroupIdGen) groupIdToConv gid = do - (rem', _, conv) <- first (\(_, _, msg) -> msg) $ runGetOrFail readConv (L.fromStrict (unGroupId gid)) + (rem', _, (conv, gen)) <- first (\(_, _, msg) -> msg) $ runGetOrFail readConv (L.fromStrict (unGroupId gid)) domain <- first displayException . T.decodeUtf8' . L.toStrict $ rem' - pure $ Qualified conv (Domain domain) + pure $ (Qualified conv (Domain domain), gen) where readConv = do version <- getWord64be @@ -62,8 +68,15 @@ groupIdToConv gid = do uuid <- maybe (fail "invalid conversation UUID in groupId") pure mUUID n <- getWord8 if n == 0 - then pure $ Conv (Id uuid) + then pure $ (Conv (Id uuid), GroupIdGen 0) else do subConvIdBS <- getByteString $ fromIntegral n subConvId <- either (fail . T.unpack) pure $ parseHeader subConvIdBS - pure $ SubConv (Id uuid) (SubConvId subConvId) + gen <- getWord32be + pure $ (SubConv (Id uuid) (SubConvId subConvId), GroupIdGen gen) + +nextGenGroupId :: GroupId -> Either String GroupId +nextGenGroupId gid = + uncurry convToGroupId + . second (GroupIdGen . succ . unGroupIdGen) + <$> groupIdToConv gid diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS/Group.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS/Group.hs index 1d51b4ea340..c20998b8e4b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/MLS/Group.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/MLS/Group.hs @@ -22,8 +22,9 @@ import Imports import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck +import Wire.API.MLS.Group import Wire.API.MLS.Group.Serialisation -import Wire.API.MLS.SubConversation (ConvOrSubConvId) +import Wire.API.MLS.SubConversation tests :: TestTree tests = @@ -32,5 +33,9 @@ tests = [ testProperty "roundtrip serialise and parse groupId" $ roundtripGroupId ] -roundtripGroupId :: Qualified ConvOrSubConvId -> Property -roundtripGroupId convId = groupIdToConv (convToGroupId convId) === Right convId +roundtripGroupId :: Qualified ConvOrSubConvId -> GroupIdGen -> Property +roundtripGroupId convId gen = + let gen' = case qUnqualified convId of + (Conv _) -> GroupIdGen 0 + (SubConv _ _) -> gen + in groupIdToConv (convToGroupId convId gen) === Right (convId, gen') diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 6e4bf7ac98e..4b080cbbfe9 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -486,5 +486,5 @@ iGetMLSClientListForConv :: ConvId -> Sem r ClientList iGetMLSClientListForConv lusr cnv = do - cm <- E.lookupMLSClients (convToGroupId (Conv <$> tUntagged (qualifyAs lusr cnv))) + cm <- E.lookupMLSClients (convToGroupId' (Conv <$> tUntagged (qualifyAs lusr cnv))) pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs cm)) diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index 6585582893b..b16c0001fad 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -127,7 +127,7 @@ getLocalSubConversation qusr lconv sconv = do -- deriving this detemernistically to prevent race condition between -- multiple threads creating the subconversation - let groupId = convToGroupId $ flip SubConv sconv <$> tUntagged lconv + let groupId = convToGroupId' $ flip SubConv sconv <$> tUntagged lconv epoch = Epoch 0 suite = cnvmlsCipherSuite mlsMeta Eff.createSubConversation (tUnqualified lconv) sconv suite epoch groupId Nothing @@ -293,7 +293,8 @@ deleteLocalSubConversation qusr lcnvId scnvId dsc = do unless (dscEpoch dsc == epoch) $ throwS @'MLSStaleMessage Eff.removeAllMLSClients gid - let newGid = convToGroupId (flip SubConv scnvId <$> tUntagged lcnvId) + -- TODO(SB) swallowing the error and starting with GroupIdGen 0 if nextGenGroupId + let newGid = fromRight (convToGroupId' (flip SubConv scnvId <$> tUntagged lcnvId)) $ nextGenGroupId gid -- the following overwrites any prior information about the subconversation Eff.createSubConversation cnvId scnvId cs (Epoch 0) newGid Nothing diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index e084e7933f0..1f41252b398 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -126,4 +126,4 @@ withCommitLock lConvOrSubId gid epoch action = ttl = fromIntegral (600 :: Int) -- 10 minutes getConvFromGroupId :: Member (Error MLSProtocolError) r => GroupId -> Sem r (Qualified ConvOrSubConvId) -getConvFromGroupId = either (throw . mlsProtocolError . T.pack) pure . groupIdToConv +getConvFromGroupId = either (throw . mlsProtocolError . T.pack) (pure . fst) . groupIdToConv diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 8b15c7f36f5..b45fe567967 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -74,7 +74,7 @@ createMLSSelfConversation lusr = do ncProtocol = ProtocolCreateMLSTag } meta = ncMetadata nc - gid = convToGroupId . fmap Conv . tUntagged . qualifyAs lusr $ cnv + gid = convToGroupId' . fmap Conv . tUntagged . qualifyAs lusr $ cnv -- FUTUREWORK: Stop hard-coding the cipher suite -- -- 'CipherSuite 1' corresponds to @@ -123,7 +123,7 @@ createConversation lcnv nc = do (proto, mgid, mep, mcs) = case ncProtocol nc of ProtocolCreateProteusTag -> (ProtocolProteus, Nothing, Nothing, Nothing) ProtocolCreateMLSTag -> - let gid = convToGroupId $ Conv <$> tUntagged lcnv + let gid = convToGroupId' $ Conv <$> tUntagged lcnv ep = Epoch 0 cs = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 in ( ProtocolMLS @@ -415,7 +415,7 @@ updateToMixedProtocol :: CipherSuiteTag -> Sem r () updateToMixedProtocol lcnv cs = do - let gid = convToGroupId $ Conv <$> tUntagged lcnv + let gid = convToGroupId' $ Conv <$> tUntagged lcnv epoch = Epoch 0 embedClient . retry x5 . batch $ do setType BatchLogged diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index b72509bf273..1518f5bf4d3 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -2779,6 +2779,12 @@ testLastLeaverSubConv = do let subId = SubConvId "conference" qsub <- createSubConv qcnv alice1 subId + prePsc <- + liftTest $ + responseJsonError + =<< getSubConv (qUnqualified alice) qcnv subId + TestM () diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 14be9f212e3..71bea0a4a7d 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -76,7 +76,7 @@ import Wire.API.Federation.API.Galley import Wire.API.MLS.CipherSuite import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential -import Wire.API.MLS.Group.Serialisation (convToGroupId) +import Wire.API.MLS.Group.Serialisation import Wire.API.MLS.KeyPackage import Wire.API.MLS.Keys import Wire.API.MLS.LeafNode @@ -521,7 +521,7 @@ setupFakeMLSGroup :: MLSTest (GroupId, Qualified ConvId) setupFakeMLSGroup creator mSubId = do qcnv <- randomQualifiedId (ciDomain creator) - let groupId = convToGroupId $ maybe (Conv <$> qcnv) ((<$> qcnv) . flip SubConv) mSubId + let groupId = convToGroupId' $ maybe (Conv <$> qcnv) ((<$> qcnv) . flip SubConv) mSubId createGroup creator (fmap Conv qcnv) groupId pure (groupId, qcnv)