2 files changed, 53 insertions(+), 5 deletions(-)

M Session.hs
M gateway.hs

@@ 2,6 2,10 @@ module Session where
 
 import Prelude ()
 import BasicPrelude
+import Control.Applicative (many)
+import qualified Data.Attoparsec.Text  as Atto hiding (Parser)
+import qualified Data.Attoparsec.Internal.Types as Atto
+import qualified Data.Text             as T
 import qualified Database.SQLite.Simple as DB
 import qualified Data.XML.Types        as XML
 import qualified Network.Protocol.XMPP as XMPP


@@ 59,3 63,50 @@ sendPresence config presence@XMPP.Presence {
 	target = maybeAddNick targetMuc (fromNick ++ s"[x]")
 	fromNick = XMPP.strResource fromResource
 sendPresence _ _ _ = return ()
+
+startOfInput :: Atto.Parser t ()
+startOfInput = Atto.Parser $ \t pos more lose suc ->
+	if pos == 0 then
+		suc t pos more ()
+	else
+		lose t pos more [] "startOfInput"
+
+replaceWords :: [(Text, Text)] -> Text -> Text
+replaceWords replacements txt = mconcat result
+	where
+	wordClass = "A-Za-z0-9_"
+	boundary =
+		(startOfInput *> pure mempty) <|>
+		(Atto.endOfInput *> pure mempty) <|>
+		(T.singleton <$> Atto.satisfy (Atto.notInClass wordClass))
+	replacement word newWord = mconcat <$> (
+		(:) <$> boundary <*> (
+			(:) <$> (Atto.string word *> pure newWord) <*>
+			((:) <$> boundary <*> pure [])
+		))
+	Right result = Atto.parseOnly (many (
+			foldr (<|>) (T.singleton <$> Atto.anyChar) (uncurry replacement <$> replacements)
+		) <* Atto.endOfInput) txt
+
+sendGroupChat :: Config.Config -> XMPP.Message -> XMPP.JID -> XMPP.XMPP ()
+sendGroupChat config message@XMPP.Message {
+	XMPP.messageFrom = Just from,
+	XMPP.messagePayloads = payloads
+} target = do
+		nickSwaps1 <- liftIO $ DB.query (Config.db config) (s"SELECT target_nick, source_nick FROM sessions WHERE source_muc=?") (DB.Only $ bareTxt target)
+		nickSwaps2 <- liftIO $ DB.query (Config.db config) (s"SELECT source_nick, target_nick FROM sessions WHERE target_muc=? AND source_muc IS NOT NULL") (DB.Only $ bareTxt target)
+		XMPP.putStanza $ message {
+			XMPP.messageFrom = Just (proxyJid config from),
+			XMPP.messageTo = Just target,
+			XMPP.messagePayloads = map (\el ->
+				case XML.isNamed (s"{jabber:component:accept}body") el of
+					[body] ->
+						body { XML.elementNodes = [
+							XML.NodeContent $ XML.ContentText $
+								replaceWords (nickSwaps1 ++ nickSwaps2)
+								(mconcat (XML.elementText body))
+						]}
+					_ -> el
+			) payloads
+		}
+sendGroupChat _ _ _ = return ()

@@ 77,11 77,8 @@ handleGroupChat config message@XMPP.Message {
 	| bareTxt to /= bareTxt (Config.bridgeJid config) =
 		-- This is to one of our ghosts, so just ignore it
 		return ()
-	| otherwise = forM_ (targets config from) $ \target ->
-		XMPP.putStanza $ message {
-			XMPP.messageFrom = Just (proxyJid config from),
-			XMPP.messageTo = Just target
-		}
+	| otherwise = forM_ (targets config from) $
+		Session.sendGroupChat config message
 handleGroupChat _ _ = return ()
 
 handleMessage :: Config.Config -> XMPP.Message -> XMPP.XMPP ()