diff --git a/changelog.d/6-federation/fix-fed-welcome-request b/changelog.d/6-federation/fix-fed-welcome-request new file mode 100644 index 0000000000..5ee60e16e9 --- /dev/null +++ b/changelog.d/6-federation/fix-fed-welcome-request @@ -0,0 +1 @@ +Send only the raw welcome message in the Galley "mls-welcome" federation endpoint diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 8ec0177ced..ed679c8780 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -352,17 +352,16 @@ logError :: (MonadIO m, HasRequest r) => Logger -> Maybe r -> Wai.Error -> m () logError g mr = logError' g (lookupRequestId =<< mr) logError' :: (MonadIO m) => Logger -> Maybe ByteString -> Wai.Error -> m () -logError' g mr e = liftIO $ doLog g (logErrorMsg mr e) +logError' g mr e = liftIO $ doLog g (logErrorMsgWithRequest mr e) where doLog | statusCode (Error.code e) >= 500 = Log.err | otherwise = Log.debug -logErrorMsg :: Maybe ByteString -> Wai.Error -> Msg -> Msg -logErrorMsg mr (Wai.Error c l m md) = +logErrorMsg :: Wai.Error -> Msg -> Msg +logErrorMsg (Wai.Error c l m md) = field "code" (statusCode c) . field "label" l - . field "request" (fromMaybe "N/A" mr) . fromMaybe id (fmap logErrorData md) . msg (val "\"" +++ m +++ val "\"") where @@ -370,6 +369,10 @@ logErrorMsg mr (Wai.Error c l m md) = field "domain" (domainText d) . field "path" p +logErrorMsgWithRequest :: Maybe ByteString -> Wai.Error -> Msg -> Msg +logErrorMsgWithRequest mr e = + field "request" (fromMaybe "N/A" mr) . logErrorMsg e + logIO :: (ToBytes msg, HasRequest r) => Logger -> Level -> Maybe r -> msg -> IO () logIO lg lv r a = let reqId = field "request" . fromMaybe "N/A" . lookupRequestId <$> r diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 6b4ed3fd56..b26d82695c 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -14,7 +14,6 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Wire.API.Federation.API.Galley where @@ -60,7 +59,7 @@ type GalleyApi = :<|> FedEndpoint "send-message" MessageSendRequest MessageSendResponse :<|> FedEndpoint "on-user-deleted-conversations" UserDeletedConversationsNotification EmptyResponse :<|> FedEndpoint "update-conversation" ConversationUpdateRequest ConversationUpdateResponse - :<|> FedEndpoint "mls-welcome" MLSWelcomeRequest () + :<|> FedEndpoint "mls-welcome" MLSWelcomeRequest EmptyResponse data GetConversationsRequest = GetConversationsRequest { gcrUserId :: UserId, @@ -256,17 +255,10 @@ data ConversationUpdateResponse (ToJSON, FromJSON) via (CustomEncoded ConversationUpdateResponse) -newtype MLSWelcomeRecipient = MLSWelcomeRecipient {unMLSWelRecipient :: (UserId, ClientId)} - deriving stock (Generic) - deriving (Arbitrary) via (GenericUniform MLSWelcomeRecipient) - deriving (FromJSON, ToJSON) via CustomEncoded MLSWelcomeRecipient - deriving newtype (Show, Eq) - -data MLSWelcomeRequest = MLSWelcomeRequest - { mwrRawWelcome :: Base64ByteString, - -- | These are qualified implicitly by the target domain - mwrRecipients :: [MLSWelcomeRecipient] +-- | A wrapper around a raw welcome message +newtype MLSWelcomeRequest = MLSWelcomeRequest + { unMLSWelcomeRequest :: Base64ByteString } - deriving stock (Generic) + deriving stock (Eq, Generic, Show) deriving (Arbitrary) via (GenericUniform MLSWelcomeRequest) deriving (FromJSON, ToJSON) via (CustomEncoded MLSWelcomeRequest) diff --git a/services/federator/src/Federator/Response.hs b/services/federator/src/Federator/Response.hs index 7dac50589d..7cc670ad3d 100644 --- a/services/federator/src/Federator/Response.hs +++ b/services/federator/src/Federator/Response.hs @@ -88,7 +88,7 @@ runWaiError = where logError :: Members '[Error Wai.Error, TinyLog] r => Wai.Error -> Sem r a logError e = do - err $ Wai.logErrorMsg Nothing e + err $ Wai.logErrorMsg e throw e serve :: diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index bbfd6642e8..9a3e1a55e2 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -19,6 +19,7 @@ module Galley.API.Federation where import Brig.Types.Connection (Relation (Accepted)) +import Control.Error import Control.Lens (itraversed, (<.>)) import Data.ByteString.Conversion (toByteString') import Data.Containers.ListUtils (nubOrd) @@ -32,13 +33,15 @@ import Data.Qualified import Data.Range (Range (fromRange)) import qualified Data.Set as Set import Data.Singletons (SingI (..), demote, sing) +import Data.Tagged import qualified Data.Text.Lazy as LT import Data.Time.Clock import Galley.API.Action import Galley.API.Error +import Galley.API.MLS.KeyPackage +import Galley.API.MLS.Welcome import qualified Galley.API.Mapping as Mapping import Galley.API.Message -import Galley.API.Push import Galley.API.Util import Galley.App import qualified Galley.Data.Conversation as Data @@ -72,6 +75,9 @@ import Wire.API.Federation.API.Common (EmptyResponse (..)) import Wire.API.Federation.API.Galley (ConversationUpdateResponse) import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Error +import Wire.API.MLS.Credential +import Wire.API.MLS.Serialisation +import Wire.API.MLS.Welcome import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Named import Wire.API.ServantProto @@ -290,7 +296,7 @@ leaveConversation requestingDomain lc = do pure (update, conv) case res of - Left err -> pure $ F.LeaveConversationResponse (Left err) + Left e -> pure $ F.LeaveConversationResponse (Left e) Right (_update, conv) -> do let action = pure (qUntagged leaver) @@ -299,7 +305,6 @@ leaveConversation requestingDomain lc = do _event <- notifyConversationAction SConversationLeaveTag (qUntagged leaver) Nothing lcnv botsAndMembers action pure $ F.LeaveConversationResponse (Right ()) - where -- FUTUREWORK: report errors to the originating backend -- FUTUREWORK: error handling for missing / mismatched clients @@ -529,26 +534,32 @@ instance mlsSendWelcome :: Members - '[ GundeckAccess, + '[ BrigAccess, + Error InternalError, + GundeckAccess, Input (Local ()), Input UTCTime ] r => Domain -> F.MLSWelcomeRequest -> - Sem r () -mlsSendWelcome _origDomain (F.MLSWelcomeRequest b64RawWelcome rcpts) = do - loc <- input @(Local ()) - now <- input @UTCTime - let rawWelcome = fromBase64ByteString b64RawWelcome - void $ - runMessagePush loc Nothing $ - foldMap (uncurry $ mkPush rawWelcome loc now) (F.unMLSWelRecipient <$> rcpts) - where - mkPush :: ByteString -> Local x -> UTCTime -> UserId -> ClientId -> MessagePush 'Broadcast - mkPush rawWelcome l time u c = - -- FUTUREWORK: use the conversation ID stored in the key package mapping table - let lcnv = qualifyAs l (Data.selfConv u) - lusr = qualifyAs l u - e = Event (qUntagged lcnv) (qUntagged lusr) time $ EdMLSWelcome rawWelcome - in newMessagePush l () Nothing defMessageMetadata (u, c) e + Sem r EmptyResponse +mlsSendWelcome _origDomain (fromBase64ByteString . F.unMLSWelcomeRequest -> rawWelcome) = do + loc <- qualifyLocal () + now <- input + welcome <- either (throw . InternalErrorWithDescription . LT.fromStrict) pure $ decodeMLS' rawWelcome + -- Extract only recipients local to this backend + rcpts <- + fmap catMaybes $ + traverse + ( fmap (fmap cidQualifiedClient . hush) + . runError @(Tagged 'MLSKeyPackageRefNotFound ()) + . derefKeyPackage + . gsNewMember + ) + $ welSecrets welcome + let lrcpts = qualifyAs loc $ fst $ partitionQualified loc rcpts + + sendLocalWelcomes Nothing now rawWelcome lrcpts + + pure EmptyResponse diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/services/galley/src/Galley/API/MLS/Welcome.hs index b8445b62cb..65194d085c 100644 --- a/services/galley/src/Galley/API/MLS/Welcome.hs +++ b/services/galley/src/Galley/API/MLS/Welcome.hs @@ -15,9 +15,14 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.MLS.Welcome (postMLSWelcome) where +module Galley.API.MLS.Welcome + ( postMLSWelcome, + sendLocalWelcomes, + ) +where import Control.Comonad +import Data.Domain import Data.Id import Data.Json.Util import Data.Qualified @@ -29,13 +34,17 @@ import Galley.Effects.BrigAccess import Galley.Effects.FederatorAccess import Galley.Effects.GundeckAccess import Imports +import Network.Wai.Utilities.Server import Polysemy import Polysemy.Input +import qualified Polysemy.TinyLog as P +import qualified System.Logger.Class as Logger import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Galley +import Wire.API.Federation.Error import Wire.API.MLS.Credential import Wire.API.MLS.Serialisation import Wire.API.MLS.Welcome @@ -46,7 +55,8 @@ postMLSWelcome :: FederatorAccess, GundeckAccess, ErrorS 'MLSKeyPackageRefNotFound, - Input UTCTime + Input UTCTime, + P.TinyLog ] r => Local UserId -> @@ -54,8 +64,11 @@ postMLSWelcome :: RawMLS Welcome -> Sem r () postMLSWelcome lusr con wel = do + now <- input rcpts <- welcomeRecipients (rmValue wel) - traverse_ (sendWelcomes lusr con (rmRaw wel)) (bucketQualified rcpts) + let (locals, remotes) = partitionQualified lusr rcpts + sendLocalWelcomes (Just con) now (rmRaw wel) (qualifyAs lusr locals) + sendRemoteWelcomes (rmRaw wel) remotes welcomeRecipients :: Members @@ -73,25 +86,9 @@ welcomeRecipients = ) . welSecrets -sendWelcomes :: - Members - '[ FederatorAccess, - GundeckAccess, - Input UTCTime - ] - r => - Local x -> - ConnId -> - ByteString -> - Qualified [(UserId, ClientId)] -> - Sem r () -sendWelcomes loc con rawWelcome recipients = do - now <- input - foldQualified loc (sendLocalWelcomes con now rawWelcome) (sendRemoteWelcomes rawWelcome) recipients - sendLocalWelcomes :: Members '[GundeckAccess] r => - ConnId -> + Maybe ConnId -> UTCTime -> ByteString -> Local [(UserId, ClientId)] -> @@ -106,18 +103,28 @@ sendLocalWelcomes con now rawWelcome lclients = do let lcnv = qualifyAs lclients (selfConv u) lusr = qualifyAs lclients u e = Event (qUntagged lcnv) (qUntagged lusr) now $ EdMLSWelcome rawWelcome - in newMessagePush lclients () (Just con) defMessageMetadata (u, c) e + in newMessagePush lclients () con defMessageMetadata (u, c) e sendRemoteWelcomes :: - Members '[FederatorAccess] r => + Members + '[ FederatorAccess, + P.TinyLog + ] + r => ByteString -> - Remote [(UserId, ClientId)] -> + [Remote (UserId, ClientId)] -> Sem r () -sendRemoteWelcomes rawWelcome rClients = do - let req = - MLSWelcomeRequest - { mwrRawWelcome = Base64ByteString rawWelcome, - mwrRecipients = MLSWelcomeRecipient <$> tUnqualified rClients - } +sendRemoteWelcomes rawWelcome clients = do + let req = MLSWelcomeRequest . Base64ByteString $ rawWelcome rpc = fedClient @'Galley @"mls-welcome" req - void $ runFederated rClients rpc + (traverse_ handleError =<<) + . runFederatedConcurrentlyEither clients + $ \_ -> rpc + where + handleError :: Member P.TinyLog r => Either (Remote [a], FederationError) x -> Sem r () + handleError (Right _) = pure () + handleError (Left (r, e)) = + P.warn $ + Logger.msg ("A welcome message could not be delivered to a remote backend" :: ByteString) + . Logger.field "remote_domain" (domainText (tDomain r)) + . (logErrorMsg (toWai e)) diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 0918e4acc2..6f4ec83254 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -31,7 +31,7 @@ import Data.Default import Data.Domain import Data.Id (ConvId, Id (..), UserId, newClientId, randomId) import Data.Json.Util hiding ((#)) -import Data.List.NonEmpty (NonEmpty (..), head) +import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 import qualified Data.List1 as List1 import qualified Data.Map as Map @@ -92,7 +92,8 @@ tests s = test s "POST /federation/send-message : Post a message sent from another backend" sendMessage, test s "POST /federation/on-user-deleted-conversations : Remove deleted remote user from local conversations" onUserDeleted, test s "POST /federation/update-conversation : Update local conversation by a remote admin " updateConversationByRemoteAdmin, - test s "POST /federation/mls-welcome : Post an MLS welcome message received from another backend" sendMLSWelcome + test s "POST /federation/mls-welcome : Post an MLS welcome message received from another backend" sendMLSWelcome, + test s "POST /federation/mls-welcome : Post an MLS welcome message (key package ref not found)" sendMLSWelcomeKeyPackageNotFound ] getConversationsAllFound :: TestM () @@ -1148,23 +1149,52 @@ sendMLSWelcome = do -- Alice is from the originating domain and Bob is local, i.e., on the receiving domain MessagingSetup {..} <- aliceInvitesBob (1, LocalUser) def {creatorOrigin = RemoteUser aliceDomain} let bob = users !! 0 - bobClient = snd . Data.List.NonEmpty.head . pClients $ bob fedGalleyClient <- view tsFedGalleyClient cannon <- view tsCannon WS.bracketR cannon (qUnqualified (pUserId bob)) $ \wsB -> do -- send welcome message - runFedClient @"mls-welcome" fedGalleyClient aliceDomain $ - MLSWelcomeRequest - (Base64ByteString welcome) - [MLSWelcomeRecipient (qUnqualified . pUserId $ bob, bobClient)] + void $ + runFedClient @"mls-welcome" fedGalleyClient aliceDomain $ + MLSWelcomeRequest + (Base64ByteString welcome) -- check that the corresponding event is received - void . liftIO $ - WS.assertMatch (5 # WS.Second) wsB $ + liftIO $ do + WS.assertMatch_ (5 # WS.Second) wsB $ wsAssertMLSWelcome (pUserId bob) welcome +sendMLSWelcomeKeyPackageNotFound :: TestM () +sendMLSWelcomeKeyPackageNotFound = do + let aliceDomain = Domain "a.far-away.example.com" + -- Alice is from the originating domain and Bob is local, i.e., on the receiving domain + MessagingSetup {..} <- + aliceInvitesBob + (1, LocalUser) + def + { creatorOrigin = RemoteUser aliceDomain, + createClients = DontCreateClients -- no key package upload will happen + } + let bob = users !! 0 + + fedGalleyClient <- view tsFedGalleyClient + cannon <- view tsCannon + + WS.bracketR cannon (qUnqualified (pUserId bob)) $ \wsB -> do + -- send welcome message + void $ + runFedClient @"mls-welcome" fedGalleyClient aliceDomain $ + MLSWelcomeRequest + (Base64ByteString welcome) + + liftIO $ do + -- check that no event is received + WS.assertNoEvent (1 # Second) [wsB] + +-- success is reported, even though no client receives the welcome +-- message due to missing key package references + getConvAction :: Sing tag -> SomeConversationAction -> Maybe (ConversationAction tag) getConvAction tquery (SomeConversationAction tag action) = case (tag, tquery) of diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 5cf7e4eb77..9ec030941f 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -28,6 +28,7 @@ import qualified Data.Aeson as Aeson import Data.Default import Data.Domain import Data.Id +import Data.Json.Util hiding ((#)) import qualified Data.List.NonEmpty as NonEmpty import Data.List1 import Data.Qualified @@ -47,6 +48,7 @@ import TestHelpers import TestSetup import Wire.API.Conversation import Wire.API.Conversation.Role +import Wire.API.Federation.API.Common import Wire.API.Federation.API.Galley import Wire.API.Message @@ -142,11 +144,11 @@ testRemoteWelcome = do opts = def {createConv = CreateConv, createClients = DontCreateClients} MessagingSetup {..} <- aliceInvitesBob (1, RemoteUser bobDomain) opts let alice = creator - bob = Imports.head users + let okResp = EmptyResponse let mockedResponse fedReq = case frRPC fedReq of - "mls-welcome" -> pure (Aeson.encode ()) + "mls-welcome" -> pure (Aeson.encode okResp) ms -> assertFailure ("unmocked endpoint called: " <> cs ms) (_resp, reqs) <- @@ -156,15 +158,8 @@ testRemoteWelcome = do -- Assert the correct federated call is made. fedWelcome <- assertOne (filter ((== "mls-welcome") . frRPC) reqs) - let welcomeRequest :: Maybe MLSWelcomeRequest = Aeson.decode (frBody fedWelcome) - liftIO $ - fmap mwrRecipients welcomeRequest - @?= Just - [ MLSWelcomeRecipient - ( qUnqualified . pUserId $ bob, - snd . NonEmpty.head . pClients $ bob - ) - ] + let req :: Maybe MLSWelcomeRequest = Aeson.decode (frBody fedWelcome) + liftIO $ req @?= (Just . MLSWelcomeRequest . Base64ByteString) welcome -- | Send a commit message, and assert that all participants see an event with -- the given list of new members.