~singpolyma/cheogram-smtp: Fix namespaces on attributes

4 files changed, 27 insertions(+), 41 deletions(-)

M Email.hs
M Util.hs
M gateway.hs
M test/EmailTest.hs

M Email.hs => Email.hs +3 -5

@@ 108,7 108,7 @@ emailToOriginID email = fmap originID $ hush . MIME.parse messageID =<<
 	firstOf (MIME.headers . MIME.header (s"message-id")) email
 	where
 	originID msgid = XML.Element (s"{urn:xmpp:sid:0}origin-id")
-		[(s"{urn:xmpp:sid:0}id", [XML.ContentText msgid])] []
+		[(s"id", [XML.ContentText msgid])] []
 
 extractThreadFromRef :: Text -> Atto.Parser Text
 extractThreadFromRef domain = mfilter (/= s"\0") $ fmap equalsDecode $


@@ 153,9 153,7 @@ emailToThread domain email = thread <&> \threadID ->
 	where
 	parent =
 		maybeToList $
-		fmap (
-			(,) (s"{jabber:component:accept}parent") .
-			(:[]) . XML.ContentText
+		fmap ((,) (s"parent") . (:[]) . XML.ContentText
 		)
 		(hush . MIME.parse (extractThreadFromRefs domain) =<< refs)
 	thread = fmap (s"References: "++) $


@@ 288,7 286,7 @@ messageToEmail fromDomain now message@XMPP.Message {
 	refs = mkReferences message
 	jidHeader = Just $ MIME.encodeEncodedWords (bareTxt from)
 	dateHeader = fromMaybe now $ parseXMPPTime =<<
-		XML.attributeText (s"{urn:xmpp:delay}stamp") =<<
+		XML.attributeText (s"stamp") =<<
 		child (s"{urn:xmpp:delay}delay") message
 	subjectHeader = MIME.encodeEncodedWords <$>
 		(getSubject message <|> defaultSubject message)

M Util.hs => Util.hs +5 -17

@@ 132,7 132,7 @@ getSubject = fmap (mconcat . XML.elementText) .
 errorPayload :: String -> String -> Text -> [XML.Node] -> XML.Element
 errorPayload typ definedCondition english morePayload =
 	XML.Element (s"{jabber:component:accept}error")
-	[(s"{jabber:component:accept}type", [XML.ContentText $ fromString typ])]
+	[(s"type", [XML.ContentText $ fromString typ])]
 	(
 		(
 			XML.NodeElement $ XML.Element definedConditionName [] []


@@ 168,27 168,15 @@ mkElement name content = XML.Element name []
 mkDiscoIdentity :: Text -> Text -> Text -> XML.Element
 mkDiscoIdentity category typ name =
 	XML.Element (s"{http://jabber.org/protocol/disco#info}identity") [
-		(
-			s"{http://jabber.org/protocol/disco#info}category",
-			[XML.ContentText category]
-		),
-		(
-			s"{http://jabber.org/protocol/disco#info}type",
-			[XML.ContentText typ]
-		),
-		(
-			s"{http://jabber.org/protocol/disco#info}name",
-			[XML.ContentText name]
-		)
+		(s"category", [XML.ContentText category]),
+		(s"type", [XML.ContentText typ]),
+		(s"name", [XML.ContentText name])
 	] []
 
 mkDiscoFeature :: Text -> XML.Element
 mkDiscoFeature var =
 	XML.Element (s"{http://jabber.org/protocol/disco#info}feature") [
-		(
-			s"{http://jabber.org/protocol/disco#info}var",
-			[XML.ContentText var]
-		)
+		(s"var", [XML.ContentText var])
 	] []
 
 (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d

M gateway.hs => gateway.hs +10 -10

@@ 30,15 30,11 @@ newtype RawComponentStanza = RawComponentStanza XML.Element
 
 instance XMPP.Stanza RawComponentStanza where
 	stanzaTo (RawComponentStanza el) =
-		XMPP.parseJID =<<
-		XML.attributeText (s"{jabber:component:accept}to") el
+		XMPP.parseJID =<< XML.attributeText (s"to") el
 	stanzaFrom (RawComponentStanza el) =
-		XMPP.parseJID =<<
-		XML.attributeText (s"{jabber:component:accept}from") el
-	stanzaID (RawComponentStanza el) =
-		XML.attributeText (s"{jabber:component:accept}id") el
-	stanzaLang (RawComponentStanza el) =
-		XML.attributeText (s"xml:lang") el
+		XMPP.parseJID =<< XML.attributeText (s"from") el
+	stanzaID (RawComponentStanza el) = XML.attributeText (s"id") el
+	stanzaLang (RawComponentStanza el) = XML.attributeText (s"xml:lang") el
 	stanzaPayloads (RawComponentStanza el) = XML.elementChildren el
 	stanzaToElement (RawComponentStanza el) = el
 


@@ 49,7 45,7 @@ defaultMessageError = errorPayload "cancel" "undefined-condition"
 overrideID :: Text -> XML.Element -> XML.Element
 overrideID newID el = el {
 	XML.elementAttributes =
-		(s"{jabber:component:accept}id", [XML.ContentText newID]) :
+		(s"id", [XML.ContentText newID]) :
 		XML.elementAttributes el
 }
 


@@ 142,11 138,15 @@ iqGetHandler iq@XMPP.IQ {
 } | Nothing <- XMPP.jidNode to,
     [_] <- XML.isNamed (s"{http://jabber.org/protocol/disco#info}query") p =
 	XMPP.putStanza $ iqReply (Just $ XML.Element
-		(s"{http://jabber.org/protocol/disco#info}query") [] [
+		(s"{http://jabber.org/protocol/disco#info}query")
+		(maybeToList nodeAttribute) [
 			XML.NodeElement $ mkDiscoIdentity
 				(s"gateway") (s"smtp") (s"Cheogram SMTP")
 		]
 	) iq
+	where
+	nodeAttribute = fmap (\node -> (s"node", [XML.ContentText node])) $
+		XML.attributeText (s"node") p
 iqGetHandler iq = XMPP.putStanza $ iqError notImplemented iq
 
 main :: IO ()

M test/EmailTest.hs => test/EmailTest.hs +9 -9

@@ 59,7 59,7 @@ unit_emailToStanzaSimple =
 				XML.NodeContent $ XML.ContentText $ s"Human"
 			],
 			XML.Element (s"{urn:xmpp:sid:0}origin-id") [(
-				s"{urn:xmpp:sid:0}id",
+				s"id",
 				[XML.ContentText $ s"boop-id@ids.example.com"]
 			)] [],
 			XML.Element (s"{jabber:component:accept}thread") [] [


@@ 183,11 183,11 @@ unit_emailToStanzaReply =
 				XML.NodeContent $ XML.ContentText $ s"subject"
 			],
 			XML.Element (s"{urn:xmpp:sid:0}origin-id") [(
-				s"{urn:xmpp:sid:0}id",
+				s"id",
 				[XML.ContentText $ s"abc@example.com"]
 			)] [],
 			XML.Element (s"{jabber:component:accept}thread") [(
-				s"{jabber:component:accept}parent",
+				s"parent",
 				[XML.ContentText $ s"athread"]
 			)] [
 				XML.NodeContent $ XML.ContentText $


@@ 222,7 222,7 @@ unit_emailToStanzaReplyNulThread =
 				XML.NodeContent $ XML.ContentText $ s"subject"
 			],
 			XML.Element (s"{urn:xmpp:sid:0}origin-id") [(
-				s"{urn:xmpp:sid:0}id",
+				s"id",
 				[XML.ContentText $ s"abc@example.com"]
 			)] [],
 			XML.Element (s"{jabber:component:accept}thread") [] [


@@ 258,11 258,11 @@ unit_emailToStanzaDeepReply =
 				XML.NodeContent $ XML.ContentText $ s"subject"
 			],
 			XML.Element (s"{urn:xmpp:sid:0}origin-id") [(
-				s"{urn:xmpp:sid:0}id",
+				s"id",
 				[XML.ContentText $ s"abc@example.com"]
 			)] [],
 			XML.Element (s"{jabber:component:accept}thread") [(
-				s"{jabber:component:accept}parent",
+				s"parent",
 				[XML.ContentText $ s"References: <1583335391.\
 					\7d84bbbf-4dd8-42f7-81cc-d7f4ffa06609.\
 					\exBUAYVLbCAwUgAUpONVhfirfwVfAUZf\


@@ 318,11 318,11 @@ unit_emailToStanzaDeepInReplyTo =
 				XML.NodeContent $ XML.ContentText $ s"subject"
 			],
 			XML.Element (s"{urn:xmpp:sid:0}origin-id") [(
-				s"{urn:xmpp:sid:0}id",
+				s"id",
 				[XML.ContentText $ s"abc@example.com"]
 			)] [],
 			XML.Element (s"{jabber:component:accept}thread") [(
-				s"{jabber:component:accept}parent",
+				s"parent",
 				[XML.ContentText $ s"References: <1583335391.\
 					\7d84bbbf-4dd8-42f7-81cc-d7f4ffa06609.\
 					\exBUAYVLbCAwUgAUpONVhfirfwVfAUZf\


@@ 474,7 474,7 @@ unit_messageToEmailWithDelay =
 		XMPP.messageFrom = XMPP.parseJID $ s"f@example.com",
 		XMPP.messagePayloads = [
 			XML.Element (s"{urn:xmpp:delay}delay") [(
-				s"{urn:xmpp:delay}stamp",
+				s"stamp",
 				[XML.ContentText $ s"2009-02-22T00:10:00Z"]
 			)] [],
 			XML.Element (s"{jabber:component:accept}body")