Apply review

Make the namespace more distinguishable, and extend the return to also
contain the origin-id if not empty.

big_tests/tests/mam_SUITE.erl

@@ -3244,7 +3244,7 @@ retract_element(origin_id) ->
            attrs = [{<<"xmlns">>, <<"urn:xmpp:message-retract:0">>}]};
 retract_element(stanza_id) ->
     #xmlel{name = <<"retract">>,
-           attrs = [{<<"xmlns">>, <<"urn:esl:message-retract:0">>}]}.
+           attrs = [{<<"xmlns">>, <<"urn:esl:message-retract-by-stanza-id:0">>}]}.
 
 origin_id_to_retract(Config) ->
     proplists:get_value(origin_id, Config, origin_id()).

big_tests/tests/mam_helper.erl

@@ -239,7 +239,7 @@ mam_ns_binary() -> mam_ns_binary_v04().
 mam_ns_binary_v04() -> <<"urn:xmpp:mam:1">>.
 mam_ns_binary_v06() -> <<"urn:xmpp:mam:2">>.
 retract_ns() -> <<"urn:xmpp:message-retract:0">>.
-retract_esl_ns() -> <<"urn:esl:message-retract:0">>.
+retract_esl_ns() -> <<"urn:esl:message-retract-by-stanza-id:0">>.
 retract_tombstone_ns() -> <<"urn:xmpp:message-retract:0#tombstone">>.
 
 skip_undefined(Xs) ->

doc/modules/mod_mam.md

@@ -27,7 +27,7 @@ The following criteria are used to find the original message:
 If more than one message matches the criteria, only the most recent one is retracted. To avoid this case, it is recommended to use a unique identifier (UUID) as the origin ID.
 
 #### Retraction on the stanza-id
-This module also implements an extension to the XEP, where it allows to specify the [`stanza-id`](https://xmpp.org/extensions/xep-0359.html#stanza-id) as [created by](https://xmpp.org/extensions/xep-0313.html#archives_id) the server's MAM, instead of the `origin-id` that the original [XEP-0424](https://xmpp.org/extensions/xep-0424.html) specifies. It announces this capability under the namespace `urn:esl:message-retract:0`. This is specially useful in groupchats where the `stanza-id` of a message is shared and known for all participants.
+This module also implements an extension to the XEP, where it allows to specify the [`stanza-id`](https://xmpp.org/extensions/xep-0359.html#stanza-id) as [created by](https://xmpp.org/extensions/xep-0313.html#archives_id) the server's MAM, instead of the `origin-id` that the original [XEP-0424](https://xmpp.org/extensions/xep-0424.html) specifies. It announces this capability under the namespace `urn:esl:message-retract-by-stanza-id:0`. This is specially useful in groupchats where the `stanza-id` of a message is shared and known for all participants.
 
 In this case, to use such functionality,
 ```xml

include/mongoose_ns.hrl

@@ -106,7 +106,7 @@
 -define(JINGLE_NS, <<"urn:xmpp:jingle:1">>).
 
 %% Custom extension to accept stanza-ids as retraction IDs
--define(NS_ESL_RETRACT,         <<"urn:esl:message-retract:0">>).
+-define(NS_ESL_RETRACT,         <<"urn:esl:message-retract-by-stanza-id:0">>).
 
 %% Erlang Solutions custom extension - token based authentication
 -define(NS_ESL_TOKEN_AUTH,      <<"erlang-solutions.com:xmpp:token-auth:0">>).

src/mam/mam_decoder.erl

@@ -2,15 +2,18 @@
 -export([decode_row/2]).
 -export([decode_muc_row/2]).
 -export([decode_muc_gdpr_row/2]).
--export([decode_retraction_info/2]).
+-export([decode_retraction_info/3]).
 
 -type ext_mess_id() :: non_neg_integer() | binary().
 -type env_vars() :: mod_mam_rdbms_arch:env_vars().
 -type db_row() :: {ext_mess_id(), ExtSrcJID :: binary(), ExtData :: binary()}.
 -type db_muc_row() :: {ext_mess_id(), Nick :: binary(), ExtData :: binary()}.
 -type db_muc_gdpr_row() :: {ext_mess_id(), ExtData :: binary()}.
 -type decoded_muc_gdpr_row() :: {ext_mess_id(), exml:element()}.
--type retraction_info() :: #{packet := exml:element(), message_id := mod_mam:message_id()}.
+-type retraction_info() :: #{retract_on := origin_id | stanza_id,
+                             packet := exml:element(),
+                             message_id := mod_mam:message_id(),
+                             origin_id := binary()}.
 
 -spec decode_row(db_row(), env_vars()) -> mod_mam:message_row().
 decode_row({ExtMessID, ExtSrcJID, ExtData}, Env) ->
@@ -31,13 +34,20 @@ decode_muc_gdpr_row({ExtMessID, ExtData}, Env) ->
     Packet = decode_packet(ExtData, Env),
     {ExtMessID, Packet}.
 
--spec decode_retraction_info(env_vars(), [] | [{mod_mam:message_id(), binary()}]) ->
+-spec decode_retraction_info(env_vars(),
+                             [{binary(), mod_mam:message_id(), binary()}],
+                             mod_mam_utils:retraction_id()) ->
     skip | retraction_info().
-decode_retraction_info(_Env, []) -> skip;
-decode_retraction_info(Env, [{ResMessID, Data}]) ->
+decode_retraction_info(_Env, [], _) -> skip;
+decode_retraction_info(Env, [{ResMessID, Data}], {origin_id, OriginID}) ->
     Packet = decode_packet(Data, Env),
     MessID = mongoose_rdbms:result_to_integer(ResMessID),
-    #{packet => Packet, message_id => MessID}.
+    #{retract_on => origin_id, packet => Packet, message_id => MessID, origin_id => OriginID};
+decode_retraction_info(Env, [{ResOriginID, Data}], {stanza_id, StanzaID}) ->
+    Packet = decode_packet(Data, Env),
+    OriginID = unescape_binary(ResOriginID, Env),
+    MessID = mod_mam_utils:external_binary_to_mess_id(StanzaID),
+    #{retract_on => stanza_id, packet => Packet, message_id => MessID, origin_id => OriginID}.
 
 -spec decode_jid(binary(), env_vars()) -> jid:jid().
 decode_jid(ExtJID, #{db_jid_codec := Codec, archive_jid := ArcJID}) ->

src/mam/mod_mam_muc_rdbms_arch.erl

@@ -133,7 +133,7 @@ register_prepared_queries() ->
     mongoose_rdbms:prepare(mam_muc_select_messages_to_retract_on_stanza_id, mam_muc_message,
                            [room_id, sender_id, id],
                            <<"SELECT ", LimitMSSQL/binary,
-                             " id, message FROM mam_muc_message"
+                             " origin_id, message FROM mam_muc_message"
                              " WHERE room_id = ? AND sender_id = ? "
                              " AND id = ?"
                              " ORDER BY id DESC ", LimitSQL/binary>>),
@@ -205,7 +205,7 @@ db_jid_codec(HostType, Module) ->
 db_message_codec(HostType, Module) ->
     gen_mod:get_module_opt(HostType, Module, db_message_format, mam_message_compressed_eterm).
 
--spec get_retract_id(exml:element(), env_vars()) -> none | {origin_id | stanza_id, binary()}.
+-spec get_retract_id(exml:element(), env_vars()) -> none | mod_mam_utils:retraction_id().
 get_retract_id(Packet, #{has_message_retraction := Enabled}) ->
     mod_mam_utils:get_retract_id(Enabled, Packet).
 
@@ -257,24 +257,24 @@ retract_message(HostType, #{archive_id := ArcID, sender_id := SenderID,
                             packet := Packet}, Env) ->
     case get_retract_id(Packet, Env) of
         none -> ok;
-        RetractionInfo ->
-            Info = get_retraction_info(HostType, ArcID, SenderID, RetractionInfo, Env),
-            make_tombstone(HostType, ArcID, RetractionInfo, Info, Env)
+        RetractionId ->
+            Info = get_retraction_info(HostType, ArcID, SenderID, RetractionId, Env),
+            make_tombstone(HostType, ArcID, RetractionId, Info, Env)
     end.
 
-get_retraction_info(HostType, ArcID, SenderID, RetractionInfo, Env) ->
+get_retraction_info(HostType, ArcID, SenderID, RetractionId, Env) ->
     {selected, Rows} =
-        execute_select_messages_to_retract(HostType, ArcID, SenderID, RetractionInfo),
-    mam_decoder:decode_retraction_info(Env, Rows).
+        execute_select_messages_to_retract(HostType, ArcID, SenderID, RetractionId),
+    mam_decoder:decode_retraction_info(Env, Rows, RetractionId).
 
-make_tombstone(_HostType, ArcID, RetractionInfo, skip, _Env) ->
+make_tombstone(_HostType, ArcID, RetractionId, skip, _Env) ->
     ?LOG_INFO(#{what => make_tombstone_failed,
                 text => <<"Message to retract was not found">>,
-                user_id => ArcID, retraction_context => RetractionInfo});
-make_tombstone(HostType, ArcID, RetractionInfo,
-               #{packet := Packet, message_id := MessID},
+                user_id => ArcID, retraction_context => RetractionId});
+make_tombstone(HostType, ArcID, _RetractionId,
+               RetractionInfo = #{message_id := MessID},
                #{archive_jid := ArcJID} = Env) ->
-    Tombstone = mod_mam_utils:tombstone(Packet, RetractionInfo, ArcJID),
+    Tombstone = mod_mam_utils:tombstone(RetractionInfo, ArcJID),
     TombstoneData = mam_encoder:encode_packet(Tombstone, Env),
     execute_make_tombstone(HostType, TombstoneData, ArcID, MessID).
 

src/mam/mod_mam_rdbms_arch.erl

@@ -157,7 +157,7 @@ register_prepared_queries() ->
     mongoose_rdbms:prepare(mam_select_messages_to_retract_on_stanza_id, mam_message,
                            [user_id, remote_bare_jid, id, direction],
                            <<"SELECT ", LimitMSSQL/binary,
-                             " id, message FROM mam_message"
+                             " origin_id, message FROM mam_message"
                              " WHERE user_id = ? AND remote_bare_jid = ? "
                              " AND id = ? AND direction = ?"
                              " ORDER BY id DESC ", LimitSQL/binary>>).
@@ -237,7 +237,7 @@ db_jid_codec(HostType, Module) ->
 db_message_codec(HostType, Module) ->
     gen_mod:get_module_opt(HostType, Module, db_message_format, mam_message_compressed_eterm).
 
--spec get_retract_id(exml:element(), env_vars()) -> none | {origin_id | stanza_id, binary()}.
+-spec get_retract_id(exml:element(), env_vars()) -> none | mod_mam_utils:retraction_id().
 get_retract_id(Packet, #{has_message_retraction := Enabled}) ->
     mod_mam_utils:get_retract_id(Enabled, Packet).
 
@@ -283,29 +283,29 @@ retract_message(HostType, #{archive_id := ArcID, remote_jid := RemJID,
                             direction := Dir, packet := Packet}, Env) ->
     case get_retract_id(Packet, Env) of
         none -> ok;
-        RetractionInfo ->
-            Info = get_retraction_info(HostType, ArcID, RemJID, RetractionInfo, Dir, Env),
-            make_tombstone(HostType, ArcID, RetractionInfo, Info, Env)
+        RetractionId ->
+            Info = get_retraction_info(HostType, ArcID, RemJID, RetractionId, Dir, Env),
+            make_tombstone(HostType, ArcID, RetractionId, Info, Env)
     end.
 
-get_retraction_info(HostType, ArcID, RemJID, RetractionInfo, Dir, Env) ->
+get_retraction_info(HostType, ArcID, RemJID, RetractionId, Dir, Env) ->
     %% Code style notice:
     %% - Add Ext prefix for all externally encoded data
     %% (in cases, when we usually add Bin, B, S Esc prefixes)
     ExtBareRemJID = mam_encoder:encode_jid(jid:to_bare(RemJID), Env),
     ExtDir = mam_encoder:encode_direction(Dir),
     {selected, Rows} = execute_select_messages_to_retract(
-                         HostType, ArcID, ExtBareRemJID, RetractionInfo, ExtDir),
-    mam_decoder:decode_retraction_info(Env, Rows).
+                         HostType, ArcID, ExtBareRemJID, RetractionId, ExtDir),
+    mam_decoder:decode_retraction_info(Env, Rows, RetractionId).
 
-make_tombstone(_HostType, ArcID, RetractionInfo, skip, _Env) ->
+make_tombstone(_HostType, ArcID, RetractionId, skip, _Env) ->
     ?LOG_INFO(#{what => make_tombstone_failed,
                 text => <<"Message to retract was not found">>,
-                user_id => ArcID, retraction_context => RetractionInfo});
-make_tombstone(HostType, ArcID, RetractionInfo,
-               #{packet := Packet, message_id := MessID},
+                user_id => ArcID, retraction_context => RetractionId});
+make_tombstone(HostType, ArcID, _RetractionId,
+               RetractionInfo = #{message_id := MessID},
                #{archive_jid := ArcJID} = Env) ->
-    Tombstone = mod_mam_utils:tombstone(Packet, RetractionInfo, ArcJID),
+    Tombstone = mod_mam_utils:tombstone(RetractionInfo, ArcJID),
     TombstoneData = mam_encoder:encode_packet(Tombstone, Env),
     execute_make_tombstone(HostType, TombstoneData, ArcID, MessID).
 

src/mam/mod_mam_utils.erl

@@ -33,7 +33,7 @@
          has_message_retraction/2,
          get_retract_id/2,
          get_origin_id/1,
-         tombstone/3,
+         tombstone/2,
          wrap_message/6,
          wrap_message/7,
          result_set/4,
@@ -133,6 +133,8 @@
 
 -define(MAYBE_BIN(X), (is_binary(X) orelse (X) =:= undefined)).
 
+-export_type([retraction_id/0]).
+
 %% Constants
 rsm_ns_binary() -> <<"http://jabber.org/protocol/rsm">>.
 
@@ -147,6 +149,7 @@ rsm_ns_binary() -> <<"http://jabber.org/protocol/rsm">>.
 -type archive_behaviour() :: mod_mam:archive_behaviour().
 -type archive_behaviour_bin() :: binary(). % `<<"roster">> | <<"always">> | <<"never">>'.
 
+-type retraction_id() :: {origin_id | stanza_id, binary()}.
 
 %% -----------------------------------------------------------------------
 %% Time
@@ -370,13 +373,13 @@ has_chat_marker(Packet) ->
     mongoose_chat_markers:has_chat_markers(Packet).
 
 -spec get_retract_id(false, exml:element()) -> none;
-                    (true, exml:element()) -> none | {origin_id | stanza_id, binary()}.
+                    (true, exml:element()) -> none | retraction_id().
 get_retract_id(true = _Enabled, Packet) ->
     get_retract_id(Packet);
 get_retract_id(false, _Packet) ->
     none.
 
--spec get_retract_id(exml:element()) -> none | {origin_id | stanza_id, binary()}.
+-spec get_retract_id(exml:element()) -> none | retraction_id().
 get_retract_id(Packet) ->
     case exml_query:path(Packet, [{element_with_ns, <<"apply-to">>, ?NS_FASTEN},
                                   {element, <<"retract">>},
@@ -396,10 +399,11 @@ get_origin_id(Packet) ->
     exml_query:path(Packet, [{element_with_ns, <<"origin-id">>, ?NS_STANZAID},
                              {attr, <<"id">>}], none).
 
-tombstone(Packet, RetractionInfo, LocJid) ->
+tombstone(RetractionInfo = #{packet := Packet}, LocJid) ->
     Packet#xmlel{children = [retracted_element(RetractionInfo, LocJid)]}.
 
-retracted_element({origin_id, OriginID}, _LocJid) ->
+retracted_element(#{retract_on := origin_id,
+                    origin_id := OriginID}, _LocJid) ->
     Timestamp = calendar:system_time_to_rfc3339(erlang:system_time(second), [{offset, "Z"}]),
     #xmlel{name = <<"retracted">>,
            attrs = [{<<"xmlns">>, ?NS_RETRACT},
@@ -408,17 +412,26 @@ retracted_element({origin_id, OriginID}, _LocJid) ->
                               attrs = [{<<"xmlns">>, ?NS_STANZAID},
                                        {<<"id">>, OriginID}]}
                       ]};
-retracted_element({stanza_id, StanzaId}, LocJid) ->
+retracted_element(#{retract_on := stanza_id,
+                    message_id := MessID} = Env, LocJid) ->
     Timestamp = calendar:system_time_to_rfc3339(erlang:system_time(second), [{offset, "Z"}]),
+    StanzaID = mod_mam_utils:mess_id_to_external_binary(MessID),
+    MaybeOriginId = maybe_append_origin_id(Env),
     #xmlel{name = <<"retracted">>,
            attrs = [{<<"xmlns">>, ?NS_ESL_RETRACT},
                     {<<"stamp">>, list_to_binary(Timestamp)}],
            children = [#xmlel{name = <<"stanza-id">>,
                               attrs = [{<<"xmlns">>, ?NS_STANZAID},
-                                       {<<"id">>, StanzaId},
-                                       {<<"by">>, jid:to_binary(jid:to_bare(LocJid))}]}
+                                       {<<"id">>, StanzaID},
+                                       {<<"by">>, jid:to_binary(jid:to_bare(LocJid))}]} |
+                       MaybeOriginId
                       ]}.
 
+maybe_append_origin_id(#{origin_id := <<>>}) ->
+    [];
+maybe_append_origin_id(#{origin_id := OriginID}) ->
+    [#xmlel{name = <<"origin-id">>, attrs = [{<<"xmlns">>, ?NS_STANZAID}, {<<"id">>, OriginID}]}].
+
 %% @doc Forms `<forwarded/>' element, according to the XEP.
 -spec wrap_message(MamNs :: binary(), Packet :: exml:element(), QueryID :: binary(),
                    MessageUID :: term(), TS :: calendar:rfc3339_string(),