Skip to content

Commit 0ba778f

Browse files
pcapriottipcapriotti
committed
Allow remote conversations in mls-message endpoint
1 parent 9057378 commit 0ba778f

File tree

7 files changed

+104
-38
lines changed

7 files changed

+104
-38
lines changed

‎libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -275,8 +275,8 @@ data MLSWelcomeRequest = MLSWelcomeRequest
275275

276276
data MLSMessageResponse
277277
= MLSMessageResponseError GalleyError
278-
| MLSProtocolError Text
279-
| MLSProposalFailure Wai.Error
278+
| MLSMessageResponseProtocolError Text
279+
| MLSMessageResponseProposalFailure Wai.Error
280280
| MLSMessageResponseUpdates [ConversationUpdate]
281281
deriving stock (Show, Generic)
282282
deriving

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,7 @@ instance
103103

104104
fromUnion (Z (I c)) = CodeAlreadyExisted c
105105
fromUnion (S (Z (I e))) = CodeAdded e
106-
fromUnion (S (S x)) = case x of
106+
fromUnion (S (S x)) = case x of {}
107107

108108
type ConvUpdateResponses = UpdateResponses "Conversation unchanged" "Conversation updated" Event
109109

@@ -1284,6 +1284,7 @@ type MLSMessagingAPI =
12841284
:<|> Named
12851285
"mls-message"
12861286
( Summary "Post an MLS message"
1287+
:> CanThrow 'ConvAccessDenied
12871288
:> CanThrow 'ConvNotFound
12881289
:> CanThrow 'MLSKeyPackageRefNotFound
12891290
:> CanThrow 'MLSClientMismatch

‎services/galley/src/Galley/API/Action.hs

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -671,14 +671,14 @@ notifyRemoteConversationAction ::
671671
ExternalAccess,
672672
GundeckAccess,
673673
MemberStore,
674-
Input (Local ()),
675674
P.TinyLog
676675
]
677676
r =>
677+
Local x ->
678678
Remote ConversationUpdate ->
679-
ConnId ->
679+
Maybe ConnId ->
680680
Sem r Event
681-
notifyRemoteConversationAction rconvUpdate con = do
681+
notifyRemoteConversationAction loc rconvUpdate con = do
682682
let convUpdate = tUnqualified rconvUpdate
683683
rconvId = qualifyAs rconvUpdate . cuConvId $ convUpdate
684684

@@ -692,7 +692,6 @@ notifyRemoteConversationAction rconvUpdate con = do
692692
-- backend.
693693
(presentUsers, allUsersArePresent) <-
694694
E.selectRemoteMembers (cuAlreadyPresentUsers convUpdate) rconvId
695-
loc <- qualifyLocal ()
696695
let localPresentUsers = qualifyAs loc presentUsers
697696

698697
unless allUsersArePresent $
@@ -709,4 +708,4 @@ notifyRemoteConversationAction rconvUpdate con = do
709708
-- implemented.
710709
let bots = []
711710

712-
pushConversationEvent (Just con) event localPresentUsers bots $> event
711+
pushConversationEvent con event localPresentUsers bots $> event

‎services/galley/src/Galley/API/Federation.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -543,11 +543,11 @@ sendMLSMessage ::
543543
F.MessageSendRequest ->
544544
Sem r F.MLSMessageResponse
545545
sendMLSMessage remoteDomain msr =
546-
fmap (either F.MLSProtocolError id)
546+
fmap (either F.MLSMessageResponseProtocolError id)
547547
. runError
548548
. fmap (either F.MLSMessageResponseError id)
549549
. runError
550-
. fmap (either (F.MLSProposalFailure . pfInner) id)
550+
. fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id)
551551
. runError
552552
$ do
553553
loc <- qualifyLocal ()

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

Lines changed: 69 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import Control.Arrow
2727
import Control.Comonad
2828
import Control.Lens (preview, to)
2929
import Data.Id
30+
import Data.Json.Util
3031
import Data.List.NonEmpty (NonEmpty, nonEmpty)
3132
import qualified Data.Map as Map
3233
import Data.Qualified
@@ -42,6 +43,7 @@ import qualified Galley.Data.Conversation.Types as Data
4243
import Galley.Effects
4344
import Galley.Effects.BrigAccess
4445
import Galley.Effects.ConversationStore
46+
import Galley.Effects.FederatorAccess
4547
import Galley.Effects.MemberStore
4648
import Galley.Options
4749
import Galley.Types
@@ -55,6 +57,8 @@ import Wire.API.Conversation.Protocol
5557
import Wire.API.Conversation.Role
5658
import Wire.API.Error
5759
import Wire.API.Error.Galley
60+
import Wire.API.Federation.API
61+
import Wire.API.Federation.API.Galley
5862
import Wire.API.Federation.Error
5963
import Wire.API.MLS.CipherSuite
6064
import Wire.API.MLS.Commit
@@ -65,7 +69,8 @@ import Wire.API.MLS.Proposal
6569
import Wire.API.MLS.Serialisation
6670

6771
type MLSMessageStaticErrors =
68-
'[ ErrorS 'ConvNotFound,
72+
'[ ErrorS 'ConvAccessDenied,
73+
ErrorS 'ConvNotFound,
6974
ErrorS 'MLSUnsupportedMessage,
7075
ErrorS 'MLSStaleMessage,
7176
ErrorS 'MLSProposalNotFound,
@@ -93,6 +98,7 @@ postMLSMessage ::
9398
( HasProposalEffects r,
9499
Members
95100
'[ Error FederationError,
101+
ErrorS 'ConvAccessDenied,
96102
ErrorS 'ConvNotFound,
97103
ErrorS 'MLSUnsupportedMessage,
98104
ErrorS 'MLSStaleMessage,
@@ -108,17 +114,42 @@ postMLSMessage ::
108114
RawMLS SomeMessage ->
109115
Sem r [LocalConversationUpdate]
110116
postMLSMessage loc qusr con smsg = case rmValue smsg of
111-
SomeMessage tag msg -> do
112-
-- fetch conversation
117+
SomeMessage _ msg -> do
118+
-- fetch conversation ID
113119
qcnv <- getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound
114-
lcnv <- ensureLocal loc qcnv -- FUTUREWORK: allow remote conversations
120+
foldQualified
121+
loc
122+
(postMLSMessageToLocalConv qusr con smsg)
123+
(postMLSMessageToRemoteConv loc qusr con smsg)
124+
qcnv
125+
126+
postMLSMessageToLocalConv ::
127+
( HasProposalEffects r,
128+
Members
129+
'[ Error FederationError,
130+
ErrorS 'ConvNotFound,
131+
ErrorS 'MLSUnsupportedMessage,
132+
ErrorS 'MLSStaleMessage,
133+
ErrorS 'MLSProposalNotFound,
134+
ErrorS 'MissingLegalholdConsent,
135+
TinyLog
136+
]
137+
r
138+
) =>
139+
Qualified UserId ->
140+
Maybe ConnId ->
141+
RawMLS SomeMessage ->
142+
Local ConvId ->
143+
Sem r [LocalConversationUpdate]
144+
postMLSMessageToLocalConv qusr con smsg lcnv = case rmValue smsg of
145+
SomeMessage tag msg -> do
115146
conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound
116147

117148
-- validate message
118149
events <- case tag of
119150
SMLSPlainText -> case msgTBS (msgPayload msg) of
120151
CommitMessage c ->
121-
processCommit qusr con (qualifyAs loc conv) (msgEpoch msg) c
152+
processCommit qusr con (qualifyAs lcnv conv) (msgEpoch msg) c
122153
ApplicationMessage _ -> throwS @'MLSUnsupportedMessage
123154
ProposalMessage _ -> pure mempty -- FUTUREWORK: handle proposals
124155
SMLSCipherText -> case toMLSEnum' (msgContentType (msgPayload msg)) of
@@ -128,10 +159,42 @@ postMLSMessage loc qusr con smsg = case rmValue smsg of
128159
Left _ -> throwS @'MLSUnsupportedMessage
129160

130161
-- forward message
131-
propagateMessage loc qusr conv con (rmRaw smsg)
162+
propagateMessage lcnv qusr conv con (rmRaw smsg)
132163

133164
pure events
134165

166+
postMLSMessageToRemoteConv ::
167+
( Members MLSMessageStaticErrors r,
168+
Members '[Error FederationError, TinyLog] r,
169+
HasProposalEffects r
170+
) =>
171+
Local x ->
172+
Qualified UserId ->
173+
Maybe ConnId ->
174+
RawMLS SomeMessage ->
175+
Remote ConvId ->
176+
Sem r [LocalConversationUpdate]
177+
postMLSMessageToRemoteConv loc qusr con smsg rcnv = do
178+
-- only local users can send messages to remote conversations
179+
lusr <- foldQualified loc pure (\_ -> throwS @'ConvAccessDenied) qusr
180+
resp <-
181+
runFederated rcnv $
182+
fedClient @'Galley @"send-mls-message" $
183+
MessageSendRequest
184+
{ msrConvId = tUnqualified rcnv,
185+
msrSender = tUnqualified lusr,
186+
msrRawMessage = Base64ByteString (rmRaw smsg)
187+
}
188+
updates <- case resp of
189+
MLSMessageResponseError e -> rethrowErrors @MLSMessageStaticErrors e
190+
MLSMessageResponseProtocolError e -> throw (mlsProtocolError e)
191+
MLSMessageResponseProposalFailure e -> throw (MLSProposalFailure e)
192+
MLSMessageResponseUpdates updates -> pure updates
193+
194+
for updates $ \update -> do
195+
e <- notifyRemoteConversationAction loc (qualifyAs rcnv update) con
196+
pure (LocalConversationUpdate e update)
197+
135198
type HasProposalEffects r =
136199
( Member BrigAccess r,
137200
Member ConversationStore r,

‎services/galley/src/Galley/API/Update.hs

Lines changed: 1 addition & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,6 @@ import qualified Data.Map.Strict as Map
7777
import Data.Qualified
7878
import qualified Data.Set as Set
7979
import Data.Singletons
80-
import qualified Data.Text as T
8180
import Data.Time
8281
import Galley.API.Action
8382
import Galley.API.Error
@@ -377,27 +376,7 @@ updateRemoteConversation rcnv lusr conn action = getUpdateResult $ do
377376
ConversationUpdateResponseUpdate convUpdate -> pure convUpdate
378377

379378
onConversationUpdated (tDomain rcnv) convUpdate
380-
notifyRemoteConversationAction (qualifyAs rcnv convUpdate) conn
381-
382-
class RethrowErrors (effs :: EffectRow) r where
383-
rethrowErrors :: GalleyError -> Sem r a
384-
385-
instance (Member (Error FederationError) r) => RethrowErrors '[] r where
386-
rethrowErrors :: GalleyError -> Sem r a
387-
rethrowErrors err' = throw (FederationUnexpectedError (T.pack . show $ err'))
388-
389-
instance
390-
( SingI (e :: GalleyError),
391-
Member (ErrorS e) r,
392-
RethrowErrors effs r
393-
) =>
394-
RethrowErrors (ErrorS e ': effs) r
395-
where
396-
rethrowErrors :: GalleyError -> Sem r a
397-
rethrowErrors err' =
398-
if err' == demote @e
399-
then throwS @e
400-
else rethrowErrors @effs @r err'
379+
notifyRemoteConversationAction lusr (qualifyAs rcnv convUpdate) (Just conn)
401380

402381
updateConversationReceiptModeUnqualified ::
403382
Members

‎services/galley/src/Galley/API/Util.hs

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import Data.Misc (PlainTextPassword (..))
3636
import Data.Qualified
3737
import qualified Data.Set as Set
3838
import Data.Singletons
39+
import qualified Data.Text as T
3940
import Data.Time
4041
import Galley.API.Error
4142
import qualified Galley.Data.Conversation as Data
@@ -824,3 +825,26 @@ ensureMemberLimit old new = do
824825
let maxSize = fromIntegral (o ^. optSettings . setMaxConvSize)
825826
when (length old + length new > maxSize) $
826827
throwS @'TooManyMembers
828+
829+
--------------------------------------------------------------------------------
830+
-- Handling remote errors
831+
832+
class RethrowErrors (effs :: EffectRow) r where
833+
rethrowErrors :: GalleyError -> Sem r a
834+
835+
instance (Member (Error FederationError) r) => RethrowErrors '[] r where
836+
rethrowErrors :: GalleyError -> Sem r a
837+
rethrowErrors err' = throw (FederationUnexpectedError (T.pack . show $ err'))
838+
839+
instance
840+
( SingI (e :: GalleyError),
841+
Member (ErrorS e) r,
842+
RethrowErrors effs r
843+
) =>
844+
RethrowErrors (ErrorS e ': effs) r
845+
where
846+
rethrowErrors :: GalleyError -> Sem r a
847+
rethrowErrors err' =
848+
if err' == demote @e
849+
then throwS @e
850+
else rethrowErrors @effs @r err'

0 commit comments

Comments
 (0)