test/test-stanza.sgl

1(import (sigil test)

2 (sigil string)

3 (sigil xmpp stanza))

5;; ============================================================

6;; JID Handling

7;; ============================================================

9(test-group "jid-parsing"

10 (test "full JID"

11 (let ((j (parse-jid "[email protected]/bot")))

12 (assert-equal "user" (jid-local j))

13 (assert-equal "example.com" (jid-domain j))

14 (assert-equal "bot" (jid-resource j))))

16 (test "bare JID"

17 (let ((j (parse-jid "[email protected]")))

18 (assert-equal "user" (jid-local j))

19 (assert-equal "example.com" (jid-domain j))

20 (assert-false (jid-resource j))))

22 (test "domain only"

23 (let ((j (parse-jid "example.com")))

24 (assert-false (jid-local j))

25 (assert-equal "example.com" (jid-domain j))

26 (assert-false (jid-resource j))))

28 (test "domain with resource"

29 (let ((j (parse-jid "example.com/announce")))

30 (assert-false (jid-local j))

31 (assert-equal "example.com" (jid-domain j))

32 (assert-equal "announce" (jid-resource j)))))

34(test-group "jid-string-conversion"

35 (test "full JID round-trip"

36 (assert-equal "[email protected]/bot"

37 (jid->string (parse-jid "[email protected]/bot"))))

39 (test "bare JID round-trip"

40 (assert-equal "[email protected]"

41 (jid->string (parse-jid "[email protected]"))))

43 (test "domain-only round-trip"

44 (assert-equal "example.com"

45 (jid->string (parse-jid "example.com"))))

47 (test "jid-bare from full JID"

48 (assert-equal "[email protected]"

49 (jid-bare "[email protected]/bot")))

51 (test "jid-bare from string"

52 (assert-equal "[email protected]"

53 (jid-bare "[email protected]")))

55 (test "jid-bare from domain"

56 (assert-equal "example.com"

57 (jid-bare "example.com"))))

59;; ============================================================

60;; Stanza Construction

61;; ============================================================

63(test-group "stanza-construction"

64 (test "message stanza"

65 (let ((msg (xmpp-message to: "[email protected]" body: "Hello" id: "test-1")))

66 (assert-equal 'message (stanza-type msg))

67 (assert-equal "[email protected]" (stanza-to msg))

68 (assert-equal "chat" (stanza-attr msg 'type))

69 (assert-equal "test-1" (stanza-id msg))

70 (assert-equal "Hello" (message-body msg))))

72 (test "message with subject"

73 (let ((msg (xmpp-message to: "[email protected]" subject: "Test" body: "Hello" id: "test-2")))

74 (let ((subj (stanza-child msg 'subject)))

75 (assert-true (pair? subj))

76 (assert-equal "Test" (sxml-text subj)))))

78 (test "presence stanza"

79 (let ((p (xmpp-presence show: "away" status: "BRB")))

80 (assert-equal 'presence (stanza-type p))

81 (assert-equal "away" (sxml-text (stanza-child p 'show)))

82 (assert-equal "BRB" (sxml-text (stanza-child p 'status)))))

84 (test "presence with type"

85 (let ((p (xmpp-presence type: "unavailable")))

86 (assert-equal "unavailable" (stanza-attr p 'type))))

88 (test "iq stanza"

89 (let ((iq (xmpp-iq type: "get" to: "example.com" id: "iq-1"

90 children: (list '(query (@ (xmlns "jabber:iq:roster")))))))

91 (assert-equal 'iq (stanza-type iq))

92 (assert-equal "get" (stanza-attr iq 'type))

93 (assert-equal "example.com" (stanza-to iq))

94 (let ((query (stanza-child iq 'query)))

95 (assert-true (pair? query)))))

97 (test "auto-generated ID"

98 (let ((msg (xmpp-message to: "[email protected]" body: "Hi")))

99 (assert-true (string? (stanza-id msg))))))

100

101;; ============================================================

102;; Stanza Inspection

103;; ============================================================

104

105(test-group "stanza-inspection"

106 (test "inspect parsed stanza"

107 (let ((s '(message (@ (to "a@b") (from "c@d") (type "chat") (id "m1"))

108 (body "Hello"))))

109 (assert-equal 'message (stanza-type s))

110 (assert-equal "a@b" (stanza-to s))

111 (assert-equal "c@d" (stanza-from s))

112 (assert-equal "m1" (stanza-id s))

113 (assert-equal "Hello" (message-body s))))

114

115 (test "stanza without attributes"

116 (let ((s '(message (body "Hello"))))

117 (assert-equal 'message (stanza-type s))

118 (assert-false (stanza-to s))

119 (assert-equal "Hello" (message-body s))))

120

121 (test "stanza-children"

122 (let ((s '(iq (@ (type "result"))

123 (query (item (@ (jid "a@b")))

124 (item (@ (jid "c@d")))))))

125 (let ((query (stanza-child s 'query)))

126 (assert-equal 2 (length (stanza-children query 'item))))))

127

128 (test "sxml-text concatenates strings"

129 (assert-equal "Hello World" (sxml-text '(body "Hello " "World"))))

130

131 (test "sxml-text returns #f for no text"

132 (assert-false (sxml-text '(empty)))))

133

134;; ============================================================

135;; Serialization

136;; ============================================================

137

138(test-group "stanza-serialization"

139 (test "message to XML"

140 (let ((xml (stanza->xml '(message (@ (to "a@b")) (body "Hi")))))

141 (assert-true (string? xml))

142 (assert-true (string-starts-with? xml "<message"))

143 (assert-true (string-ends-with? xml "</message>"))))

144

145 (test "empty element"

146 (assert-equal "<presence></presence>" (stanza->xml '(presence)))))

147

148(run-tests)