[FS-806] Add a Timestamp to the MLS Message Endpoint

changelog.d/1-api-changes/mls-message

@@ -0,0 +1 @@
+The response to POST /mls/messages adds a timestamp

libs/wire-api/src/Wire/API/Conversation/Protocol.hs

@@ -40,8 +40,8 @@ import Imports
 import Wire.API.Arbitrary
 import Wire.API.Conversation.Action.Tag
 import Wire.API.MLS.CipherSuite
+import Wire.API.MLS.Epoch
 import Wire.API.MLS.Group
-import Wire.API.MLS.Message
 
 data ProtocolTag = ProtocolProteusTag | ProtocolMLSTag
   deriving stock (Eq, Show, Enum, Bounded, Generic)

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

@@ -0,0 +1,32 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- 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.Epoch where
+
+import Data.Schema
+import Imports
+import Wire.API.Arbitrary
+import Wire.API.MLS.Serialisation
+
+newtype Epoch = Epoch {epochNumber :: Word64}
+  deriving stock (Eq, Show)
+  deriving newtype (Arbitrary, Enum, ToSchema)
+
+instance ParseMLS Epoch where
+  parseMLS = Epoch <$> parseMLS

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

@@ -20,8 +20,7 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Wire.API.MLS.Message
-  ( Epoch (..),
-    Message (..),
+  ( Message (..),
     WireFormatTag (..),
     SWireFormatTag (..),
     SomeMessage (..),
@@ -31,28 +30,26 @@ module Wire.API.MLS.Message
     Sender (..),
     MLSPlainTextSym0,
     MLSCipherTextSym0,
+    MLSMessageSendingStatus (..),
   )
 where
 
+import Control.Lens ((?~))
+import qualified Data.Aeson as A
 import Data.Binary
+import Data.Json.Util
 import Data.Schema
 import Data.Singletons.TH
 import qualified Data.Swagger as S
 import Imports
-import Wire.API.Arbitrary
+import Wire.API.Event.Conversation
 import Wire.API.MLS.Commit
+import Wire.API.MLS.Epoch
 import Wire.API.MLS.Group
 import Wire.API.MLS.KeyPackage
 import Wire.API.MLS.Proposal
 import Wire.API.MLS.Serialisation
 
-newtype Epoch = Epoch {epochNumber :: Word64}
-  deriving stock (Eq, Show)
-  deriving newtype (Arbitrary, Enum, ToSchema)
-
-instance ParseMLS Epoch where
-  parseMLS = Epoch <$> parseMLS
-
 data WireFormatTag = MLSPlainText | MLSCipherText
   deriving (Bounded, Enum, Eq, Show)
 
@@ -167,3 +164,24 @@ instance ParseMLS MessagePayloadTBS where
       ApplicationMessageTag -> ApplicationMessage <$> parseMLSBytes @Word32
       ProposalMessageTag -> ProposalMessage <$> parseMLS
       CommitMessageTag -> CommitMessage <$> parseMLS
+
+data MLSMessageSendingStatus = MLSMessageSendingStatus
+  { mmssEvents :: [Event],
+    mmssTime :: UTCTimeMillis
+  }
+  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema MLSMessageSendingStatus
+
+instance ToSchema MLSMessageSendingStatus where
+  schema =
+    object "MLSMessageSendingStatus" $
+      MLSMessageSendingStatus
+        <$> mmssEvents
+          .= fieldWithDocModifier
+            "events"
+            (description ?~ "A list of events caused by sending the message.")
+            (array schema)
+        <*> mmssTime
+          .= fieldWithDocModifier
+            "time"
+            (description ?~ "The time of sending the message.")
+            schema

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

@@ -1313,26 +1313,48 @@ type MLSMessagingAPI =
         :> MultiVerb1 'POST '[JSON] (RespondEmpty 201 "Welcome message sent")
     )
     :<|> Named
-           "mls-message"
+           "mls-message-v1"
            ( Summary "Post an MLS message"
+               :> Until 'V2
                :> CanThrow 'ConvAccessDenied
                :> CanThrow 'ConvNotFound
-               :> CanThrow 'ConvMemberNotFound
-               :> CanThrow 'MLSKeyPackageRefNotFound
+               :> CanThrow 'MissingLegalholdConsent
                :> CanThrow 'MLSClientMismatch
+               :> CanThrow 'MLSCommitMissingReferences
+               :> CanThrow 'MLSKeyPackageRefNotFound
                :> CanThrow 'MLSProtocolErrorTag
                :> CanThrow 'MLSStaleMessage
                :> CanThrow MLSProposalFailure
                :> CanThrow 'MLSProposalNotFound
                :> CanThrow 'MLSUnsupportedMessage
                :> CanThrow 'MLSUnsupportedProposal
                :> CanThrow 'LegalHoldNotEnabled
+               :> "messages"
+               :> ZConn
+               :> ReqBody '[MLS] (RawMLS SomeMessage)
+               :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" [Event])
+           )
+    :<|> Named
+           "mls-message"
+           ( Summary "Post an MLS message"
+               :> From 'V2
+               :> CanThrow 'ConvAccessDenied
+               :> CanThrow 'ConvNotFound
                :> CanThrow 'MissingLegalholdConsent
+               :> CanThrow 'MLSClientMismatch
                :> CanThrow 'MLSCommitMissingReferences
+               :> CanThrow 'MLSKeyPackageRefNotFound
+               :> CanThrow 'MLSProtocolErrorTag
+               :> CanThrow 'MLSStaleMessage
+               :> CanThrow MLSProposalFailure
+               :> CanThrow 'MLSProposalNotFound
+               :> CanThrow 'MLSUnsupportedMessage
+               :> CanThrow 'MLSUnsupportedProposal
+               :> CanThrow 'LegalHoldNotEnabled
                :> "messages"
                :> ZConn
                :> ReqBody '[MLS] (RawMLS SomeMessage)
-               :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" [Event])
+               :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" MLSMessageSendingStatus)
            )
 
 type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSMessagingAPI)

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

@@ -31,6 +31,7 @@ import Test.Tasty.HUnit
 import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Commit
 import Wire.API.MLS.Credential
+import Wire.API.MLS.Epoch
 import Wire.API.MLS.Extension
 import Wire.API.MLS.KeyPackage
 import Wire.API.MLS.Message

libs/wire-api/wire-api.cabal

@@ -48,6 +48,7 @@ library
       Wire.API.MLS.Commit
       Wire.API.MLS.Context
       Wire.API.MLS.Credential
+      Wire.API.MLS.Epoch
       Wire.API.MLS.Extension
       Wire.API.MLS.Group
       Wire.API.MLS.KeyPackage

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

@@ -19,6 +19,7 @@ module Galley.API.MLS
   ( postMLSWelcome,
     postMLSMessage,
     postMLSMessageFromLocalUser,
+    postMLSMessageFromLocalUserV1,
   )
 where
 

services/galley/src/Galley/API/MLS/Message.hs

@@ -18,6 +18,7 @@
 
 module Galley.API.MLS.Message
   ( postMLSMessageFromLocalUser,
+    postMLSMessageFromLocalUserV1,
     postMLSMessage,
     MLSMessageStaticErrors,
   )
@@ -94,34 +95,63 @@ type MLSMessageStaticErrors =
      ErrorS 'MLSCommitMissingReferences
    ]
 
-postMLSMessageFromLocalUser ::
+postMLSMessageFromLocalUserV1 ::
   ( HasProposalEffects r,
     Members
       '[ Resource,
          Error FederationError,
          ErrorS 'ConvAccessDenied,
          ErrorS 'ConvNotFound,
-         ErrorS 'ConvMemberNotFound,
          Error InternalError,
+         ErrorS 'MLSCommitMissingReferences,
          ErrorS 'MLSProposalNotFound,
          ErrorS 'MLSUnsupportedMessage,
          ErrorS 'MLSStaleMessage,
          ErrorS 'MissingLegalholdConsent,
-         ErrorS 'MLSCommitMissingReferences,
+         Input (Local ()),
          ProposalStore,
-         TinyLog,
-         Input (Local ())
+         TinyLog
        ]
       r
   ) =>
   Local UserId ->
   ConnId ->
   RawMLS SomeMessage ->
   Sem r [Event]
-postMLSMessageFromLocalUser lusr conn msg =
+postMLSMessageFromLocalUserV1 lusr conn msg =
   map lcuEvent
     <$> postMLSMessage lusr (qUntagged lusr) (Just conn) msg
 
+postMLSMessageFromLocalUser ::
+  ( HasProposalEffects r,
+    Members
+      '[ Resource,
+         Error FederationError,
+         ErrorS 'ConvAccessDenied,
+         ErrorS 'ConvNotFound,
+         Error InternalError,
+         ErrorS 'MLSCommitMissingReferences,
+         ErrorS 'MLSUnsupportedMessage,
+         ErrorS 'MLSStaleMessage,
+         ErrorS 'MLSProposalNotFound,
+         ErrorS 'MissingLegalholdConsent,
+         Input (Local ()),
+         ProposalStore,
+         TinyLog
+       ]
+      r
+  ) =>
+  Local UserId ->
+  ConnId ->
+  RawMLS SomeMessage ->
+  Sem r MLSMessageSendingStatus
+postMLSMessageFromLocalUser lusr conn msg = do
+  -- FUTUREWORK: Inline the body of 'postMLSMessageFromLocalUserV1' once version
+  -- V1 is dropped
+  events <- postMLSMessageFromLocalUserV1 lusr conn msg
+  t <- toUTCTimeMillis <$> input
+  pure $ MLSMessageSendingStatus events t
+
 postMLSMessage ::
   ( HasProposalEffects r,
     Members

services/galley/src/Galley/API/Public/Servant.hs

@@ -159,6 +159,7 @@ servantSitemap =
     mls :: API MLSAPI GalleyEffects
     mls =
       mkNamedAPI @"mls-welcome-message" postMLSWelcome
+        <@> mkNamedAPI @"mls-message-v1" postMLSMessageFromLocalUserV1
         <@> mkNamedAPI @"mls-message" postMLSMessageFromLocalUser
 
     customBackend :: API CustomBackendAPI GalleyEffects

services/galley/src/Galley/Cassandra/Conversation/MLS.hs

@@ -23,8 +23,8 @@ import Data.Time
 import qualified Galley.Cassandra.Queries as Cql
 import Galley.Data.Types
 import Imports
+import Wire.API.MLS.Epoch
 import Wire.API.MLS.Group
-import Wire.API.MLS.Message
 
 acquireCommitLock :: GroupId -> Epoch -> NominalDiffTime -> Client LockAcquired
 acquireCommitLock groupId epoch ttl = do

services/galley/src/Galley/Cassandra/Proposal.hs

@@ -26,8 +26,8 @@ import Galley.Effects.ProposalStore
 import Imports
 import Polysemy
 import Polysemy.Input
+import Wire.API.MLS.Epoch
 import Wire.API.MLS.Group
-import Wire.API.MLS.Message
 import Wire.API.MLS.Proposal
 import Wire.API.MLS.Serialisation
 

services/galley/src/Galley/Effects/ConversationStore.hs

@@ -64,7 +64,7 @@ import Galley.Types.Conversations.Members
 import Imports
 import Polysemy
 import Wire.API.Conversation hiding (Conversation, Member)
-import Wire.API.MLS.Message
+import Wire.API.MLS.Epoch
 
 data ConversationStore m a where
   CreateConversationId :: ConversationStore m ConvId

services/galley/src/Galley/Effects/ProposalStore.hs

@@ -21,8 +21,8 @@ module Galley.Effects.ProposalStore where
 
 import Imports
 import Polysemy
+import Wire.API.MLS.Epoch
 import Wire.API.MLS.Group
-import Wire.API.MLS.Message
 import Wire.API.MLS.Proposal
 import Wire.API.MLS.Serialisation
 

services/galley/test/integration/API/MLS.hs

@@ -25,6 +25,7 @@ import API.Util
 import Bilge hiding (head)
 import Bilge.Assert
 import Cassandra
+import Control.Arrow
 import Control.Lens (view)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
@@ -62,6 +63,7 @@ import Wire.API.Federation.API.Common
 import Wire.API.Federation.API.Galley
 import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Group (convToGroupId)
+import Wire.API.MLS.Message
 import Wire.API.Message
 
 tests :: IO TestSetup -> TestTree
@@ -699,12 +701,12 @@ testRemoteAppMessage = withSystemTempDirectory "mls" $ \tmp -> do
             . pClients
             $ bob
         ms -> assertFailure ("unmocked endpoint called: " <> cs ms)
-  (events :: [Event], reqs) <- withTempMockFederator' mock $ do
+  (events :: [Event], reqs) <- fmap (first mmssEvents) . withTempMockFederator' mock $ do
     galley <- viewGalley
     void $ postCommit MessagingSetup {creator = alice, users = [bob], ..}
     responseJsonError
       =<< post
-        ( galley . paths ["mls", "messages"]
+        ( galley . paths ["v2", "mls", "messages"]
             . zUser (qUnqualified (pUserId alice))
             . zConn "conn"
             . content "message/mls"
@@ -1175,7 +1177,7 @@ propExistingConv = withSystemTempDirectory "mls" $ \tmp -> do
   prop <- liftIO $ bareAddProposal tmp creator bob "group.json" "group.json"
 
   events <-
-    responseJsonError
+    fmap mmssEvents . responseJsonError
       =<< postMessage (qUnqualified (pUserId creator)) prop
       <!! const 201 === statusCode
   liftIO $ events @?= ([] :: [Event])

services/galley/test/integration/API/MLS/Util.hs

@@ -50,6 +50,7 @@ import Wire.API.Conversation.Protocol
 import Wire.API.Event.Conversation
 import Wire.API.MLS.Credential
 import Wire.API.MLS.KeyPackage
+import Wire.API.MLS.Message
 import Wire.API.MLS.Serialisation
 import Wire.API.User.Client
 import Wire.API.User.Client.Prekey
@@ -444,7 +445,7 @@ claimKeyPackage brig claimant target =
 
 postCommit :: HasCallStack => MessagingSetup -> TestM [Event]
 postCommit MessagingSetup {..} =
-  responseJsonError
+  fmap mmssEvents . responseJsonError
     =<< postMessage (qUnqualified (pUserId creator)) commit
       <!! const 201 === statusCode
 
@@ -462,7 +463,7 @@ postMessage ::
 postMessage sender msg = do
   galley <- viewGalley
   post
-    ( galley . paths ["mls", "messages"]
+    ( galley . paths ["v2", "mls", "messages"]
         . zUser sender
         . zConn "conn"
         . content "message/mls"