2 ipv4address_properties,
5 most_sig_bit_different,
8 import Data.Maybe (fromJust)
9 import Test.HUnit (assertEqual)
10 import Test.Framework (Test, testGroup)
11 import Test.Framework.Providers.HUnit (testCase)
12 import Test.Framework.Providers.QuickCheck2 (testProperty)
13 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
20 IPv4Address { octet1 :: Octet,
27 instance Show IPv4Address where
28 show addr = concat [(show oct1) ++ ".",
39 instance Arbitrary IPv4Address where
41 oct1 <- arbitrary :: Gen Octet
42 oct2 <- arbitrary :: Gen Octet
43 oct3 <- arbitrary :: Gen Octet
44 oct4 <- arbitrary :: Gen Octet
45 return (IPv4Address oct1 oct2 oct3 oct4)
49 instance Maskable IPv4Address where
51 apply_mask addr mask bit =
59 -- A copy of 'addr' with the fourth octet zeroed (or oned).
60 new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
62 -- Likewise for new_addr1's third octet.
63 new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
65 -- And new_addr2's second octet.
66 new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
68 -- This helper function allows us to pattern-match cleanly.
69 apply_mask' :: Maskbits -> IPv4Address
71 apply_mask' ThirtyTwo = addr
73 apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
76 addr { octet4 = (apply_mask oct4 Six bit) }
78 apply_mask' TwentyNine =
79 addr { octet4 = (apply_mask oct4 Five bit) }
81 apply_mask' TwentyEight =
82 addr { octet4 = (apply_mask oct4 Four bit) }
84 apply_mask' TwentySeven =
85 addr { octet4 = (apply_mask oct4 Three bit) }
87 apply_mask' TwentySix =
88 addr { octet4 = (apply_mask oct4 Two bit) }
90 apply_mask' TwentyFive =
91 addr { octet4 = (apply_mask oct4 One bit) }
93 apply_mask' TwentyFour = new_addr1
95 apply_mask' TwentyThree =
96 new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
98 apply_mask' TwentyTwo =
99 new_addr1 { octet3 = (apply_mask oct3 Six bit) }
101 apply_mask' TwentyOne =
102 new_addr1 { octet3 = (apply_mask oct3 Five bit) }
105 new_addr1 { octet3 = (apply_mask oct3 Four bit) }
107 apply_mask' Nineteen =
108 new_addr1 { octet3 = (apply_mask oct3 Three bit) }
110 apply_mask' Eighteen =
111 new_addr1 { octet3 = (apply_mask oct3 Two bit) }
113 apply_mask' Seventeen =
114 new_addr1 { octet3 = (apply_mask oct3 One bit) }
116 apply_mask' Sixteen =
119 apply_mask' Fifteen =
120 new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
122 apply_mask' Fourteen =
123 new_addr2 { octet2 = (apply_mask oct2 Six bit) }
125 apply_mask' Thirteen =
126 new_addr2 { octet2 = (apply_mask oct2 Five bit) }
129 new_addr2 { octet2 = (apply_mask oct2 Four bit) }
132 new_addr2 { octet2 = (apply_mask oct2 Three bit) }
135 new_addr2 { octet2 = (apply_mask oct2 Two bit) }
138 new_addr2 { octet2 = (apply_mask oct2 One bit) }
141 new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
144 new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
147 new_addr3 { octet1 = (apply_mask oct1 Six bit) }
150 new_addr3 { octet1 = (apply_mask oct1 Five bit) }
153 new_addr3 { octet1 = (apply_mask oct1 Four bit) }
156 new_addr3 { octet1 = (apply_mask oct1 Three bit) }
159 new_addr3 { octet1 = (apply_mask oct1 Two bit) }
162 new_addr3 { octet1 = (apply_mask oct1 One bit) }
165 new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
168 instance Bounded IPv4Address where
169 -- | The minimum possible IPv4 address, 0.0.0.0.
170 minBound = IPv4Address minBound minBound minBound minBound
172 -- | The maximum possible IPv4 address, 255.255.255.255.
173 maxBound = IPv4Address maxBound maxBound maxBound maxBound
177 -- | Convert @addr@ to an 'Int' by converting each octet to an 'Int'
178 -- and shifting the result to the left by 0,8.16, or 24 bits.
179 ipv4address_to_int :: IPv4Address -> Int
180 ipv4address_to_int addr =
181 (shifted_oct1) + (shifted_oct2) + (shifted_oct3) + oct4
183 oct1 = fromEnum (octet1 addr)
184 oct2 = fromEnum (octet2 addr)
185 oct3 = fromEnum (octet3 addr)
186 oct4 = fromEnum (octet4 addr)
188 shifted_oct1 = oct1 * 2^(24 :: Integer)
189 shifted_oct2 = oct2 * 2^(16 :: Integer)
190 shifted_oct3 = oct3 * 2^(8 :: Integer)
194 -- | Convert an 'Int' @x@ to an 'IPv4Address'. Each octet of @x@ is
195 -- right-shifted by the appropriate number of bits, and the fractional
197 ipv4address_from_int :: Int -> Maybe IPv4Address
198 ipv4address_from_int x
199 | (x < 0) || (x > 2^(32 :: Integer) - 1) = Nothing
201 -- If the algebra is right, none of these octet_from_int calls
202 -- below can fail since 0 <= x <= 2^32 - 1.
203 oct1 <- octet_from_int shifted_x1
204 oct2 <- octet_from_int shifted_x2
205 oct3 <- octet_from_int shifted_x3
206 oct4 <- octet_from_int x4
207 return $ IPv4Address oct1 oct2 oct3 oct4
209 -- Chop off the higher octets. x1 = x `mod` 2^32, would be
211 x2 = x `mod` 2^(24 :: Integer)
212 x3 = x `mod` 2^(16 :: Integer)
213 x4 = x `mod` 2^(8 :: Integer)
214 -- Perform right-shifts. x4 doesn't need a shift.
215 shifted_x1 = x `quot` 2^(24 :: Integer)
216 shifted_x2 = x2 `quot` 2^(16 :: Integer)
217 shifted_x3 = x3 `quot` 2^(8 :: Integer)
220 instance Enum IPv4Address where
221 -- We're supposed to throw a runtime error if you call (succ
222 -- maxBound), so the fromJust here doesn't introduce any additional
224 toEnum = fromJust . ipv4address_from_int
225 fromEnum = ipv4address_to_int
227 -- | Given two addresses, find the number of the most significant bit
228 -- where they differ. If the addresses are the same, return
230 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
231 most_sig_bit_different addr1 addr2
232 | addr1 == addr2 = Maskbits.Zero
233 | m1 /= n1 = Maskbits.One
243 | m11 /= n11 = Eleven
244 | m12 /= n12 = Twelve
245 | m13 /= n13 = Thirteen
246 | m14 /= n14 = Fourteen
247 | m15 /= n15 = Fifteen
248 | m16 /= n16 = Sixteen
249 | m17 /= n17 = Seventeen
250 | m18 /= n18 = Eighteen
251 | m19 /= n19 = Nineteen
252 | m20 /= n20 = Twenty
253 | m21 /= n21 = TwentyOne
254 | m22 /= n22 = TwentyTwo
255 | m23 /= n23 = TwentyThree
256 | m24 /= n24 = TwentyFour
257 | m25 /= n25 = TwentyFive
258 | m26 /= n26 = TwentySix
259 | m27 /= n27 = TwentySeven
260 | m28 /= n28 = TwentyEight
261 | m29 /= n29 = TwentyNine
262 | m30 /= n30 = Thirty
263 | m31 /= n31 = ThirtyOne
264 | m32 /= n32 = ThirtyTwo
265 | otherwise = Maskbits.Zero
299 oct1a = (octet1 addr1)
300 oct2a = (octet2 addr1)
301 oct3a = (octet3 addr1)
302 oct4a = (octet4 addr1)
335 oct1b = (octet1 addr2)
336 oct2b = (octet2 addr2)
337 oct3b = (octet3 addr2)
338 oct4b = (octet4 addr2)
342 ipv4address_tests :: Test
344 testGroup "IPv4 Address Tests" [
348 test_most_sig_bit_different1,
349 test_most_sig_bit_different2,
352 ipv4address_properties :: Test
353 ipv4address_properties =
355 "IPv4 Address Properties "
357 "fromEnum/toEnum are inverses"
358 prop_from_enum_to_enum_inverses ]
360 -- QuickCheck properties
361 prop_from_enum_to_enum_inverses :: Int -> Property
362 prop_from_enum_to_enum_inverses x =
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 = fromJust $ octet_from_int a
372 oct2 = fromJust $ octet_from_int b
373 oct3 = fromJust $ octet_from_int c
374 oct4 = fromJust $ octet_from_int d
376 test_minBound :: Test
378 testCase desc $ assertEqual desc expected actual
380 desc = "minBound should be 0.0.0.0"
381 expected = mk_testaddr 0 0 0 0
382 actual = minBound :: IPv4Address
384 test_maxBound :: Test
386 testCase desc $ assertEqual desc expected actual
388 desc = "maxBound should be 255.255.255.255"
389 expected = mk_testaddr 255 255 255 255
390 actual = maxBound :: IPv4Address
394 testCase desc $ assertEqual desc expected actual
396 desc = "enumerating a /24 gives the correct addresses"
397 expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ]
398 lb = mk_testaddr 192 168 0 0
399 ub = mk_testaddr 192 168 0 255
400 actual = map show [lb..ub]
402 test_most_sig_bit_different1 :: Test
403 test_most_sig_bit_different1 =
404 testCase desc $ assertEqual desc
408 desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
409 addr1 = mk_testaddr 10 1 1 0
410 addr2 = (mk_testaddr 10 1 0 0)
411 bit = most_sig_bit_different addr1 addr2
415 test_most_sig_bit_different2 :: Test
416 test_most_sig_bit_different2 =
417 testCase desc $ assertEqual desc
421 desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
422 addr1 = mk_testaddr 10 1 2 0
423 addr2 = mk_testaddr 10 1 1 0
424 bit = most_sig_bit_different addr1 addr2
429 testCase desc $ assertEqual desc expected actual
431 desc = "192.168.0.0 in base-10 is 3232235520"
432 expected = mk_testaddr 192 168 0 0
433 actual = toEnum 3232235520