16 prop_all_cidrs_contain_themselves,
17 prop_contains_proper_intransitive
20 import Data.List (nubBy)
21 import Data.Maybe (catMaybes, fromJust)
23 import Test.QuickCheck
25 import qualified Bit as B
33 data Cidr = Cidr { ipv4address :: IPv4Address,
34 maskbits :: Maskbits }
38 instance Show Cidr where
39 show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
42 instance Arbitrary Cidr where
44 ipv4 <- arbitrary :: Gen IPv4Address
45 mask <- arbitrary :: Gen Maskbits
46 return (Cidr ipv4 mask)
49 instance Eq Cidr where
50 cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
53 -- Two CIDR ranges are equivalent if they have the same network bits
54 -- and the masks are the same.
55 equivalent :: Cidr -> Cidr -> Bool
56 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
57 (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
59 -- Returns the mask portion of a CIDR address. That is, everything
60 -- after the trailing slash.
61 maskbits_from_cidr_string :: String -> Maybe Maskbits
62 maskbits_from_cidr_string s
63 | length partlist == 2 = maskbits_from_string (partlist !! 1)
66 partlist = (splitWith (`elem` "/") s)
69 -- | Takes an IP address String in CIDR notation, and returns a list
70 -- of its octets (as Ints).
71 octets_from_cidr_string :: String -> [Octet]
72 octets_from_cidr_string s =
73 catMaybes $ map octet_from_string (take 4 (splitWith (`elem` "./") s))
76 -- | Return Nothing if we can't parse both maskbits and octets from
78 cidr_from_string :: String -> Maybe Cidr
80 case (octets_from_cidr_string s) of
81 [oct1, oct2, oct3, oct4] ->
82 case (maskbits_from_cidr_string s) of
84 Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
90 min_host :: Cidr -> IPv4Address
91 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
94 max_host :: Cidr -> IPv4Address
95 max_host (Cidr addr mask) = apply_mask addr mask B.One
98 min_octet1 :: Cidr -> Octet
99 min_octet1 cidr = octet1 (min_host cidr)
101 min_octet2 :: Cidr -> Octet
102 min_octet2 cidr = octet2 (min_host cidr)
104 min_octet3 :: Cidr -> Octet
105 min_octet3 cidr = octet3 (min_host cidr)
107 min_octet4 :: Cidr -> Octet
108 min_octet4 cidr = octet4 (min_host cidr)
110 max_octet1 :: Cidr -> Octet
111 max_octet1 cidr = octet1 (max_host cidr)
113 max_octet2 :: Cidr -> Octet
114 max_octet2 cidr = octet2 (max_host cidr)
116 max_octet3 :: Cidr -> Octet
117 max_octet3 cidr = octet3 (max_host cidr)
119 max_octet4 :: Cidr -> Octet
120 max_octet4 cidr = octet4 (max_host cidr)
124 -- | Return true if the first argument (a CIDR range) contains the
125 -- second (another CIDR range). There are a lot of ways we can be
126 -- fed junk here. For lack of a better alternative, just return
127 -- False when we are given nonsense.
129 -- If the number of bits in the network part of the first address is
130 -- larger than the number of bits in the second, there is no way
131 -- that the first range can contain the second. For, if the number
132 -- of network bits is larger, then the number of host bits must be
133 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
134 -- certainly does not contain cidr2.
136 -- On the other hand, if the first argument (cidr1) has fewer (or
137 -- the same number of) network bits as the second, it can contain
138 -- the second. In this case, we need to check that every host in
139 -- cidr2 is contained in cidr1. If a host in cidr2 is contained in
140 -- cidr1, then at least mbits1 of an address in cidr2 will match
141 -- cidr1. For example,
143 -- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
145 -- Here, cidr2 contains all of 192.168.1.0 through
146 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
147 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
148 -- what we want to check is that cidr2 "begins with" something that
149 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
150 -- cidr2 DOES, cidr1 contains cidr2..
152 -- The way that we check this is to apply cidr1's mask to cidr2's
153 -- address and see if the result is the same as cidr1's mask applied
154 -- to cidr1's address.
156 contains :: Cidr -> Cidr -> Bool
157 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
158 | mbits1 > mbits2 = False
159 | otherwise = addr1masked == addr2masked
161 addr1masked = apply_mask addr1 mbits1 B.Zero
162 addr2masked = apply_mask addr2 mbits1 B.Zero
165 contains_proper :: Cidr -> Cidr -> Bool
166 contains_proper cidr1 cidr2 =
167 (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
170 -- | A CIDR range is redundant (with respect to the given list) if
171 -- another CIDR range in that list properly contains it.
172 redundant :: [Cidr] -> Cidr -> Bool
173 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
176 -- | First, we look at all possible pairs of cidrs, and combine the
177 -- adjacent ones in to a new list. Then, we concatenate that list
178 -- with the original one, and filter out all of the redundancies. If
179 -- two adjacent Cidrs are combined into a larger one, they will be
180 -- removed in the second step since the larger Cidr must contain the
183 -- Once this is done, we see whether or not the result is different
184 -- than the argument that was passed in. If nothing changed, we're
185 -- done and return the list that was passed to us. However, if
186 -- something changed, we recurse and try to combine the list again.
187 combine_all :: [Cidr] -> [Cidr]
189 | cidrs == (combine_contained unique_cidrs) = cidrs
190 | otherwise = combine_all (combine_contained unique_cidrs)
192 unique_cidrs = nubBy equivalent cidr_combinations
194 cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
197 -- | Take a list of CIDR ranges and filter out all of the ones that
198 -- are contained entirelt within some other range in the list.
199 combine_contained :: [Cidr] -> [Cidr]
200 combine_contained cidrs =
201 filter (not . (redundant cidrs)) cidrs
204 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
205 -- decrement the maskbits of cidr1 and return that; it will contain
206 -- both cidr1 and cidr2.
207 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
208 combine_adjacent cidr1 cidr2
209 | not (adjacent cidr1 cidr2) = Nothing
210 | (maskbits cidr1 == Zero) = Nothing
211 | otherwise = Just $ cidr1 { maskbits = decrement (maskbits cidr1) }
215 -- | Determine whether or not two CIDR ranges are adjacent. If two
216 -- ranges lie consecutively within the IP space, they can be
217 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
218 -- and can be combined in to 10.1.0.0/23.
219 adjacent :: Cidr -> Cidr -> Bool
221 | mbits1 /= mbits2 = False
222 | mbits1 == Maskbits.Zero = False -- They're equal.
223 | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
225 addr1 = ipv4address cidr1
226 addr2 = ipv4address cidr2
227 mbits1 = maskbits cidr1
228 mbits2 = maskbits cidr2
236 test_min_host1 :: Test
238 TestCase $ assertEqual "The minimum host in 10.0.0.0/24 is 10.0.0.0"
242 actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
243 expected = "10.0.0.0"
246 test_max_host1 :: Test
248 TestCase $ assertEqual "The maximum host in 10.0.0.0/24 is 10.0.0.255"
252 actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
253 expected = "10.0.0.255"
256 test_equality1 :: Test
260 "10.1.1.0/23 equals itself"
264 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
267 test_contains1 :: Test
271 "10.1.1.0/23 contains 10.1.1.0/24"
273 (cidr1 `contains` cidr2)
275 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
276 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
279 test_contains2 :: Test
283 "10.1.1.0/23 contains itself"
285 (cidr1 `contains` cidr1)
287 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
290 test_contains_proper1 :: Test
291 test_contains_proper1 =
294 "10.1.1.0/23 contains 10.1.1.0/24 properly"
296 (cidr1 `contains_proper` cidr2)
298 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
299 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
302 test_contains_proper2 :: Test
303 test_contains_proper2 =
306 "10.1.1.0/23 does not contain itself properly"
308 (cidr1 `contains_proper` cidr1)
310 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
313 test_adjacent1 :: Test
317 "10.1.0.0/24 is adjacent to 10.1.1.0/24"
319 (cidr1 `adjacent` cidr2)
321 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
322 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
325 test_adjacent2 :: Test
329 "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
331 (cidr1 `adjacent` cidr2)
333 cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
334 cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
337 test_adjacent3 :: Test
341 "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
343 (cidr1 `adjacent` cidr2)
345 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
346 cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
349 test_adjacent4 :: Test
353 "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
355 (cidr1 `adjacent` cidr2)
357 cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
358 cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
361 test_combine_contained1 :: Test
362 test_combine_contained1 =
365 "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
367 (combine_contained test_cidrs)
369 cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
370 cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
371 cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
372 expected_cidrs = [cidr1]
373 test_cidrs = [cidr1, cidr2, cidr3]
376 test_combine_contained2 :: Test
377 test_combine_contained2 =
380 "192.168.3.0/23 does not contain 192.168.1.0/24"
382 (combine_contained [cidr1, cidr2])
384 cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
385 cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
388 test_combine_all1 :: Test
392 "10.0.0.0/24 is adjacent to 10.0.1.0/24 and 10.0.3.0/23 contains 10.0.2.0/24"
394 (combine_all test_cidrs)
396 cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
397 cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
398 cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
399 cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
400 cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
401 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
402 test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
405 test_combine_all2 :: Test
409 "127.0.0.1/32 combines with itself recursively"
411 (combine_all test_cidrs)
413 cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
414 expected_cidrs = [cidr1]
415 test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
418 test_combine_all3 :: Test
422 "10.0.0.16, 10.0.0.17, 10.0.0.18, and 10.0.0.19 get combined into 10.0.0.16/30"
424 (combine_all test_cidrs)
426 cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
427 cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
428 cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
429 cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
430 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
431 test_cidrs = [cidr1, cidr2, cidr3, cidr4]
435 cidr_tests = [ test_min_host1,
440 test_contains_proper1,
441 test_contains_proper2,
446 test_combine_contained1,
447 test_combine_contained2,
455 prop_all_cidrs_contain_themselves :: Cidr -> Bool
456 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
459 -- If cidr1 properly contains cidr2, then by definition cidr2
460 -- does not properly contain cidr1.
461 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
462 prop_contains_proper_intransitive cidr1 cidr2 =
463 (cidr1 `contains_proper` cidr2) ==>
464 (not (cidr2 `contains_proper` cidr1))