~singpolyma/cheogram-smtp

ref: 2e20ee0ff17e2f4162505a0f8b955c25ce35dbbd cheogram-smtp/test/VCardTest.hs -rw-r--r-- 1.1 KiB
2e20ee0fStephen Paul Weber Fetch vcard4 when sending message and use it for name and X-URL headers 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
module VCardTest where

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

import Util
import VCard
import TestInstances ()

prop_vcardRequest :: XMPP.JID -> Bool
prop_vcardRequest jid =
	XMPP.iqTo req == Just jid &&
	XMPP.iqPayload req == Just vcardEl
	where
	vcardEl = XML.Element (s"{urn:ietf:params:xml:ns:vcard-4.0}vcard") [] []
	req = vcardRequest jid

-- Odds of randomly producing the right payload are basically zero
prop_parseVCardRandomIQ :: XMPP.IQ -> Bool
prop_parseVCardRandomIQ iq = parseVCard iq == emptyVCard

data VCardResult = VCardResult VCard XMPP.IQ deriving (Show)

instance Arbitrary VCardResult where
	arbitrary = do
		vcard <- VCard <$> arbitrary <*> arbitrary <*> arbitrary
		iq <- XMPP.IQ <$>
			pure XMPP.IQResult <*>
			arbitrary <*>
			arbitrary <*>
			arbitrary <*>
			arbitrary <*>
			pure (Just $ vcardToElement vcard)
		return (VCardResult vcard iq)

prop_parseVCardValid :: VCardResult -> Bool
prop_parseVCardValid (VCardResult vcard iq) = parseVCard iq == vcard