~psycotica0/sgx-dummy

24d4749f3b3fba7c84db989231b3eac17ad8ddb6 — Christopher Vollick 1 year, 3 days ago b474688
Test Commands

I'm doing a thing with ad hoc commands, but it's hard to test if there aren't
any actual commands to run.

So, I've pulled these commands from the spec and don't the bare minimum to make
it look like they may be doing something.
1 files changed, 131 insertions(+), 0 deletions(-)

M gateway.lhs
M gateway.lhs => gateway.lhs +131 -0
@@ 103,6 103,76 @@ And tell the user they're done so they can close their window.
>				]
>			]

Command List

> handleRegister (XMPP.ReceivedIQ iq@XMPP.IQ {
> 	XMPP.iqType = XMPP.IQGet,
> 	XMPP.iqTo = Just XMPP.JID { XMPP.jidNode = Nothing },
> 	XMPP.iqPayload = Just p
> })
> 	| [_] <- XML.isNamed (s"{http://jabber.org/protocol/disco#items}query") =<< XML.hasAttributeText (s"node") (s"http://jabber.org/protocol/commands" ==) p,
> 	  Just to <- XMPP.iqTo iq
> 		= XMPP.putStanza $ iqReply iq $ Just $
> 			XML.Element (s"{http://jabber.org/protocol/disco#items}query") [(s"node", [s"http://jabber.org/protocol/commands"])] [
> 				XML.NodeElement $ XML.Element (s"item") [
> 					(s"jid", [XML.ContentText $ XMPP.formatJID to]),
> 					(s"node", [s"config"]),
> 					(s"name", [s"Test Form"])
> 				] []
> 			]

Command Final Page

> handleRegister (XMPP.ReceivedIQ iq@XMPP.IQ {
> 	XMPP.iqType = XMPP.IQSet,
> 	XMPP.iqTo = Just XMPP.JID { XMPP.jidNode = Nothing },
> 	XMPP.iqPayload = Just p
> })
> 	| [command] <- XML.isNamed (s"{http://jabber.org/protocol/commands}command") =<< XML.hasAttributeText (s"node") (s"config" ==) =<< XML.hasAttributeText (s"action") (s"execute" ==) p,
> 	  [_] <- XML.hasAttributeText (s"var") (s"runlevel" ==) =<< XML.isNamed(s"{jabber:x:data}field") =<< XML.elementChildren =<< XML.isNamed(s"{jabber:x:data}x") =<< XML.elementChildren command
> 		= XMPP.putStanza $ iqReply iq $ Just $ XML.documentRoot page3

And the same if they use "complete" instead of "execute"

> handleRegister (XMPP.ReceivedIQ iq@XMPP.IQ {
> 	XMPP.iqType = XMPP.IQSet,
> 	XMPP.iqTo = Just XMPP.JID { XMPP.jidNode = Nothing },
> 	XMPP.iqPayload = Just p
> })
> 	| [command] <- XML.isNamed (s"{http://jabber.org/protocol/commands}command") =<< XML.hasAttributeText (s"node") (s"config" ==) =<< XML.hasAttributeText (s"action") (s"complete" ==) p,
> 	  [_] <- XML.hasAttributeText (s"var") (s"runlevel" ==) =<< XML.isNamed(s"{jabber:x:data}field") =<< XML.elementChildren =<< XML.isNamed(s"{jabber:x:data}x") =<< XML.elementChildren command
> 		= XMPP.putStanza $ iqReply iq $ Just $ XML.documentRoot page3

Command Page 2

> handleRegister (XMPP.ReceivedIQ iq@XMPP.IQ {
> 	XMPP.iqType = XMPP.IQSet,
> 	XMPP.iqTo = Just XMPP.JID { XMPP.jidNode = Nothing },
> 	XMPP.iqPayload = Just p
> })
> 	| [_] <- XML.isNamed (s"{http://jabber.org/protocol/commands}command") =<< XML.hasAttributeText (s"node") (s"config" ==) =<< XML.hasAttributeText (s"action") (s"next" ==) p
> 		= XMPP.putStanza $ iqReply iq $ Just $ XML.documentRoot page2

Command Page 1

> handleRegister (XMPP.ReceivedIQ iq@XMPP.IQ {
> 	XMPP.iqType = XMPP.IQSet,
> 	XMPP.iqTo = Just XMPP.JID { XMPP.jidNode = Nothing },
> 	XMPP.iqPayload = Just p
> })
> 	| [_] <- XML.isNamed (s"{http://jabber.org/protocol/commands}command") =<< XML.hasAttributeText (s"node") (s"config" ==) =<< XML.hasAttributeText (s"action") (s"execute" ==) p
> 		= XMPP.putStanza $ iqReply iq $ Just $ XML.documentRoot page1

And again, handling "previous"

> handleRegister (XMPP.ReceivedIQ iq@XMPP.IQ {
> 	XMPP.iqType = XMPP.IQSet,
> 	XMPP.iqTo = Just XMPP.JID { XMPP.jidNode = Nothing },
> 	XMPP.iqPayload = Just p
> })
> 	| [_] <- XML.isNamed (s"{http://jabber.org/protocol/commands}command") =<< XML.hasAttributeText (s"node") (s"config" ==) =<< XML.hasAttributeText (s"action") (s"prev" ==) p
> 		= XMPP.putStanza $ iqReply iq $ Just $ XML.documentRoot page1

Any other IQ we don't bother with, but should return an error so nothing gets stuck.

> handleRegister (XMPP.ReceivedIQ iq)


@@ 211,3 281,64 @@ Helper to create an XMPP error payload with basic structure most errors need fil
>	where
>	nText = s"{urn:ietf:params:xml:ns:xmpp-stanzas}text"
>	nCond = "{urn:ietf:params:xml:ns:xmpp-stanzas}" ++ definedCondition

These pages pulled from https://xmpp.org/extensions/xep-0050.html

> page1 = XML.parseText_ XML.def $ s"\
>\		  <command xmlns='http://jabber.org/protocol/commands'\
>\		           sessionid='config:20020923T213616Z-700'\
>\		           node='config'\
>\		           status='executing'>\
>\		    <actions execute='next'>\
>\		      <next/>\
>\		    </actions>\
>\		    <x xmlns='jabber:x:data' type='form'>\
>\		      <title>Configure Service</title>\
>\		      <instructions>\
>\		        Please select the service to configure.\
>\		      </instructions>\
>\		      <field var='service' label='Service' type='list-single'>\
>\		        <option><value>httpd</value></option>\
>\		        <option><value>jabberd</value></option>\
>\		        <option><value>postgresql</value></option>\
>\		      </field>\
>\		    </x>\
>\		  </command>"

> page2 = XML.parseText_ XML.def $ s"\
>\	  <command xmlns='http://jabber.org/protocol/commands'\
>\	           sessionid='config:20020923T213616Z-700'\
>\	           node='config'\
>\	           status='executing'>\
>\	    <actions execute='complete'>\
>\	      <prev/>\
>\	      <complete/>\
>\	    </actions>\
>\	    <x xmlns='jabber:x:data' type='form'>\
>\	      <title>Configure Service</title>\
>\	      <instructions>\
>\	        Please select the run modes and state for 'httpd'.\
>\	      </instructions>\
>\	      <field var='runlevel' label='Run Modes' type='list-multi'>\
>\	        <value>3</value>\
>\	        <value>5</value>\
>\	        <option label='Single-User'><value>1</value></option>\
>\	        <option label='Non-Networked Multi-User'><value>2</value></option>\
>\	        <option label='Full Multi-User'><value>3</value></option>\
>\	        <option label='X-Window'><value>5</value></option>\
>\	      </field>\
>\	      <field var='state' label='Run State' type='list-single'>\
>\	        <value>off</value>\
>\	        <option label='Active'><value>off</value></option>\
>\	        <option label='Inactive'><value>on</value></option>\
>\	      </field>\
>\	    </x>\
>\	  </command>"

> page3 = XML.parseText_ XML.def $ s"\
>\  <command xmlns='http://jabber.org/protocol/commands'\
>\           sessionid='config:20020923T213616Z-700'\
>\           node='config'\
>\           status='completed'>\
>\    <note type='info'>Service 'httpd' has been configured.</note>\
>\  </command>"