~singpolyma/cheogram

324c6163bf77a35f7ab0173664bc66091bdbb7f3 — Stephen Paul Weber 1 year, 12 days ago 6d0162f
Try adding markable to messages

Causing clients to send a message when the message is viewed, which goes into
mam/carbons for other clients to see the current read position for syncing read
status.
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