From da853b0b9982dc63290066f939ef4b85c5dec839 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 27 Dec 2021 22:31:12 -0500
Subject: [PATCH] Support passing through messages from alphanumeric senders

Some countries support these one-way SMS senders that come from ascii
alphanum+space senders.  All known SGX pass those through raw as the localpart,
so why not just allow them to and fix it up in Cheogram, since that's our whole
job is to make the SGX author's life easier.

Converts to Base10 (https://wiki.soprani.ca/TextEncodingBase10) and appends a
suitable phone-context.  Don't need to specially handle replies since these are
one-way senders anyway so any reply attempt will fail.  Adds the original
localpart as a nickname so that clients can show it rather than the Base10 gunk.
---
 Main.hs |  9 +++++++++
 Util.hs | 10 ++++++++++
 2 files changed, 19 insertions(+)

diff --git a/Main.hs b/Main.hs
index ec15000..ab99a8c 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1373,6 +1373,15 @@ component db redis pushStatsd backendHost did maybeAvatar cacheOOB sendIQ iqRece
 					case (maybeRoute, mapToComponent from) of
 						(Just route, Just componentFrom) | route == strDomain (jidDomain from) ->
 							(sendToComponent . receivedStanza) =<< mapReceivedMessageM (UIO.lift . cacheOOB) (receivedStanzaFromTo componentFrom routeTo stanza)
+						(Just route, _) -- Alphanumeric senders
+							| route == strDomain (jidDomain from),
+							  Just localpart <- strNode <$> jidNode from,
+							  Nothing <- T.find (\c -> not ((isAlphaNum c || c == ' ') && isAscii c)) localpart ->
+								let
+									localpart' = T.concatMap (\c -> tshow (ord c - 30)) localpart ++ s";phone-context=alphanumeric.phone-context.soprani.ca"
+									Just componentFrom = parseJID (localpart' ++ s"@" ++ formatJID componentJid)
+								in
+								(sendToComponent . receivedStanza) =<< mapReceivedMessageM (fmap (addNickname localpart) . UIO.lift . cacheOOB) (receivedStanzaFromTo componentFrom routeTo stanza)
 						_ | Just jid <- (`telToJid` formatJID componentJid) =<< strNode <$> jidNode to -> do
 							sendToComponent $ stanzaError stanza $
 								Element (fromString "{jabber:component:accept}error")
diff --git a/Util.hs b/Util.hs
index 67bf878..d354d8f 100644
--- a/Util.hs
+++ b/Util.hs
@@ -247,6 +247,16 @@ forkFinallyXMPP kid handler = do
 mkElement :: XML.Name -> Text -> XML.Element
 mkElement name txt = XML.Element name [] [XML.NodeContent $ XML.ContentText txt]
 
+nickname :: Text -> XML.Element
+nickname nick = XML.Element (s"{http://jabber.org/protocol/nick}nick") [] [
+		XML.NodeContent $ XML.ContentText nick
+	]
+
+addNickname :: Text -> XMPP.Message -> XMPP.Message
+addNickname nick m@(XMPP.Message { XMPP.messagePayloads = p }) = m {
+		XMPP.messagePayloads = (nickname nick) : p
+	}
+
 mapReceivedMessageM :: (Applicative f) =>
 	  (XMPP.Message -> f XMPP.Message)
 	-> XMPP.ReceivedStanza
-- 
2.34.5