~singpolyma/cheogram

7b3f9c67ca403f2c3230c775012e495d5fa5550f — Stephen Paul Weber 15 days ago f91742a master
Include the command payload item along with the bot prompt
4 files changed, 45 insertions(+), 17 deletions(-)

M Adhoc.hs
M ConfigureDirectMessageRoute.hs
M JidSwitch.hs
M Main.hs
M Adhoc.hs => Adhoc.hs +1 -1
@@ 53,7 53,7 @@ botHelp _ _ = Nothing
-- This replaces certain commands that the SGX supports with our sugared versions
maskCommands :: XMPP.JID -> [Element] -> [Element]
maskCommands componentJid = map (\el ->
		if attributeText (s"node") el == Just JidSwitch.backendNodeName then
		if attributeText (s"node") el == Just ConfigureDirectMessageRoute.switchBackendNodeName then
			Element (s"{http://jabber.org/protocol/disco#items}item") [
					(s"jid", [ContentText $ formatJID componentJid ++ s"/CHEOGRAM%" ++ JidSwitch.nodeName]),
					(s"node", [ContentText JidSwitch.nodeName]),

M ConfigureDirectMessageRoute.hs => ConfigureDirectMessageRoute.hs +6 -4
@@ 1,4 1,4 @@
module ConfigureDirectMessageRoute (main, nodeName) where
module ConfigureDirectMessageRoute (main, nodeName, switchBackendNodeName) where

import Prelude ()
import BasicPrelude hiding (log)


@@ 20,7 20,9 @@ import qualified Data.Bool.HT as HT
import qualified Data.XML.Types as XML

import Util
import qualified JidSwitch

switchBackendNodeName :: Text
switchBackendNodeName = s"https://ns.cheogram.com/sgx/jid-switch"

newtype SessionID = SessionID UUID deriving (Ord, Eq, Show)



@@ 363,7 365,7 @@ switchStage2 switchJid switchRoute possibleRoute existingRoute componentDomain s
				XMPP.iqID = Just (s"ConfigureDirectMessageRoute2" ++ sessionIDToText sid),
				XMPP.iqTo = Just switchRoute,
				XMPP.iqFrom = Just $ sendFromForBackend componentDomain switchJid,
				XMPP.iqPayload = Just $ Element (s"{http://jabber.org/protocol/commands}command") [(s"node", [ContentText JidSwitch.backendNodeName])] []
				XMPP.iqPayload = Just $ Element (s"{http://jabber.org/protocol/commands}command") [(s"node", [ContentText switchBackendNodeName])] []
			}
		)
	| otherwise =


@@ 384,7 386,7 @@ switchStage3 switchJid switchRoute stage2ID stage2From componentDomain sid iqID 
				XMPP.iqFrom = Just $ sendFromForBackend componentDomain switchJid,
				XMPP.iqID = Just (s"ConfigureDirectMessageRoute3" ++ sessionIDToText sid),
				XMPP.iqPayload = Just $ Element (s"{http://jabber.org/protocol/commands}command") [
						(s"node", [ContentText JidSwitch.backendNodeName]),
						(s"node", [ContentText switchBackendNodeName]),
						(s"sessionid", [ContentText $ backendSid])
					] [
						NodeElement $ Element (fromString "{jabber:x:data}x") [

M JidSwitch.hs => JidSwitch.hs +21 -9
@@ 12,11 12,9 @@ import Util
import CommandAction
import StanzaRec

import qualified ConfigureDirectMessageRoute
import qualified DB

backendNodeName :: Text
backendNodeName = s"https://ns.cheogram.com/sgx/jid-switch"

nodeName :: Text
nodeName = s"change jabber id"



@@ 54,12 52,26 @@ receiveIq componentJid setJidSwitch iq@(XMPP.IQ { XMPP.iqFrom = Just from, XMPP.
	  Just newJid <- XMPP.parseJID =<< getFormField form (s"new-jid") = do
		(from', newJid', _) <- setJidSwitch newJid
		return [
			mkStanzaRec $ mkSMS componentJid newJid $ concat [
				bareTxt from',
				s" has requested a Jabber ID change to ",
				bareTxt newJid',
				s". To complete this request send \"register\""
			],
			mkStanzaRec $ (XMPP.emptyMessage XMPP.MessageChat) {
				XMPP.messageTo = Just newJid,
				XMPP.messageFrom = Just componentJid,
				XMPP.messagePayloads = [
					mkElement (s"{jabber:component:accept}body") $ concat [
						bareTxt from',
						s" has requested a Jabber ID change to ",
						bareTxt newJid',
						s". To complete this request send \"register\""
					],
					Element (s"{http://jabber.org/protocol/disco#items}query")
						[(s"node", [ContentText $ s"http://jabber.org/protocol/commands"])] [
							NodeElement $ Element (s"{http://jabber.org/protocol/disco#items}item") [
								(s"jid", [ContentText $ XMPP.formatJID componentJid ++ s"/CHEOGRAM%" ++ ConfigureDirectMessageRoute.nodeName]),
								(s"node", [ContentText ConfigureDirectMessageRoute.nodeName]),
								(s"name", [ContentText $ s"register"])
							] []
						]
				]
			},
			mkStanzaRec $ flip iqReply iq $ Just $ commandStage sid [] (s"completed") [
				Element (s"{http://jabber.org/protocol/commands}note") [
					(s"{http://jabber.org/protocol/commands}type", [ContentText $ s"info"])

M Main.hs => Main.hs +17 -3
@@ 993,9 993,23 @@ componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ iq@(IQ { iqT
						]
					]
				) iq,
				mkStanzaRec $ mkSMS componentJid pushRegisterTo $
					s"To start registration with " ++ XMPP.formatJID from ++ s" reply with: register " ++ XMPP.formatJID from ++
					s"\n(If you do not wish to start this registration, simply ignore this message.)"
				mkStanzaRec $ (XMPP.emptyMessage XMPP.MessageChat) {
					XMPP.messageTo = Just pushRegisterTo,
					XMPP.messageFrom = Just componentJid,
					XMPP.messagePayloads = [
						mkElement (s"{jabber:component:accept}body") $
							s"To start registration with " ++ XMPP.formatJID from ++ s" reply with: register " ++ XMPP.formatJID from ++
							s"\n(If you do not wish to start this registration, simply ignore this message.)",
						Element (s"{http://jabber.org/protocol/disco#items}query")
							[(s"node", [ContentText $ s"http://jabber.org/protocol/commands"])] [
								NodeElement $ Element (s"{http://jabber.org/protocol/disco#items}item") [
									(s"jid", [ContentText $ formatJID componentJid ++ s"/CHEOGRAM%" ++ ConfigureDirectMessageRoute.nodeName]),
									(s"node", [ContentText ConfigureDirectMessageRoute.nodeName]),
									(s"name", [ContentText $ s"register " ++ XMPP.formatJID from])
								] []
							]
					]
				}
			]
componentStanza (ComponentContext { db, componentJid }) (ReceivedIQ iq@(IQ { iqFrom = Just _, iqTo = Just (JID { jidNode = Nothing }), iqPayload = Just p }))
	| iqType iq `elem` [IQGet, IQSet],