~singpolyma/cheogram: Support passing through messages from alphanumeric senders

da853b0b9982dc63290066f939ef4b85c5dec839 — Stephen Paul Weber 1 year, 5 months ago 45718aa

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.

patch browse .tar.gz

2 files changed, 19 insertions(+), 0 deletions(-)

M Main.hs
M Util.hs

M Main.hs => Main.hs +9 -0

@@ 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")

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

@@ 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