~singpolyma/cheogram-smtp

ref: 06e954292339d5569db11c456447e8fd72f1d6c0 cheogram-smtp/test/UtilTest.hs -rw-r--r-- 2.8 KiB
06e95429Stephen Paul Weber Add install instructions to README 2 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
module UtilTest where

import Prelude ()
import BasicPrelude
import Test.Tasty.HUnit
import qualified Network.Protocol.XMPP as XMPP
import qualified Data.XML.Types as XML

import TestInstances ()
import Util

-- Because Arbitrary for XML.Element can be slow
exampleElement :: XML.Element
exampleElement = XML.Element (s"{example.com}x") [] []

prop_jidEscapeRoundtrip :: Text -> Bool
prop_jidEscapeRoundtrip txt = unescapeJid (escapeJid txt) == txt

prop_sRoundtrip :: String -> Bool
prop_sRoundtrip str = textToString (s str) == str

prop_iqReply :: XMPP.IQ -> Bool
prop_iqReply iq =
	XMPP.iqType reply == XMPP.IQResult &&
	XMPP.iqFrom reply == XMPP.iqTo iq &&
	XMPP.iqTo reply == XMPP.iqFrom iq &&
	XMPP.iqPayload reply == Just exampleElement
	where
	reply = iqReply (Just exampleElement) iq

prop_iqError :: XMPP.IQ -> Bool
prop_iqError iq =
	XMPP.iqType err == XMPP.IQError &&
	XMPP.iqFrom err == XMPP.iqTo iq &&
	XMPP.iqTo err == XMPP.iqFrom iq &&
	XMPP.iqPayload err == Just exampleElement
	where
	err = iqError exampleElement iq

prop_getBody :: Text -> Bool
prop_getBody bodyTxt = getBody message == Just bodyTxt
	where
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messagePayloads = [
			exampleElement,
			XML.Element (s"{jabber:component:accept}body") [] [
				XML.NodeContent $ XML.ContentText mempty,
				XML.NodeContent $ XML.ContentText bodyTxt
			]
		]
	}

prop_getSubject :: Text -> Bool
prop_getSubject subjectTxt = getSubject message == Just subjectTxt
	where
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messagePayloads = [
			exampleElement,
			XML.Element (s"{jabber:component:accept}subject") [] [
				XML.NodeContent $ XML.ContentText mempty,
				XML.NodeContent $ XML.ContentText subjectTxt
			]
		]
	}

unit_childFound :: IO ()
unit_childFound =
	child (s"{findme.example.com}x") message
	@?=
	Just findme
	where
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messagePayloads = [exampleElement, findme, exampleElement]
	}
	findme = XML.Element (s"{findme.example.com}x") [] []

unit_childNotFound :: IO ()
unit_childNotFound =
	child (s"{notfindme.example.com}x") message
	@?=
	Nothing
	where
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messagePayloads = [exampleElement, findme, exampleElement]
	}
	findme = XML.Element (s"{findme.example.com}x") [] []

unit_errorChildFound :: IO ()
unit_errorChildFound =
	errorChild message
	@?=
	Just err
	where
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messagePayloads = [exampleElement, err, exampleElement]
	}
	err = errorPayload "cancel" "not-found" (s"Not here") []

unit_errorChildNotFound :: IO ()
unit_errorChildNotFound =
	errorChild message
	@?=
	Nothing
	where
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messagePayloads = [exampleElement, exampleElement]
	}