Check consistency of group info

changelog.d/2-features/group-info-check

@@ -0,0 +1 @@
+Add option to check group info consistency on every MLS commit

charts/galley/templates/configmap.yaml

@@ -101,6 +101,9 @@ data:
       {{- end }}
       passwordHashingOptions: {{ toYaml .settings.passwordHashingOptions | nindent 8 }}
       passwordHashingRateLimit: {{ toYaml .settings.passwordHashingRateLimit | nindent 8 }}
+      {{- if .settings.checkGroupInfo }}
+      checkGroupInfo: {{ .settings.checkGroupInfo }}
+      {{- end }}
       featureFlags:
         sso: {{ .settings.featureFlags.sso }}
         legalhold: {{ .settings.featureFlags.legalhold }}

charts/galley/values.yaml

@@ -91,6 +91,8 @@ config:
       ipAddressExceptions: []
       maxRateLimitedKeys: 100000 # Estimated memory usage: 4 MB
 
+    checkGroupInfo: false
+
     # To disable proteus for new federated conversations:
     # federationProtocols: ["mls"]
 

docs/src/developer/reference/config-options.md

@@ -873,6 +873,20 @@ The `ipAddressExceptions` have to be CIDR blocks which can be specified like
 by pass the rate limits. To limit one particular IP address, it can be specified
 as `127.0.0.1/32`.
 
+#### Group info consistency check
+
+To enable group info consistency checks on MLS commits:
+```
+# galley.yaml
+config:
+  settings:
+    checkGroupInfo: true
+```
+
+Enabling consistency checks makes Galley parse the ratchet tree
+extension in the group info of every commit and compare it to the
+group state after applying the commit.
+
 #### Disabling API versions
 
 It is possible to disable one ore more API versions. When an API version is disabled it won’t be advertised on the `GET /api-version` endpoint, neither in the `supported`, nor in the `development` section. Requests made to any endpoint of a disabled API version will result in the same error response as a request made to an API version that does not exist.

integration/test/Test/MLS.hs

@@ -970,3 +970,56 @@ testInvalidLeafNodeSignature = do
       (left, right) -> case B.uncons right of
         Just (h, t) -> left <> B.singleton (h `xor` 0x01) <> t
         Nothing -> bs
+
+testGroupInfoMismatch :: (HasCallStack) => App ()
+testGroupInfoMismatch = withModifiedBackend
+  (def {galleyCfg = setField "settings.checkGroupInfo" True})
+  $ \domain -> do
+    [alice, bob, charlie] <- createAndConnectUsers [domain, domain, domain]
+    [alice1, bob1, bob2, charlie1] <- traverse (createMLSClient def) [alice, bob, bob, charlie]
+    traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
+    conv <- createNewGroup def alice1
+
+    mp1 <- createAddCommit alice1 conv [bob]
+    void $ sendAndConsumeCommitBundle mp1
+
+    -- attempt a commit with an old group info
+    mp2 <- createAddCommit alice1 conv [charlie]
+    bindResponse (postMLSCommitBundle mp2.sender (mkBundle mp2 {groupInfo = mp1.groupInfo}))
+      $ \resp -> do
+        resp.status `shouldMatchInt` 400
+        resp.json %. "label" `shouldMatch` "mls-group-info-mismatch"
+
+    -- check that epoch is still 1
+    bindResponse (getConversation alice conv) $ \resp -> do
+      resp.status `shouldMatchInt` 200
+      resp.json %. "epoch" `shouldMatchInt` 1
+
+    -- attempt an external commit with an old group info
+    void $ uploadNewKeyPackage def bob2
+    mp3 <- createExternalCommit conv bob2 Nothing
+    bindResponse (postMLSCommitBundle bob2 (mkBundle mp3 {groupInfo = mp1.groupInfo}))
+      $ \resp -> do
+        resp.status `shouldMatchInt` 400
+        resp.json %. "label" `shouldMatch` "mls-group-info-mismatch"
+
+    -- check that epoch is still 1
+    bindResponse (getConversation alice conv) $ \resp -> do
+      resp.status `shouldMatchInt` 200
+      resp.json %. "epoch" `shouldMatchInt` 1
+
+testGroupInfoCheckDisabled :: (HasCallStack) => App ()
+testGroupInfoCheckDisabled = do
+  [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OwnDomain, OwnDomain]
+  [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
+  traverse_ (uploadNewKeyPackage def) [bob1, charlie1]
+  conv <- createNewGroup def alice1
+
+  mp1 <- createAddCommit alice1 conv [bob]
+  void $ sendAndConsumeCommitBundle mp1
+
+  -- attempt a commit with an old group info
+  mp2 <- createAddCommit alice1 conv [charlie]
+  bindResponse (postMLSCommitBundle mp2.sender (mkBundle mp2 {groupInfo = mp1.groupInfo}))
+    $ \resp -> do
+      resp.status `shouldMatchInt` 201

integration/test/Test/MLS/SubConversation.hs

@@ -344,11 +344,16 @@ testResendingProposals = do
   void $ createExternalCommit subConvId bob2 Nothing >>= sendAndConsumeCommitBundle
   void $ createExternalCommit subConvId bob3 Nothing >>= sendAndConsumeCommitBundle
 
-  leaveConv subConvId bob1
-  leaveConv subConvId bob2
-  leaveConv subConvId bob3
+  withWebSockets [alice1, alice2, charlie1] \wss -> do
+    leaveConv subConvId bob1
+    leaveConv subConvId bob2
+    leaveConv subConvId bob3
+    for_ wss $ \ws ->
+      when (ws.client /= Just charlie1) $ do
+        replicateM_ 3 do
+          msg <- consumeMessage subConvId def (fromJust ws.client) Nothing ws
+          msg %. "message.content.sender.External" `shouldMatchInt` 0
 
-  withWebSockets [alice1, alice2, charlie1] \[wsAlice1, wsAlice2, wsCharlie1] -> do
     void
       $ createExternalCommit subConvId charlie1 Nothing
       >>= (postMLSCommitBundle charlie1 . mkBundle)
@@ -371,15 +376,11 @@ testResendingProposals = do
         }
 
     -- consume proposals after backend resends them
-    for_ [wsAlice1, wsAlice2] $ \ws -> do
-      commitMsg <- consumeMessage subConvId def (fromJust ws.client) Nothing ws
-      commitMsg %. "message.content.sender" `shouldMatch` "NewMemberCommit"
-      replicateM 3 do
-        msg <- consumeMessage subConvId def (fromJust ws.client) Nothing ws
-        msg %. "message.content.sender.External" `shouldMatchInt` 0
-    void $ do
-      let ws = wsCharlie1
-      replicateM 3 do
+    for_ wss $ \ws -> do
+      when (ws.client /= Just charlie1) $ do
+        commitMsg <- consumeMessage subConvId def (fromJust ws.client) Nothing ws
+        commitMsg %. "message.content.sender" `shouldMatch` "NewMemberCommit"
+      replicateM_ 3 do
         msg <- consumeMessage subConvId def (fromJust ws.client) Nothing ws
         msg %. "message.content.sender.External" `shouldMatchInt` 0
 

libs/wire-api/src/Wire/API/Error/Galley.hs

@@ -106,6 +106,7 @@ data GalleyError
   | MLSMigrationCriteriaNotSatisfied
   | MLSFederatedOne2OneNotSupported
   | MLSFederatedResetNotSupported
+  | MLSGroupInfoMismatch
   | GroupIdVersionNotSupported
   | -- | MLS and federation are incompatible with legalhold - this error is thrown if a user
     -- tries to create an MLS group while being under legalhold
@@ -268,6 +269,8 @@ type instance MapError 'MLSFederatedOne2OneNotSupported = 'StaticError 400 "mls-
 
 type instance MapError 'MLSFederatedResetNotSupported = 'StaticError 400 "mls-federated-reset-not-supported" "Reset is not supported by the owning backend of the conversation"
 
+type instance MapError 'MLSGroupInfoMismatch = 'StaticError 400 "mls-group-info-mismatch" "Ratchet tree mismatch in GroupInfo"
+
 type instance MapError 'GroupIdVersionNotSupported = 'StaticError 400 "mls-group-id-not-supported" "The group ID version of the conversation is not supported by one of the federated backends"
 
 type instance MapError MLSLegalholdIncompatible = 'StaticError 409 "mls-legal-hold-not-allowed" "A user who is under legal-hold may not participate in MLS conversations"

libs/wire-api/src/Wire/API/MLS/Extension.hs

@@ -37,3 +37,15 @@ instance SerialiseMLS Extension where
   serialiseMLS (Extension ty d) = do
     serialiseMLS ty
     serialiseMLSBytes @VarInt d
+
+class IsExtension e where
+  extensionType :: Word16
+
+findExtension ::
+  forall e.
+  (ParseMLS e, IsExtension e) =>
+  [Extension] ->
+  Either Text [e]
+findExtension =
+  traverse (decodeMLS' . (.extData))
+    . filter (\e -> e.extType == extensionType @e)

libs/wire-api/src/Wire/API/MLS/GroupInfo.hs

@@ -18,6 +18,7 @@
 module Wire.API.MLS.GroupInfo
   ( GroupContext (..),
     GroupInfo (..),
+    GroupInfoTBS (..),
     GroupInfoData (..),
   )
 where

libs/wire-api/src/Wire/API/MLS/RatchetTree.hs

@@ -0,0 +1,78 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- 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 Wire.API.MLS.RatchetTree where
+
+import Data.Functor
+import Imports
+import Wire.API.MLS.Extension
+import Wire.API.MLS.HPKEPublicKey
+import Wire.API.MLS.LeafNode
+import Wire.API.MLS.Serialisation
+
+data RatchetTree = RatchetTree {nodes :: [Maybe RatchetTreeNode]}
+  deriving (Eq, Show)
+
+instance IsExtension RatchetTree where
+  extensionType = 2
+
+instance ParseMLS RatchetTree where
+  parseMLS = RatchetTree <$> parseMLSVector @VarInt (parseMLSOptional parseMLS)
+
+data RatchetTreeNodeTag = RatchetTreeLeafNodeTag | RatchetTreeParentNodeTag
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+instance ParseMLS RatchetTreeNodeTag where
+  parseMLS = parseMLSEnum @Word8 "NodeType"
+
+data RatchetTreeNode
+  = RatchetTreeParentNode RatchetTreeParent
+  | RatchetTreeLeafNode LeafNode
+  deriving (Eq, Show)
+
+instance ParseMLS RatchetTreeNode where
+  parseMLS =
+    parseMLS >>= \case
+      RatchetTreeParentNodeTag -> RatchetTreeParentNode <$> parseMLS
+      RatchetTreeLeafNodeTag -> RatchetTreeLeafNode <$> parseMLS
+
+data RatchetTreeParent = RatchetTreeParent
+  { encryptionKey :: HPKEPublicKey,
+    parentHash :: ByteString,
+    unmergedLeaves :: [Word32]
+  }
+  deriving (Eq, Show)
+
+instance ParseMLS RatchetTreeParent where
+  parseMLS =
+    RatchetTreeParent
+      <$> parseMLS
+      <*> parseMLSBytes @VarInt
+      <*> parseMLSVector @VarInt parseMLS
+
+ratchetTreeLeaves :: RatchetTree -> [(LeafIndex, LeafNode)]
+ratchetTreeLeaves =
+  foldMap (traverse toNode) . zip [0 ..] . evens . (.nodes)
+  where
+    evens :: [a] -> [a]
+    evens [] = []
+    evens [x] = [x]
+    evens (x : _ : xs) = (x : evens xs)
+
+    toNode :: Maybe RatchetTreeNode -> [LeafNode]
+    toNode (Just (RatchetTreeLeafNode n)) = [n]
+    toNode _ = []

libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs

@@ -114,6 +114,7 @@ type MLSMessagingAPI =
                :> CanThrow MLSLegalholdIncompatible
                :> CanThrow MLSProposalFailure
                :> CanThrow MLSIdentityMismatch
+               :> CanThrow MLSGroupInfoMismatch
                :> CanThrow NonFederatingBackends
                :> CanThrow UnreachableBackends
                :> CanThrow GroupIdVersionNotSupported

libs/wire-api/wire-api.cabal

@@ -133,6 +133,7 @@ library
     Wire.API.MLS.Proposal
     Wire.API.MLS.ProposalTag
     Wire.API.MLS.ProtocolVersion
+    Wire.API.MLS.RatchetTree
     Wire.API.MLS.Serialisation
     Wire.API.MLS.Servant
     Wire.API.MLS.SubConversation

services/galley/src/Galley/API/MLS/Commit/Core.hs

@@ -111,12 +111,12 @@ getCommitData ::
   Epoch ->
   CipherSuiteTag ->
   IncomingBundle ->
-  Sem r ProposalAction
+  Sem r (IndexMap, ProposalAction)
 getCommitData senderIdentity lConvOrSub epoch ciphersuite bundle = do
   let convOrSub = tUnqualified lConvOrSub
       groupId = cnvmlsGroupId convOrSub.mlsMeta
 
-  evalState convOrSub.indexMap $ do
+  runState convOrSub.indexMap $ do
     creatorAction <-
       if epoch == Epoch 0
         then addProposedClient (Left senderIdentity.client)

services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs

@@ -72,7 +72,7 @@ getExternalCommitData ::
   Local ConvOrSubConv ->
   Epoch ->
   Commit ->
-  Sem r ExternalCommitAction
+  Sem r (IndexMap, ExternalCommitAction)
 getExternalCommitData senderIdentity lConvOrSub epoch commit = do
   let convOrSub = tUnqualified lConvOrSub
   activeData <-
@@ -100,7 +100,7 @@ getExternalCommitData senderIdentity lConvOrSub epoch commit = do
   unless (null (Map.keys counts \\ allowedProposals)) $
     throw (mlsProtocolError "Invalid proposal type in an external commit")
 
-  evalState convOrSub.indexMap $ do
+  runState convOrSub.indexMap $ do
     -- process optional removal
     propAction <- applyProposals activeData.ciphersuite proposals
     removedIndex <- case cmAssocs (paRemove propAction) of
@@ -116,7 +116,9 @@ getExternalCommitData senderIdentity lConvOrSub epoch commit = do
       _ -> throw (mlsProtocolError "External commits must contain at most one Remove proposal")
 
     -- add sender client
-    addedIndex <- gets imNextIndex
+    im <- get
+    let (addedIndex, im') = imAddClient im senderIdentity
+    put im'
 
     pure
       ExternalCommitAction