From 5021381ab314bc0356dfc50f152be395090c3764 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Thu, 16 Feb 2017 19:52:01 -0500
Subject: [PATCH] Route direct messages if route exists

---
 Main.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/Main.hs b/Main.hs
index ae49de2..1b52304 100644
--- a/Main.hs
+++ b/Main.hs
@@ -176,11 +176,23 @@ componentMessage _ componentJid (m@Message { messageType = MessageGroupChat }) e
 		return []
 	where
 	txt = mconcat [fromString "(", fromMaybe (fromString "nonick") resourceFrom, fromString ") ", body]
-componentMessage db componentJid (Message { messageFrom = Just from }) existingRoom _ _ smsJid (Just body) = do
+componentMessage db componentJid m@(Message { messageFrom = Just from }) existingRoom bareFrom resourceFrom smsJid (Just body) = do
 	log "WHISPER" (from, smsJid, body)
-	nick <- nickFor db from existingRoom
-	let txt = mconcat [fromString "(", nick, fromString " whispers) ", body]
-	return [mkStanzaRec $ mkSMS componentJid smsJid txt]
+
+	maybeRoute <- TC.runTCM $ TC.get db (T.unpack (bareTxt from) ++ "\0direct-message-route")
+	case (fmap fromString maybeRoute, parseJID $ escapeJid bareFrom ++ s"@" ++ formatJID componentJid ++ resourceSuffix) of
+		(Just route, Just routeFrom) -> do
+			log "WHISPER ROUTE" route
+			return [mkStanzaRec $ m {
+				messageFrom = Just routeFrom,
+				messageTo = parseJID $ (fromMaybe mempty $ strNode <$> jidNode smsJid) ++ s"@" ++ route
+			}]
+		_ -> do
+			nick <- nickFor db from existingRoom
+			let txt = mconcat [fromString "(", nick, fromString " whispers) ", body]
+			return [mkStanzaRec $ mkSMS componentJid smsJid txt]
+	where
+	resourceSuffix = maybe mempty (s"/"++) resourceFrom
 componentMessage _ _ m _ _ _ _ _ = do
 	log "UNKNOWN MESSAGE" m
 	return []
-- 
2.45.2