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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module System.ZMQ4.Test.Properties where
import Test.QuickCheck
import Test.QuickCheck.Monadic (monadicIO, run)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Control.Applicative
import Control.Concurrent.Async (wait)
import Data.Int
import Data.Word
import Data.Restricted
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import System.ZMQ4.Monadic
import System.Posix.Types (Fd(..))
import Prelude
import qualified Data.ByteString as SB
import qualified Data.ByteString.Char8 as CB
import qualified Test.QuickCheck.Monadic as QM
tests :: TestTree
tests = testGroup "0MQ Socket Properties"
[ testProperty "get socket option (Pair)" (prop_get_socket_option Pair)
, testProperty "get socket option (Pub)" (prop_get_socket_option Pub)
, testProperty "get socket option (Sub)" (prop_get_socket_option Sub)
, testProperty "get socket option (XPub)" (prop_get_socket_option XPub)
, testProperty "get socket option (XSub)" (prop_get_socket_option XSub)
, testProperty "get socket option (Req)" (prop_get_socket_option Req)
, testProperty "get socket option (Rep)" (prop_get_socket_option Rep)
, testProperty "get socket option (Dealer)" (prop_get_socket_option Dealer)
, testProperty "get socket option (Router)" (prop_get_socket_option Router)
, testProperty "get socket option (Pull)" (prop_get_socket_option Pull)
, testProperty "get socket option (Push)" (prop_get_socket_option Push)
, testProperty "set;get socket option (Pair)" (prop_set_get_socket_option Pair)
, testProperty "set;get socket option (Pub)" (prop_set_get_socket_option Pub)
, testProperty "set;get socket option (Sub)" (prop_set_get_socket_option Sub)
, testProperty "set;get socket option (XPub)" (prop_set_get_socket_option XPub)
, testProperty "set;get socket option (XSub)" (prop_set_get_socket_option XSub)
, testProperty "set;get socket option (Req)" (prop_set_get_socket_option Req)
, testProperty "set;get socket option (Rep)" (prop_set_get_socket_option Rep)
, testProperty "set;get socket option (Dealer)" (prop_set_get_socket_option Dealer)
, testProperty "set;get socket option (Router)" (prop_set_get_socket_option Router)
, testProperty "set;get socket option (Pull)" (prop_set_get_socket_option Pull)
, testProperty "set;get socket option (Push)" (prop_set_get_socket_option Push)
, testProperty "(un-)subscribe" (prop_subscribe Sub)
, testCase "last_enpoint" (last_endpoint)
, testGroup "connect disconnect"
[ testProperty "" (prop_connect_disconnect x)
| x <- [ (AnySocket Rep, AnySocket Req)
, (AnySocket Router, AnySocket Req)
, (AnySocket Pull, AnySocket Push)
]
]
, testGroup "0MQ Messages"
[ testProperty "msg send == msg received (Req/Rep)" (prop_send_receive Req Rep)
, testProperty "msg send == msg received (Push/Pull)" (prop_send_receive Push Pull)
, testProperty "msg send == msg received (Pair/Pair)" (prop_send_receive Pair Pair)
-- , testProperty "publish/subscribe" (prop_pub_sub Pub Sub)
-- (disabled due to LIBZMQ-270 [https://zeromq.jira.com/browse/LIBZMQ-270])
]
]
prop_get_socket_option :: SocketType t => t -> GetOpt -> Property
prop_get_socket_option t opt = monadicIO $ run $ do
runZMQ $ do
s <- socket t
case opt of
Events _ -> events s >> return ()
Filedesc _ -> fileDescriptor s >> return ()
ReceiveMore _ -> moreToReceive s >> return ()
prop_set_get_socket_option :: SocketType t => t -> SetOpt -> Property
prop_set_get_socket_option t opt = monadicIO $ do
r <- run $ runZMQ $ do
s <- socket t
case opt of
Identity val -> (== (rvalue val)) <$> (setIdentity val s >> identity s)
Ipv4Only val -> (== val) <$> (setIpv4Only val s >> ipv4Only s)
Affinity val -> (ieq val) <$> (setAffinity val s >> affinity s)
Backlog val -> (ieq (rvalue val)) <$> (setBacklog val s >> backlog s)
Linger val -> (ieq (rvalue val)) <$> (setLinger val s >> linger s)
Rate val -> (ieq (rvalue val)) <$> (setRate val s >> rate s)
ReceiveBuf val -> (ieq (rvalue val)) <$> (setReceiveBuffer val s >> receiveBuffer s)
ReconnectIVL val -> (ieq (rvalue val)) <$> (setReconnectInterval val s >> reconnectInterval s)
ReconnectIVLMax val -> (ieq (rvalue val)) <$> (setReconnectIntervalMax val s >> reconnectIntervalMax s)
RecoveryIVL val -> (ieq (rvalue val)) <$> (setRecoveryInterval val s >> recoveryInterval s)
SendBuf val -> (ieq (rvalue val)) <$> (setSendBuffer val s >> sendBuffer s)
MaxMessageSize val -> (ieq (rvalue val)) <$> (setMaxMessageSize val s >> maxMessageSize s)
McastHops val -> (ieq (rvalue val)) <$> (setMcastHops val s >> mcastHops s)
ReceiveHighWM val -> (ieq (rvalue val)) <$> (setReceiveHighWM val s >> receiveHighWM s)
ReceiveTimeout val -> (ieq (rvalue val)) <$> (setReceiveTimeout val s >> receiveTimeout s)
SendHighWM val -> (ieq (rvalue val)) <$> (setSendHighWM val s >> sendHighWM s)
SendTimeout val -> (ieq (rvalue val)) <$> (setSendTimeout val s >> sendTimeout s)
ZapDomain val -> (== (rvalue val)) <$> (setZapDomain val s >> zapDomain s)
PlainPassword val -> (== (rvalue val)) <$> (setPlainPassword val s >> plainPassword s)
PlainUsername val -> (== (rvalue val)) <$> (setPlainUserName val s >> plainUserName s)
QM.assert r
where
ieq :: (Integral i, Integral k) => i -> k -> Bool
ieq i k = (fromIntegral i :: Int) == (fromIntegral k :: Int)
last_endpoint :: IO ()
last_endpoint = do
let a = "tcp://127.0.0.1:43821"
a' <- runZMQ $ do
s <- socket Rep
bind s a
lastEndpoint s
a @=? a'
prop_subscribe :: (Subscriber a, SocketType a) => a -> Bytes -> Property
prop_subscribe t (Bytes subs) = monadicIO $ run $
runZMQ $ do
s <- socket t
subscribe s subs
unsubscribe s subs
prop_send_receive :: (SocketType a, SocketType b, Receiver b, Sender a) => a -> b -> Bytes -> Property
prop_send_receive a b (Bytes msg) = monadicIO $ do
msg' <- run $ runZMQ $ do
sender <- socket a
receiver <- socket b
bind receiver "inproc://endpoint"
x <- async $ receive receiver
connect sender "inproc://endpoint"
send sender [] msg
liftIO $ wait x
QM.assert (msg == msg')
prop_pub_sub :: (SocketType a, Subscriber b, SocketType b, Sender a, Receiver b) => a -> b -> Bytes -> Property
prop_pub_sub a b (Bytes msg) = monadicIO $ do
msg' <- run $ runZMQ $ do
pub <- socket a
sub <- socket b
subscribe sub ""
bind sub "inproc://endpoint"
connect pub "inproc://endpoint"
send pub [] msg
receive sub
QM.assert (msg == msg')
prop_connect_disconnect :: (AnySocket, AnySocket) -> Property
prop_connect_disconnect (AnySocket t0, AnySocket t) = monadicIO $ run $
runZMQ $ do
s0 <- socket t0
bind s0 "inproc://endpoint"
s <- socket t
connect s "inproc://endpoint"
disconnect s "inproc://endpoint"
newtype Bytes = Bytes { unbytes :: ByteString } deriving Show
instance Arbitrary Bytes where
arbitrary = Bytes . CB.filter (/= '\NUL') . CB.pack <$> arbitrary
data GetOpt =
Events Int
| Filedesc Fd
| ReceiveMore Bool
deriving Show
data SetOpt =
Affinity Word64
| Backlog (Restricted (N0, Int32) Int)
| Identity (Restricted (N1, N254) ByteString)
| Ipv4Only Bool
| Linger (Restricted (Nneg1, Int32) Int)
| MaxMessageSize (Restricted (Nneg1, Int64) Int64)
| McastHops (Restricted (N1, Int32) Int)
| Rate (Restricted (N1, Int32) Int)
| ReceiveBuf (Restricted (N0, Int32) Int)
| ReceiveHighWM (Restricted (N0, Int32) Int)
| ReceiveTimeout (Restricted (Nneg1, Int32) Int)
| ReconnectIVL (Restricted (N0, Int32) Int)
| ReconnectIVLMax (Restricted (N0, Int32) Int)
| RecoveryIVL (Restricted (N0, Int32) Int)
| SendBuf (Restricted (N0, Int32) Int)
| SendHighWM (Restricted (N0, Int32) Int)
| SendTimeout (Restricted (Nneg1, Int32) Int)
| ZapDomain (Restricted (N1, N254) ByteString)
| PlainPassword (Restricted (N1, N254) ByteString)
| PlainUsername (Restricted (N1, N254) ByteString)
deriving Show
instance Arbitrary GetOpt where
arbitrary = oneof [
Events <$> arbitrary
, Filedesc . Fd . fromIntegral <$> (arbitrary :: Gen Int32)
, ReceiveMore <$> arbitrary
]
instance Arbitrary SetOpt where
arbitrary = oneof [
Affinity <$> (arbitrary :: Gen Word64)
, Ipv4Only <$> (arbitrary :: Gen Bool)
, Backlog . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, Linger . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1)
, Rate . toR1 <$> (arbitrary :: Gen Int32) `suchThat` (> 0)
, ReceiveBuf . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, ReconnectIVL . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, ReconnectIVLMax . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, RecoveryIVL . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, SendBuf . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, McastHops . toR1 <$> (arbitrary :: Gen Int32) `suchThat` (> 0)
, ReceiveHighWM . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, ReceiveTimeout . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1)
, SendHighWM . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0)
, SendTimeout . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1)
, MaxMessageSize . toRneg1' <$> (arbitrary :: Gen Int64) `suchThat` (>= -1)
, ZapDomain . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)
, PlainPassword . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)
, PlainUsername . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)
, Identity . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)
]
toR1 :: Int32 -> Restricted (N1, Int32) Int
toR1 = fromJust . toRestricted . fromIntegral
toR0 :: Int32 -> Restricted (N0, Int32) Int
toR0 = fromJust . toRestricted . fromIntegral
toRneg1 :: Int32 -> Restricted (Nneg1, Int32) Int
toRneg1 = fromJust . toRestricted . fromIntegral
toRneg1' :: Int64 -> Restricted (Nneg1, Int64) Int64
toRneg1' = fromJust . toRestricted . fromIntegral
data AnySocket where
AnySocket :: SocketType a => a -> AnySocket
|
