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 (bareJid 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