~singpolyma/cheogram: Try adding markable to messages

2 files changed, 7 insertions(+), 2 deletions(-)

M Main.hs
M Util.hs

M Main.hs => Main.hs +2 -2

@@ 684,7 684,7 @@ componentStanza (ComponentContext { db, adhocBotMessage, ctxCacheOOB, componentJ
 	| Just _ <- groupTextPorcelein (formatJID componentJid) m = do
 		-- TODO: only when from direct message route
 		-- TODO: only if target does not understand stanza addressing
-		Just reply <- fmap (groupTextPorcelein (formatJID componentJid)) $ UIO.lift $ ctxCacheOOB (Just . addOOBFallbackBody) True m
+		Just reply <- fmap (groupTextPorcelein (formatJID componentJid)) $ fmap addMarkable $ UIO.lift $ ctxCacheOOB (Just . addOOBFallbackBody) True m
 		let mBody = fromMaybe mempty $ getBody "jabber:component:accept" m
 		let replyBody = fromMaybe mempty $ getBody "jabber:component:accept" reply
 		reply' <- rememberIncomingBody db (mapBody (const mBody) reply)


@@ 1560,7 1560,7 @@ component db redis pushStatsd backendHost did maybeAvatar cacheOOB sendIQ iqRece
 							  Just from' <- XMPP.parseJID $ (intercalate (s",") $ sort $ mapMaybe (T.stripPrefix (s"sms:") <=< XML.attributeText (s"uri")) (isNamed (s"{http://jabber.org/protocol/address}address") =<< elementChildren addresses)) ++ s"@" ++ formatJID componentJid ->
 								sendToComponent $ receivedStanza $ receivedStanzaFromTo from' routeTo stanza
 							| route == strDomain (jidDomain from) ->
-								(sendToComponent . receivedStanza) =<< mapReceivedMessageM (UIO.lift . (rememberIncomingBody db <=< cacheOOB (Just . addOOBFallbackBody) True)) (receivedStanzaFromTo componentFrom routeTo stanza)
+								(sendToComponent . receivedStanza) =<< mapReceivedMessageM (fmap addMarkable . UIO.lift . (rememberIncomingBody db <=< cacheOOB (Just . addOOBFallbackBody) True)) (receivedStanzaFromTo componentFrom routeTo stanza)
 						(Just route, _) -- Alphanumeric senders
 							| route == strDomain (jidDomain from),
 							  Just localpart <- strNode <$> jidNode from,

M Util.hs => Util.hs +5 -0

@@ 270,6 270,11 @@ addNickname nick m@(XMPP.Message { XMPP.messagePayloads = p }) = m {
 		XMPP.messagePayloads = (nickname nick) : p
 	}
 
+addMarkable :: XMPP.Message -> XMPP.Message
+addMarkable m@(XMPP.Message { XMPP.messagePayloads = p }) = m {
+		XMPP.messagePayloads = (XML.Element (s"{urn:xmpp:chat-markers:0}markable") [] []) : p
+	}
+
 mapReceivedMessageM :: (Applicative f) =>
 	  (XMPP.Message -> f XMPP.Message)
 	-> XMPP.ReceivedStanza