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