FS-1059 Change commit-bundle body type to protobuf format

changelog.d/1-api-changes/pr-2773

@@ -0,0 +1 @@
+Change mime type of body of /v3/mls/commit-bundles endpoint

libs/wire-api/src/Wire/API/ConverProtoLens.hs

@@ -0,0 +1,33 @@
+-- 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.ConverProtoLens where
+
+import Data.Bifunctor (Bifunctor (first))
+import Imports
+
+-- | This typeclass exists to provide overloaded function names for convertion
+-- between data types generated by proto-lens and data types used in wire
+-- We added fundeps here for better type inference, but we can't be as explicit as we wanted
+-- with @a -> b, b -> a@, since our instances would be orphaned on the left hand side argument.
+class ConvertProtoLens a b | b -> a where
+  fromProtolens :: a -> Either Text b
+  toProtolens :: b -> a
+
+-- | Add labels to error messages
+protoLabel :: Text -> Either Text a -> Either Text a
+protoLabel lbl = first ((lbl <> ": ") <>)

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

@@ -17,8 +17,17 @@
 
 module Wire.API.MLS.CommitBundle where
 
+import Control.Lens (view, (.~), (?~))
+import Data.Bifunctor (first)
+import qualified Data.ByteString as BS
+import Data.ProtoLens (decodeMessage, encodeMessage)
+import qualified Data.ProtoLens (Message (defMessage))
 import qualified Data.Swagger as S
+import qualified Data.Text as T
 import Imports
+import qualified Proto.Mls
+import qualified Proto.Mls_Fields as Proto.Mls
+import Wire.API.ConverProtoLens
 import Wire.API.MLS.GroupInfoBundle
 import Wire.API.MLS.Message
 import Wire.API.MLS.Serialisation
@@ -31,14 +40,40 @@ data CommitBundle = CommitBundle
   }
   deriving (Eq, Show)
 
-instance ParseMLS CommitBundle where
-  parseMLS = CommitBundle <$> parseMLS <*> parseMLSOptional parseMLS <*> parseMLS
+instance ConvertProtoLens Proto.Mls.CommitBundle CommitBundle where
+  fromProtolens protoBundle = protoLabel "CommitBundle" $ do
+    CommitBundle
+      <$> protoLabel "commit" (decodeMLS' (view Proto.Mls.commit protoBundle))
+      <*> protoLabel
+        "welcome"
+        ( let bs = view Proto.Mls.welcome protoBundle
+           in if BS.length bs == 0
+                then pure Nothing
+                else Just <$> decodeMLS' bs
+        )
+      <*> protoLabel "group_info_bundle" (fromProtolens (view Proto.Mls.groupInfoBundle protoBundle))
+  toProtolens bundle =
+    let commitData = rmRaw (cbCommitMsg bundle)
+        welcomeData = foldMap rmRaw (cbWelcome bundle)
+        groupInfoData = toProtolens (cbGroupInfoBundle bundle)
+     in ( Data.ProtoLens.defMessage
+            & Proto.Mls.commit .~ commitData
+            & Proto.Mls.welcome .~ welcomeData
+            & Proto.Mls.groupInfoBundle .~ groupInfoData
+        )
 
 instance S.ToSchema CommitBundle where
-  declareNamedSchema _ = pure (mlsSwagger "CommitBundle")
+  declareNamedSchema _ =
+    pure $
+      S.NamedSchema (Just "CommitBundle") $
+        mempty
+          & S.description
+            ?~ "A protobuf-serialized object. See wireapp/generic-message-proto for the definition."
 
-instance SerialiseMLS CommitBundle where
-  serialiseMLS (CommitBundle commit welcome gi) = do
-    serialiseMLS commit
-    serialiseMLSOptional serialiseMLS welcome
-    serialiseMLS gi
+deserializeCommitBundle :: ByteString -> Either Text CommitBundle
+deserializeCommitBundle b = do
+  protoCommitBundle :: Proto.Mls.CommitBundle <- first (("Parsing protobuf failed: " <>) . T.pack) (decodeMessage b)
+  first ("Converting from protobuf failed: " <>) (fromProtolens protoCommitBundle)
+
+serializeCommitBundle :: CommitBundle -> ByteString
+serializeCommitBundle = encodeMessage . (toProtolens @Proto.Mls.CommitBundle @CommitBundle)

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

@@ -17,27 +17,66 @@
 
 module Wire.API.MLS.GroupInfoBundle where
 
+import Control.Lens (view, (.~))
+import Data.ProtoLens (Message (defMessage))
 import Imports
+import qualified Proto.Mls
+import qualified Proto.Mls_Fields as Proto.Mls
 import Test.QuickCheck
+import Wire.API.ConverProtoLens
 import Wire.API.MLS.PublicGroupState
 import Wire.API.MLS.Serialisation
 import Wire.Arbitrary
 
-data GroupInfoEncryption = UnencryptedGroupInfo | JweEncryptedGroupInfo
-  deriving stock (Eq, Show, Generic, Bounded, Enum)
-  deriving (Arbitrary) via (GenericUniform GroupInfoEncryption)
+data GroupInfoType = GroupInfoTypePublicGroupState | UnencryptedGroupInfo | JweEncryptedGroupInfo
+  deriving stock (Eq, Show, Generic, Enum, Bounded)
+  deriving (Arbitrary) via (GenericUniform GroupInfoType)
+
+instance ConvertProtoLens Proto.Mls.GroupInfoType GroupInfoType where
+  fromProtolens Proto.Mls.PUBLIC_GROUP_STATE = pure GroupInfoTypePublicGroupState
+  fromProtolens Proto.Mls.GROUP_INFO = pure UnencryptedGroupInfo
+  fromProtolens Proto.Mls.GROUP_INFO_JWE = pure JweEncryptedGroupInfo
+
+  toProtolens GroupInfoTypePublicGroupState = Proto.Mls.PUBLIC_GROUP_STATE
+  toProtolens UnencryptedGroupInfo = Proto.Mls.GROUP_INFO
+  toProtolens JweEncryptedGroupInfo = Proto.Mls.GROUP_INFO_JWE
 
-data GroupInfoTreeType = TreeFull | TreeDelta | TreeByRef
+data RatchetTreeType = TreeFull | TreeDelta | TreeByRef
   deriving stock (Eq, Show, Generic, Bounded, Enum)
-  deriving (Arbitrary) via (GenericUniform GroupInfoTreeType)
+  deriving (Arbitrary) via (GenericUniform RatchetTreeType)
+
+instance ConvertProtoLens Proto.Mls.RatchetTreeType RatchetTreeType where
+  fromProtolens Proto.Mls.FULL = pure TreeFull
+  fromProtolens Proto.Mls.DELTA = pure TreeDelta
+  fromProtolens Proto.Mls.REFERENCE = pure TreeByRef
+
+  toProtolens TreeFull = Proto.Mls.FULL
+  toProtolens TreeDelta = Proto.Mls.DELTA
+  toProtolens TreeByRef = Proto.Mls.REFERENCE
 
 data GroupInfoBundle = GroupInfoBundle
-  { gipEncryptionType :: GroupInfoEncryption,
-    gipTreeType :: GroupInfoTreeType,
+  { gipGroupInfoType :: GroupInfoType,
+    gipRatchetTreeType :: RatchetTreeType,
     gipGroupState :: RawMLS PublicGroupState
   }
   deriving stock (Eq, Show, Generic)
 
+instance ConvertProtoLens Proto.Mls.GroupInfoBundle GroupInfoBundle where
+  fromProtolens protoBundle =
+    protoLabel "GroupInfoBundle" $
+      GroupInfoBundle
+        <$> protoLabel "field group_info_type" (fromProtolens (view Proto.Mls.groupInfoType protoBundle))
+        <*> protoLabel "field ratchet_tree_type" (fromProtolens (view Proto.Mls.ratchetTreeType protoBundle))
+        <*> protoLabel "field group_info" (decodeMLS' (view Proto.Mls.groupInfo protoBundle))
+  toProtolens bundle =
+    let encryptionType = toProtolens (gipGroupInfoType bundle)
+        treeType = toProtolens (gipRatchetTreeType bundle)
+     in ( defMessage
+            & Proto.Mls.groupInfoType .~ encryptionType
+            & Proto.Mls.ratchetTreeType .~ treeType
+            & Proto.Mls.groupInfo .~ rmRaw (gipGroupState bundle)
+        )
+
 instance Arbitrary GroupInfoBundle where
   arbitrary =
     GroupInfoBundle
@@ -48,7 +87,7 @@ instance Arbitrary GroupInfoBundle where
 instance ParseMLS GroupInfoBundle where
   parseMLS =
     GroupInfoBundle
-      <$> parseMLSEnum @Word8 "GroupInfoEncryptionEnum"
+      <$> parseMLSEnum @Word8 "GroupInfoTypeEnum"
       <*> parseMLSEnum @Word8 "RatchetTreeEnum"
       <*> parseMLS
 

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

@@ -24,15 +24,13 @@ import Data.Binary.Put
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Swagger as S
 import Imports
-import Servant.API.ContentTypes
 import Test.QuickCheck hiding (label)
 import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Epoch
 import Wire.API.MLS.Extension
 import Wire.API.MLS.Group
 import Wire.API.MLS.KeyPackage
 import Wire.API.MLS.Serialisation
-import Wire.API.MLS.Servant
 import Wire.Arbitrary
 
 data PublicGroupStateTBS = PublicGroupStateTBS
@@ -102,9 +100,6 @@ instance SerialiseMLS OpaquePublicGroupState where
 instance S.ToSchema OpaquePublicGroupState where
   declareNamedSchema _ = pure (mlsSwagger "OpaquePublicGroupState")
 
-instance MimeRender MLS OpaquePublicGroupState where
-  mimeRender _ = LBS.fromStrict . unOpaquePublicGroupState
-
 toOpaquePublicGroupState :: RawMLS PublicGroupState -> OpaquePublicGroupState
 toOpaquePublicGroupState = OpaquePublicGroupState . rmRaw
 

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

@@ -15,14 +15,17 @@
 -- 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.Servant (MLS, mimeUnrenderMLSWith) where
+module Wire.API.MLS.Servant (MLS, mimeUnrenderMLSWith, CommitBundleMimeType) where
 
 import Data.Bifunctor
 import Data.Binary
+import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as T
 import Imports
 import Network.HTTP.Media ((//))
 import Servant.API hiding (Get)
+import Wire.API.MLS.CommitBundle
+import Wire.API.MLS.PublicGroupState (OpaquePublicGroupState, unOpaquePublicGroupState)
 import Wire.API.MLS.Serialisation
 
 data MLS
@@ -33,5 +36,19 @@ instance Accept MLS where
 instance {-# OVERLAPPABLE #-} ParseMLS a => MimeUnrender MLS a where
   mimeUnrender _ = mimeUnrenderMLSWith parseMLS
 
+instance MimeRender MLS OpaquePublicGroupState where
+  mimeRender _ = LBS.fromStrict . unOpaquePublicGroupState
+
 mimeUnrenderMLSWith :: Get a -> LByteString -> Either String a
 mimeUnrenderMLSWith p = first T.unpack . decodeMLSWith p
+
+data CommitBundleMimeType
+
+instance Accept CommitBundleMimeType where
+  contentType _ = "application" // "x-protobuf"
+
+instance MimeUnrender CommitBundleMimeType CommitBundle where
+  mimeUnrender _ = first T.unpack . deserializeCommitBundle . LBS.toStrict
+
+instance MimeRender CommitBundleMimeType CommitBundle where
+  mimeRender _ = LBS.fromStrict . serializeCommitBundle

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

@@ -1427,7 +1427,7 @@ type MLSMessagingAPI =
                :> CanThrow MLSProposalFailure
                :> "commit-bundles"
                :> ZConn
-               :> ReqBody '[MLS] (RawMLS CommitBundle)
+               :> ReqBody '[CommitBundleMimeType] CommitBundle
                :> MultiVerb1 'POST '[JSON] (Respond 201 "Commit accepted and forwarded" MLSMessageSendingStatus)
            )
     :<|> Named

libs/wire-api/test/unit/Test/Wire/API/MLS.hs

@@ -62,7 +62,7 @@ tests =
       testCase "key package ref" testKeyPackageRef,
       testCase "validate message signature" testVerifyMLSPlainTextWithKey,
       testCase "create signed remove proposal" testRemoveProposalMessageSignature,
-      testCase "parse GroupInfoBundle" testParseGroupInfoBundle
+      testCase "parse GroupInfoBundle" testParseGroupInfoBundle -- TODO: remove this also
     ]
 
 testParseKeyPackage :: IO ()