3 ipv4address_properties,
5 most_sig_bit_different )
8 import Data.Word (Word32)
10 import Test.Tasty ( TestTree, testGroup )
11 import Test.Tasty.HUnit ( (@?=), testCase )
12 import Test.Tasty.QuickCheck (
13 Arbitrary( arbitrary ),
19 import Maskable ( Maskable( apply_mask) )
22 Zero, One, Two, Three, Four, Five, Six, Seven, Eight,
23 Nine, Ten, Eleven, Twelve, Thirteen, Fourteen, Fifteen, Sixteen,
24 Seventeen, Eighteen, Nineteen, Twenty, TwentyOne, TwentyTwo, TwentyThree,
25 TwentyFour, TwentyFive, TwentySix, TwentySeven, TwentyEight, TwentyNine,
26 Thirty, ThirtyOne, ThirtyTwo ) )
27 import Octet ( Octet( b1, b2, b3, b4, b5, b6, b7, b8) )
30 IPv4Address { octet1 :: Octet,
37 instance Show IPv4Address where
38 show addr = concat [(show oct1) ++ ".",
49 instance Arbitrary IPv4Address where
51 oct1 <- arbitrary :: Gen Octet
52 oct2 <- arbitrary :: Gen Octet
53 oct3 <- arbitrary :: Gen Octet
54 oct4 <- arbitrary :: Gen Octet
55 return (IPv4Address oct1 oct2 oct3 oct4)
59 instance Maskable IPv4Address where
61 apply_mask addr mask bit =
69 -- A copy of 'addr' with the fourth octet zeroed (or oned).
70 new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
72 -- Likewise for new_addr1's third octet.
73 new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
75 -- And new_addr2's second octet.
76 new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
78 -- This helper function allows us to pattern-match cleanly.
79 apply_mask' :: Maskbits -> IPv4Address
81 apply_mask' ThirtyTwo = addr
83 apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
86 addr { octet4 = (apply_mask oct4 Six bit) }
88 apply_mask' TwentyNine =
89 addr { octet4 = (apply_mask oct4 Five bit) }
91 apply_mask' TwentyEight =
92 addr { octet4 = (apply_mask oct4 Four bit) }
94 apply_mask' TwentySeven =
95 addr { octet4 = (apply_mask oct4 Three bit) }
97 apply_mask' TwentySix =
98 addr { octet4 = (apply_mask oct4 Two bit) }
100 apply_mask' TwentyFive =
101 addr { octet4 = (apply_mask oct4 One bit) }
103 apply_mask' TwentyFour = new_addr1
105 apply_mask' TwentyThree =
106 new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
108 apply_mask' TwentyTwo =
109 new_addr1 { octet3 = (apply_mask oct3 Six bit) }
111 apply_mask' TwentyOne =
112 new_addr1 { octet3 = (apply_mask oct3 Five bit) }
115 new_addr1 { octet3 = (apply_mask oct3 Four bit) }
117 apply_mask' Nineteen =
118 new_addr1 { octet3 = (apply_mask oct3 Three bit) }
120 apply_mask' Eighteen =
121 new_addr1 { octet3 = (apply_mask oct3 Two bit) }
123 apply_mask' Seventeen =
124 new_addr1 { octet3 = (apply_mask oct3 One bit) }
126 apply_mask' Sixteen =
129 apply_mask' Fifteen =
130 new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
132 apply_mask' Fourteen =
133 new_addr2 { octet2 = (apply_mask oct2 Six bit) }
135 apply_mask' Thirteen =
136 new_addr2 { octet2 = (apply_mask oct2 Five bit) }
139 new_addr2 { octet2 = (apply_mask oct2 Four bit) }
142 new_addr2 { octet2 = (apply_mask oct2 Three bit) }
145 new_addr2 { octet2 = (apply_mask oct2 Two bit) }
148 new_addr2 { octet2 = (apply_mask oct2 One bit) }
151 new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
154 new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
157 new_addr3 { octet1 = (apply_mask oct1 Six bit) }
160 new_addr3 { octet1 = (apply_mask oct1 Five bit) }
163 new_addr3 { octet1 = (apply_mask oct1 Four bit) }
166 new_addr3 { octet1 = (apply_mask oct1 Three bit) }
169 new_addr3 { octet1 = (apply_mask oct1 Two bit) }
172 new_addr3 { octet1 = (apply_mask oct1 One bit) }
175 new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
178 instance Bounded IPv4Address where
179 -- | The minimum possible IPv4 address, 0.0.0.0.
180 minBound = IPv4Address minBound minBound minBound minBound
182 -- | The maximum possible IPv4 address, 255.255.255.255.
183 maxBound = IPv4Address maxBound maxBound maxBound maxBound
188 instance Enum IPv4Address where
189 -- | Convert an 'Int' @x@ to an 'IPv4Address'. Each octet of @x@ is
190 -- right-shifted by the appropriate number of bits, and the fractional
193 IPv4Address oct1 oct2 oct3 oct4
195 -- Convert the input Int to a Word32 before we proceed. On x86,
196 -- the Int that we get could be negative (half of all IP
197 -- addresses correspond to negative numbers), and then the magic
198 -- below doesn't work. The Word32 type is unsigned, so we do the
199 -- math on that and then convert everything back to Int later on
200 -- once we have four much-smaller non-negative numbers.
201 x = fromIntegral y :: Word32
203 -- Chop off the higher octets. x1 = x `mod` 2^32, would be
205 x2 = x `mod` 2^(24 :: Integer)
206 x3 = x `mod` 2^(16 :: Integer)
207 x4 = (fromIntegral $ x `mod` 2^(8 :: Integer)) :: Int
208 -- Perform right-shifts. x4 doesn't need a shift.
209 shifted_x1 = (fromIntegral $ x `quot` 2^(24 :: Integer)) :: Int
210 shifted_x2 = (fromIntegral $ x2 `quot` 2^(16 :: Integer)) :: Int
211 shifted_x3 = fromIntegral $ x3 `quot` 2^(8 :: Integer) :: Int
212 oct1 = toEnum shifted_x1 :: Octet
213 oct2 = toEnum shifted_x2 :: Octet
214 oct3 = toEnum shifted_x3 :: Octet
215 oct4 = toEnum x4 :: Octet
217 -- | Convert @addr@ to an 'Int' by converting each octet to an 'Int'
218 -- and shifting the result to the left by 0,8.16, or 24 bits.
220 (shifted_oct1) + (shifted_oct2) + (shifted_oct3) + oct4
222 oct1 = fromEnum (octet1 addr)
223 oct2 = fromEnum (octet2 addr)
224 oct3 = fromEnum (octet3 addr)
225 oct4 = fromEnum (octet4 addr)
226 shifted_oct1 = oct1 * 2^(24 :: Integer)
227 shifted_oct2 = oct2 * 2^(16 :: Integer)
228 shifted_oct3 = oct3 * 2^(8 :: Integer)
230 -- | Given two addresses, find the number of the most significant bit
231 -- where they differ. If the addresses are the same, return
233 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
234 most_sig_bit_different addr1 addr2
235 | addr1 == addr2 = Maskbits.Zero
236 | m1 /= n1 = Maskbits.One
246 | m11 /= n11 = Eleven
247 | m12 /= n12 = Twelve
248 | m13 /= n13 = Thirteen
249 | m14 /= n14 = Fourteen
250 | m15 /= n15 = Fifteen
251 | m16 /= n16 = Sixteen
252 | m17 /= n17 = Seventeen
253 | m18 /= n18 = Eighteen
254 | m19 /= n19 = Nineteen
255 | m20 /= n20 = Twenty
256 | m21 /= n21 = TwentyOne
257 | m22 /= n22 = TwentyTwo
258 | m23 /= n23 = TwentyThree
259 | m24 /= n24 = TwentyFour
260 | m25 /= n25 = TwentyFive
261 | m26 /= n26 = TwentySix
262 | m27 /= n27 = TwentySeven
263 | m28 /= n28 = TwentyEight
264 | m29 /= n29 = TwentyNine
265 | m30 /= n30 = Thirty
266 | m31 /= n31 = ThirtyOne
267 | m32 /= n32 = ThirtyTwo
268 | otherwise = Maskbits.Zero
302 oct1a = (octet1 addr1)
303 oct2a = (octet2 addr1)
304 oct3a = (octet3 addr1)
305 oct4a = (octet4 addr1)
338 oct1b = (octet1 addr2)
339 oct2b = (octet2 addr2)
340 oct3b = (octet3 addr2)
341 oct4b = (octet4 addr2)
345 ipv4address_tests :: TestTree
347 testGroup "IPv4 Address Tests" [
351 test_most_sig_bit_different1,
352 test_most_sig_bit_different2,
359 ipv4address_properties :: TestTree
360 ipv4address_properties =
362 "IPv4 Address Properties "
363 [ prop_from_enum_to_enum_inverses ]
365 -- QuickCheck properties
366 prop_from_enum_to_enum_inverses :: TestTree
367 prop_from_enum_to_enum_inverses =
368 testProperty "fromEnum and toEnum are inverses" prop
370 prop :: Int -> Property
372 (0 <= x) && (x <= 2^(32 :: Integer) - 1) ==>
373 fromEnum (toEnum x :: IPv4Address) == x
376 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
377 mk_testaddr a b c d =
378 IPv4Address oct1 oct2 oct3 oct4
380 oct1 = toEnum a :: Octet
381 oct2 = toEnum b :: Octet
382 oct3 = toEnum c :: Octet
383 oct4 = toEnum d :: Octet
386 test_minBound :: TestTree
388 testCase desc $ actual @?= expected
390 desc = "minBound should be 0.0.0.0"
391 expected = mk_testaddr 0 0 0 0
392 actual = minBound :: IPv4Address
395 test_maxBound :: TestTree
397 testCase desc $ actual @?= expected
399 desc = "maxBound should be 255.255.255.255"
400 expected = mk_testaddr 255 255 255 255
401 actual = maxBound :: IPv4Address
404 test_enum :: TestTree
406 testCase desc $ actual @?= expected
408 desc = "enumerating a /24 gives the correct addresses"
409 expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ]
410 lb = mk_testaddr 192 168 0 0
411 ub = mk_testaddr 192 168 0 255
412 actual = map show [lb..ub]
415 test_most_sig_bit_different1 :: TestTree
416 test_most_sig_bit_different1 =
417 testCase desc $ actual @?= expected
419 desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
420 addr1 = mk_testaddr 10 1 1 0
421 addr2 = (mk_testaddr 10 1 0 0)
422 expected = TwentyFour
423 actual = most_sig_bit_different addr1 addr2
427 test_most_sig_bit_different2 :: TestTree
428 test_most_sig_bit_different2 =
429 testCase desc $ actual @?= expected
431 desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
432 addr1 = mk_testaddr 10 1 2 0
433 addr2 = mk_testaddr 10 1 1 0
434 expected = TwentyThree
435 actual = most_sig_bit_different addr1 addr2
438 test_to_enum :: TestTree
440 testCase desc $ actual @?= expected
442 desc = "192.168.0.0 in base-10 is 3232235520"
443 expected = mk_testaddr 192 168 0 0
444 -- We declare the big number as Word32 because otherwise, on x86,
445 -- we get a warning that it's too big to fit in a 32-bit integer.
446 -- Ultimately we convert it to a (negative) Int on those systems
447 -- anyway, but the gymnastics declare our intent to the compiler.
448 actual = toEnum (fromIntegral (3232235520 :: Word32)) :: IPv4Address
451 test_ord_instance1 :: TestTree
453 testCase desc $ actual @?= expected
455 desc = "127.0.0.0 is less than 127.0.0.1"
456 addr1 = mk_testaddr 127 0 0 0
457 addr2 = mk_testaddr 127 0 0 1
459 actual = addr1 <= addr2
462 test_ord_instance2 :: TestTree
464 testCase desc $ actual @?= expected
466 desc = "127.0.0.0 is less than 127.0.1.0"
467 addr1 = mk_testaddr 127 0 0 0
468 addr2 = mk_testaddr 127 0 1 0
470 actual = addr1 <= addr2
472 test_ord_instance3 :: TestTree
474 testCase desc $ actual @?= expected
476 desc = "127.0.0.0 is less than 127.1.0.0"
477 addr1 = mk_testaddr 127 0 0 0
478 addr2 = mk_testaddr 127 1 0 0
480 actual = addr1 <= addr2
482 test_ord_instance4 :: TestTree
484 testCase desc $ actual @?= expected
486 desc = "127.0.0.0 is less than 128.0.0.0"
487 addr1 = mk_testaddr 127 0 0 0
488 addr2 = mk_testaddr 128 0 0 0
490 actual = addr1 <= addr2