3 ipv4address_properties,
5 most_sig_bit_different )
9 import Test.Tasty ( TestTree, testGroup )
10 import Test.Tasty.HUnit ( (@?=), testCase )
11 import Test.Tasty.QuickCheck (
12 Arbitrary( arbitrary ),
18 import Maskable ( Maskable( apply_mask) )
21 Zero, One, Two, Three, Four, Five, Six, Seven, Eight,
22 Nine, Ten, Eleven, Twelve, Thirteen, Fourteen, Fifteen, Sixteen,
23 Seventeen, Eighteen, Nineteen, Twenty, TwentyOne, TwentyTwo, TwentyThree,
24 TwentyFour, TwentyFive, TwentySix, TwentySeven, TwentyEight, TwentyNine,
25 Thirty, ThirtyOne, ThirtyTwo ) )
26 import Octet ( Octet( b1, b2, b3, b4, b5, b6, b7, b8) )
29 IPv4Address { octet1 :: Octet,
36 instance Show IPv4Address where
37 show addr = concat [(show oct1) ++ ".",
48 instance Arbitrary IPv4Address where
50 oct1 <- arbitrary :: Gen Octet
51 oct2 <- arbitrary :: Gen Octet
52 oct3 <- arbitrary :: Gen Octet
53 oct4 <- arbitrary :: Gen Octet
54 return (IPv4Address oct1 oct2 oct3 oct4)
58 instance Maskable IPv4Address where
60 apply_mask addr mask bit =
68 -- A copy of 'addr' with the fourth octet zeroed (or oned).
69 new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
71 -- Likewise for new_addr1's third octet.
72 new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
74 -- And new_addr2's second octet.
75 new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
77 -- This helper function allows us to pattern-match cleanly.
78 apply_mask' :: Maskbits -> IPv4Address
80 apply_mask' ThirtyTwo = addr
82 apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
85 addr { octet4 = (apply_mask oct4 Six bit) }
87 apply_mask' TwentyNine =
88 addr { octet4 = (apply_mask oct4 Five bit) }
90 apply_mask' TwentyEight =
91 addr { octet4 = (apply_mask oct4 Four bit) }
93 apply_mask' TwentySeven =
94 addr { octet4 = (apply_mask oct4 Three bit) }
96 apply_mask' TwentySix =
97 addr { octet4 = (apply_mask oct4 Two bit) }
99 apply_mask' TwentyFive =
100 addr { octet4 = (apply_mask oct4 One bit) }
102 apply_mask' TwentyFour = new_addr1
104 apply_mask' TwentyThree =
105 new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
107 apply_mask' TwentyTwo =
108 new_addr1 { octet3 = (apply_mask oct3 Six bit) }
110 apply_mask' TwentyOne =
111 new_addr1 { octet3 = (apply_mask oct3 Five bit) }
114 new_addr1 { octet3 = (apply_mask oct3 Four bit) }
116 apply_mask' Nineteen =
117 new_addr1 { octet3 = (apply_mask oct3 Three bit) }
119 apply_mask' Eighteen =
120 new_addr1 { octet3 = (apply_mask oct3 Two bit) }
122 apply_mask' Seventeen =
123 new_addr1 { octet3 = (apply_mask oct3 One bit) }
125 apply_mask' Sixteen =
128 apply_mask' Fifteen =
129 new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
131 apply_mask' Fourteen =
132 new_addr2 { octet2 = (apply_mask oct2 Six bit) }
134 apply_mask' Thirteen =
135 new_addr2 { octet2 = (apply_mask oct2 Five bit) }
138 new_addr2 { octet2 = (apply_mask oct2 Four bit) }
141 new_addr2 { octet2 = (apply_mask oct2 Three bit) }
144 new_addr2 { octet2 = (apply_mask oct2 Two bit) }
147 new_addr2 { octet2 = (apply_mask oct2 One bit) }
150 new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
153 new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
156 new_addr3 { octet1 = (apply_mask oct1 Six bit) }
159 new_addr3 { octet1 = (apply_mask oct1 Five bit) }
162 new_addr3 { octet1 = (apply_mask oct1 Four bit) }
165 new_addr3 { octet1 = (apply_mask oct1 Three bit) }
168 new_addr3 { octet1 = (apply_mask oct1 Two bit) }
171 new_addr3 { octet1 = (apply_mask oct1 One bit) }
174 new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
177 instance Bounded IPv4Address where
178 -- | The minimum possible IPv4 address, 0.0.0.0.
179 minBound = IPv4Address minBound minBound minBound minBound
181 -- | The maximum possible IPv4 address, 255.255.255.255.
182 maxBound = IPv4Address maxBound maxBound maxBound maxBound
187 instance Enum IPv4Address where
188 -- | Convert an 'Int' @x@ to an 'IPv4Address'. Each octet of @x@ is
189 -- right-shifted by the appropriate number of bits, and the fractional
192 IPv4Address oct1 oct2 oct3 oct4
194 -- Chop off the higher octets. x1 = x `mod` 2^32, would be
196 x2 = x `mod` 2^(24 :: Integer)
197 x3 = x `mod` 2^(16 :: Integer)
198 x4 = x `mod` 2^(8 :: Integer)
199 -- Perform right-shifts. x4 doesn't need a shift.
200 shifted_x1 = x `quot` 2^(24 :: Integer)
201 shifted_x2 = x2 `quot` 2^(16 :: Integer)
202 shifted_x3 = x3 `quot` 2^(8 :: Integer)
203 oct1 = toEnum shifted_x1 :: Octet
204 oct2 = toEnum shifted_x2 :: Octet
205 oct3 = toEnum shifted_x3 :: Octet
206 oct4 = toEnum x4 :: Octet
208 -- | Convert @addr@ to an 'Int' by converting each octet to an 'Int'
209 -- and shifting the result to the left by 0,8.16, or 24 bits.
211 (shifted_oct1) + (shifted_oct2) + (shifted_oct3) + oct4
213 oct1 = fromEnum (octet1 addr)
214 oct2 = fromEnum (octet2 addr)
215 oct3 = fromEnum (octet3 addr)
216 oct4 = fromEnum (octet4 addr)
217 shifted_oct1 = oct1 * 2^(24 :: Integer)
218 shifted_oct2 = oct2 * 2^(16 :: Integer)
219 shifted_oct3 = oct3 * 2^(8 :: Integer)
221 -- | Given two addresses, find the number of the most significant bit
222 -- where they differ. If the addresses are the same, return
224 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
225 most_sig_bit_different addr1 addr2
226 | addr1 == addr2 = Maskbits.Zero
227 | m1 /= n1 = Maskbits.One
237 | m11 /= n11 = Eleven
238 | m12 /= n12 = Twelve
239 | m13 /= n13 = Thirteen
240 | m14 /= n14 = Fourteen
241 | m15 /= n15 = Fifteen
242 | m16 /= n16 = Sixteen
243 | m17 /= n17 = Seventeen
244 | m18 /= n18 = Eighteen
245 | m19 /= n19 = Nineteen
246 | m20 /= n20 = Twenty
247 | m21 /= n21 = TwentyOne
248 | m22 /= n22 = TwentyTwo
249 | m23 /= n23 = TwentyThree
250 | m24 /= n24 = TwentyFour
251 | m25 /= n25 = TwentyFive
252 | m26 /= n26 = TwentySix
253 | m27 /= n27 = TwentySeven
254 | m28 /= n28 = TwentyEight
255 | m29 /= n29 = TwentyNine
256 | m30 /= n30 = Thirty
257 | m31 /= n31 = ThirtyOne
258 | m32 /= n32 = ThirtyTwo
259 | otherwise = Maskbits.Zero
293 oct1a = (octet1 addr1)
294 oct2a = (octet2 addr1)
295 oct3a = (octet3 addr1)
296 oct4a = (octet4 addr1)
329 oct1b = (octet1 addr2)
330 oct2b = (octet2 addr2)
331 oct3b = (octet3 addr2)
332 oct4b = (octet4 addr2)
336 ipv4address_tests :: TestTree
338 testGroup "IPv4 Address Tests" [
342 test_most_sig_bit_different1,
343 test_most_sig_bit_different2,
350 ipv4address_properties :: TestTree
351 ipv4address_properties =
353 "IPv4 Address Properties "
354 [ prop_from_enum_to_enum_inverses ]
356 -- QuickCheck properties
357 prop_from_enum_to_enum_inverses :: TestTree
358 prop_from_enum_to_enum_inverses =
359 testProperty "fromEnum and toEnum are inverses" prop
361 prop :: Int -> Property
363 (0 <= x) && (x <= 2^(32 :: Integer) - 1) ==>
364 fromEnum (toEnum x :: IPv4Address) == x
367 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
368 mk_testaddr a b c d =
369 IPv4Address oct1 oct2 oct3 oct4
371 oct1 = toEnum a :: Octet
372 oct2 = toEnum b :: Octet
373 oct3 = toEnum c :: Octet
374 oct4 = toEnum d :: Octet
377 test_minBound :: TestTree
379 testCase desc $ actual @?= expected
381 desc = "minBound should be 0.0.0.0"
382 expected = mk_testaddr 0 0 0 0
383 actual = minBound :: IPv4Address
386 test_maxBound :: TestTree
388 testCase desc $ actual @?= expected
390 desc = "maxBound should be 255.255.255.255"
391 expected = mk_testaddr 255 255 255 255
392 actual = maxBound :: IPv4Address
395 test_enum :: TestTree
397 testCase desc $ actual @?= expected
399 desc = "enumerating a /24 gives the correct addresses"
400 expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ]
401 lb = mk_testaddr 192 168 0 0
402 ub = mk_testaddr 192 168 0 255
403 actual = map show [lb..ub]
406 test_most_sig_bit_different1 :: TestTree
407 test_most_sig_bit_different1 =
408 testCase desc $ actual @?= expected
410 desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
411 addr1 = mk_testaddr 10 1 1 0
412 addr2 = (mk_testaddr 10 1 0 0)
413 expected = TwentyFour
414 actual = most_sig_bit_different addr1 addr2
418 test_most_sig_bit_different2 :: TestTree
419 test_most_sig_bit_different2 =
420 testCase desc $ actual @?= expected
422 desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
423 addr1 = mk_testaddr 10 1 2 0
424 addr2 = mk_testaddr 10 1 1 0
425 expected = TwentyThree
426 actual = most_sig_bit_different addr1 addr2
429 test_to_enum :: TestTree
431 testCase desc $ actual @?= expected
433 desc = "192.168.0.0 in base-10 is 3232235520"
434 expected = mk_testaddr 192 168 0 0
435 actual = toEnum 3232235520 :: IPv4Address
438 test_ord_instance1 :: TestTree
440 testCase desc $ actual @?= expected
442 desc = "127.0.0.0 is less than 127.0.0.1"
443 addr1 = mk_testaddr 127 0 0 0
444 addr2 = mk_testaddr 127 0 0 1
446 actual = addr1 <= addr2
449 test_ord_instance2 :: TestTree
451 testCase desc $ actual @?= expected
453 desc = "127.0.0.0 is less than 127.0.1.0"
454 addr1 = mk_testaddr 127 0 0 0
455 addr2 = mk_testaddr 127 0 1 0
457 actual = addr1 <= addr2
459 test_ord_instance3 :: TestTree
461 testCase desc $ actual @?= expected
463 desc = "127.0.0.0 is less than 127.1.0.0"
464 addr1 = mk_testaddr 127 0 0 0
465 addr2 = mk_testaddr 127 1 0 0
467 actual = addr1 <= addr2
469 test_ord_instance4 :: TestTree
471 testCase desc $ actual @?= expected
473 desc = "127.0.0.0 is less than 128.0.0.0"
474 addr1 = mk_testaddr 127 0 0 0
475 addr2 = mk_testaddr 128 0 0 0
477 actual = addr1 <= addr2