1 -- | The CIDR modules contains most of the functions used for working
22 import Data.List (nubBy)
23 import Data.List.Split (splitOneOf)
24 import Data.Maybe (catMaybes, mapMaybe)
26 import Test.Tasty ( TestTree, testGroup )
27 import Test.Tasty.HUnit ( (@?=), testCase )
28 import Test.Tasty.QuickCheck (
29 Arbitrary( arbitrary ),
34 import Text.Read (readMaybe)
36 import qualified Bit as B (Bit(..))
38 IPv4Address( IPv4Address, octet1, octet2, octet3, octet4 ),
39 most_sig_bit_different )
40 import Maskable (Maskable(apply_mask))
41 import Maskbits ( Maskbits(Zero) )
42 import Octet (Octet())
45 data Cidr = Cidr { ipv4address :: IPv4Address,
46 maskbits :: Maskbits }
49 instance Show Cidr where
50 show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
53 instance Arbitrary Cidr where
55 ipv4 <- arbitrary :: Gen IPv4Address
56 mask <- arbitrary :: Gen Maskbits
57 return (Cidr ipv4 mask)
60 instance Eq Cidr where
61 cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
64 -- | Two CIDR ranges are equivalent if they have the same network bits
65 -- and the masks are the same.
66 equivalent :: Cidr -> Cidr -> Bool
67 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
68 (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
70 -- | Returns the mask portion of a CIDR address. That is, everything
71 -- after the trailing slash.
72 maskbits_from_cidr_string :: String -> Maybe Maskbits
73 maskbits_from_cidr_string s
74 | length partlist == 2 = readMaybe (partlist !! 1)
77 partlist = splitOneOf "/" s
80 -- | Takes an IP address String in CIDR notation, and returns a list
81 -- of its octets (as Ints).
82 octets_from_cidr_string :: String -> [Octet]
83 octets_from_cidr_string s =
85 (p1:p2:p3:p4:_) -> mapMaybe readMaybe [p1,p2,p3,p4]
88 parts = splitOneOf "./" s
90 instance Read Cidr where
91 -- | Parse everything or nothing.
93 case (octets_from_cidr_string s) of
94 [oct1, oct2, oct3, oct4] ->
95 case (maskbits_from_cidr_string s) of
97 [(Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits, "")]
102 -- | Given a CIDR, return the minimum valid IPv4 address contained
104 min_host :: Cidr -> IPv4Address
105 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
107 -- | Given a CIDR, return the maximum valid IPv4 address contained
109 max_host :: Cidr -> IPv4Address
110 max_host (Cidr addr mask) = apply_mask addr mask B.One
112 -- | Given a CIDR, return the first octet of the minimum valid IPv4
113 -- address contained within it.
114 min_octet1 :: Cidr -> Octet
115 min_octet1 cidr = octet1 (min_host cidr)
117 -- | Given a CIDR, return the second octet of the minimum valid IPv4
118 -- address contained within it.
119 min_octet2 :: Cidr -> Octet
120 min_octet2 cidr = octet2 (min_host cidr)
122 -- | Given a CIDR, return the third octet of the minimum valid IPv4
123 -- address contained within it.
124 min_octet3 :: Cidr -> Octet
125 min_octet3 cidr = octet3 (min_host cidr)
127 -- | Given a CIDR, return the fourth octet of the minimum valid IPv4
128 -- address contained within it.
129 min_octet4 :: Cidr -> Octet
130 min_octet4 cidr = octet4 (min_host cidr)
132 -- | Given a CIDR, return the first octet of the maximum valid IPv4
133 -- address contained within it.
134 max_octet1 :: Cidr -> Octet
135 max_octet1 cidr = octet1 (max_host cidr)
137 -- | Given a CIDR, return the second octet of the maximum valid IPv4
138 -- address contained within it.
139 max_octet2 :: Cidr -> Octet
140 max_octet2 cidr = octet2 (max_host cidr)
142 -- | Given a CIDR, return the third octet of the maximum valid IPv4
143 -- address contained within it.
144 max_octet3 :: Cidr -> Octet
145 max_octet3 cidr = octet3 (max_host cidr)
147 -- | Given a CIDR, return the fourth octet of the maximum valid IPv4
148 -- address contained within it.
149 max_octet4 :: Cidr -> Octet
150 max_octet4 cidr = octet4 (max_host cidr)
154 -- | Return true if the first argument (a CIDR range) contains the
155 -- second (another CIDR range). There are a lot of ways we can be
156 -- fed junk here. For lack of a better alternative, just return
157 -- False when we are given nonsense.
159 -- If the number of bits in the network part of the first address is
160 -- larger than the number of bits in the second, there is no way
161 -- that the first range can contain the second. For, if the number
162 -- of network bits is larger, then the number of host bits must be
163 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
164 -- certainly does not contain cidr2.
166 -- On the other hand, if the first argument (cidr1) has fewer (or
167 -- the same number of) network bits as the second, it can contain
168 -- the second. In this case, we need to check that every host in
169 -- cidr2 is contained in cidr1. If a host in cidr2 is contained in
170 -- cidr1, then at least mbits1 of an address in cidr2 will match
171 -- cidr1. For example,
173 -- cidr1 = 192.168.1.0\/23, cidr2 = 192.168.1.100\/24
175 -- Here, cidr2 contains all of 192.168.1.0 through
176 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
177 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
178 -- what we want to check is that cidr2 "begins with" something that
179 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
180 -- cidr2 DOES, cidr1 contains cidr2..
182 -- The way that we check this is to apply cidr1's mask to cidr2's
183 -- address and see if the result is the same as cidr1's mask applied
184 -- to cidr1's address.
186 contains :: Cidr -> Cidr -> Bool
187 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
188 | mbits1 > mbits2 = False
189 | otherwise = addr1masked == addr2masked
191 addr1masked = apply_mask addr1 mbits1 B.Zero
192 addr2masked = apply_mask addr2 mbits1 B.Zero
195 -- | Contains but is not equal to.
196 contains_proper :: Cidr -> Cidr -> Bool
197 contains_proper cidr1 cidr2 =
198 (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
201 -- | A CIDR range is redundant (with respect to the given list) if
202 -- another CIDR range in that list properly contains it.
203 redundant :: [Cidr] -> Cidr -> Bool
204 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
207 -- | First, we look at all possible pairs of cidrs, and combine the
208 -- adjacent ones in to a new list. Then, we concatenate that list
209 -- with the original one, and filter out all of the redundancies. If
210 -- two adjacent Cidrs are combined into a larger one, they will be
211 -- removed in the second step since the larger Cidr must contain the
214 -- Once this is done, we see whether or not the result is different
215 -- than the argument that was passed in. If nothing changed, we're
216 -- done and return the list that was passed to us. However, if
217 -- something changed, we recurse and try to combine the list again.
218 combine_all :: [Cidr] -> [Cidr]
220 | cidrs == (combine_contained unique_cidrs) = cidrs
221 | otherwise = combine_all (combine_contained unique_cidrs)
223 unique_cidrs = nubBy equivalent cidr_combinations
225 cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
228 -- | Take a list of CIDR ranges and filter out all of the ones that
229 -- are contained entirelt within some other range in the list.
230 combine_contained :: [Cidr] -> [Cidr]
231 combine_contained cidrs =
232 filter (not . (redundant cidrs)) cidrs
235 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
236 -- decrement the maskbits of cidr1 and return that; it will contain
237 -- both cidr1 and cidr2.
238 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
239 combine_adjacent cidr1 cidr2
240 | not (adjacent cidr1 cidr2) = Nothing
241 | (maskbits cidr1 == Zero) = Nothing
242 | otherwise = Just $ cidr1 { maskbits = pred (maskbits cidr1) }
246 -- | Determine whether or not two CIDR ranges are adjacent. If two
247 -- ranges lie consecutively within the IP space, they can be
248 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
249 -- and can be combined in to 10.1.0.0/23.
250 adjacent :: Cidr -> Cidr -> Bool
252 | mbits1 /= mbits2 = False
253 | mbits1 == Maskbits.Zero = False -- They're equal.
254 | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
256 addr1 = ipv4address cidr1
257 addr2 = ipv4address cidr2
258 mbits1 = maskbits cidr1
259 mbits2 = maskbits cidr2
262 enumerate :: Cidr -> [IPv4Address]
263 enumerate cidr = [(min_host cidr)..(max_host cidr)]
266 -- | Replace any masked bits in this CIDR's IPv4Address with zeros.
267 normalize :: Cidr -> Cidr
268 normalize (Cidr addr mask) =
271 nrml_addr = apply_mask addr mask B.Zero
274 cidr_tests :: TestTree
276 testGroup "CIDR Tests" [
283 test_contains_proper1,
284 test_contains_proper2,
289 test_combine_contained1,
290 test_combine_contained2,
298 cidr_properties :: TestTree
300 testGroup "CIDR Properties" [
301 prop_all_cidrs_contain_themselves,
302 prop_contains_proper_antisymmetric,
303 prop_normalize_idempotent ]
307 test_enumerate :: TestTree
309 testCase desc $ actual @?= expected
311 desc = "192.168.0.240/30 is enumerated correctly"
312 oct1 = toEnum 192 :: Octet
313 oct2 = toEnum 168 :: Octet
314 oct3 = minBound :: Octet
315 mk_ip = IPv4Address oct1 oct2 oct3
316 addr1 = mk_ip $ toEnum 240
317 addr2 = mk_ip $ toEnum 241
318 addr3 = mk_ip $ toEnum 242
319 addr4 = mk_ip $ toEnum 243
320 expected = [addr1, addr2, addr3, addr4]
321 actual = enumerate (read "192.168.0.240/30" :: Cidr)
323 test_min_host1 :: TestTree
325 testCase desc $ actual @?= expected
327 desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
328 actual = show $ min_host (read "10.0.0.0/24" :: Cidr)
329 expected = "10.0.0.0"
332 test_max_host1 :: TestTree
334 testCase desc $ actual @?= expected
336 desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
337 actual = show $ max_host (read "10.0.0.0/24" :: Cidr)
338 expected = "10.0.0.255"
341 test_equality1 :: TestTree
343 testCase desc $ actual @?= expected
345 desc = "10.1.1.0/23 equals itself"
346 actual = read "10.1.1.0/23" :: Cidr
347 expected = read "10.1.1.0/23" :: Cidr
350 test_contains1 :: TestTree
352 testCase desc $ actual @?= expected
354 desc = "10.1.1.0/23 contains 10.1.1.0/24"
355 cidr1 = read "10.1.1.0/23" :: Cidr
356 cidr2 = read "10.1.1.0/24" :: Cidr
358 actual = cidr1 `contains` cidr2
361 test_contains2 :: TestTree
363 testCase desc $ actual @?= expected
365 desc = "10.1.1.0/23 contains itself"
366 cidr1 = read "10.1.1.0/23" :: Cidr
368 actual = cidr1 `contains` cidr1
371 test_contains_proper1 :: TestTree
372 test_contains_proper1 =
373 testCase desc $ actual @?= expected
375 desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
376 cidr1 = read "10.1.1.0/23" :: Cidr
377 cidr2 = read "10.1.1.0/24" :: Cidr
379 actual = cidr1 `contains_proper` cidr2
382 test_contains_proper2 :: TestTree
383 test_contains_proper2 =
384 testCase desc $ actual @?= expected
386 desc = "10.1.1.0/23 does not contain itself properly"
387 cidr1 = read "10.1.1.0/23" :: Cidr
389 actual = cidr1 `contains_proper` cidr1
392 test_adjacent1 :: TestTree
394 testCase desc $ actual @?= expected
396 desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
397 cidr1 = read "10.1.0.0/24" :: Cidr
398 cidr2 = read "10.1.1.0/24" :: Cidr
400 actual = cidr1 `adjacent` cidr2
403 test_adjacent2 :: TestTree
405 testCase desc $ actual @?= expected
407 desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
408 cidr1 = read "10.1.0.0/23" :: Cidr
409 cidr2 = read "10.1.0.0/24" :: Cidr
411 actual = cidr1 `adjacent` cidr2
414 test_adjacent3 :: TestTree
416 testCase desc $ actual @?= expected
418 desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
419 cidr1 = read "10.1.0.0/24" :: Cidr
420 cidr2 = read "10.2.5.0/24" :: Cidr
422 actual = cidr1 `adjacent` cidr2
425 test_adjacent4 :: TestTree
427 testCase desc $ actual @?= expected
429 desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
430 cidr1 = read "10.1.1.0/24" :: Cidr
431 cidr2 = read "10.1.2.0/24" :: Cidr
433 actual = cidr1 `adjacent` cidr2
435 test_combine_contained1 :: TestTree
436 test_combine_contained1 =
437 testCase desc $ actual @?= expected
439 desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
440 cidr1 = read "10.0.0.0/8" :: Cidr
441 cidr2 = read "10.1.0.0/16" :: Cidr
442 cidr3 = read "10.1.1.0/24" :: Cidr
443 test_cidrs = [cidr1, cidr2, cidr3]
445 actual = combine_contained test_cidrs
447 test_combine_contained2 :: TestTree
448 test_combine_contained2 =
449 testCase desc $ actual @?= expected
451 desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
452 cidr1 = read "192.168.3.0/23" :: Cidr
453 cidr2 = read "192.168.1.0/24" :: Cidr
454 expected = [cidr1, cidr2]
455 actual = combine_contained [cidr1, cidr2]
458 test_combine_all1 :: TestTree
460 testCase desc $ actual @?= expected
462 desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
463 ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
464 cidr1 = read "10.0.0.0/24" :: Cidr
465 cidr2 = read "10.0.1.0/24" :: Cidr
466 cidr3 = read "10.0.2.0/24" :: Cidr
467 cidr4 = read "10.0.3.0/23" :: Cidr
468 cidr5 = read "10.0.0.0/23" :: Cidr
469 test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
470 expected = [read "10.0.0.0/22" :: Cidr]
471 actual = combine_all test_cidrs
474 test_combine_all2 :: TestTree
476 testCase desc $ actual @?= expected
478 desc = "127.0.0.1/32 combines with itself recursively"
479 cidr1 = read "127.0.0.1/32" :: Cidr
480 test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
482 actual = combine_all test_cidrs
485 test_combine_all3 :: TestTree
487 testCase desc $ actual @?= expected
489 desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
490 ++ "10.0.0.19 get combined into 10.0.0.16/30"
491 cidr1 = read "10.0.0.16/32" :: Cidr
492 cidr2 = read "10.0.0.17/32" :: Cidr
493 cidr3 = read "10.0.0.18/32" :: Cidr
494 cidr4 = read "10.0.0.19/32" :: Cidr
495 test_cidrs = [cidr1, cidr2, cidr3, cidr4]
496 expected = [read "10.0.0.16/30" :: Cidr]
497 actual = combine_all test_cidrs
499 test_normalize1 :: TestTree
501 testCase desc $ actual @?= expected
503 desc = "127.0.0.1/8 normalized is 127.0.0.0/8"
504 expected = read "127.0.0.0/8" :: Cidr
505 actual = normalize (read "127.0.0.1/8" :: Cidr)
508 test_normalize2 :: TestTree
510 testCase desc $ actual @?= expected
512 desc = "192.168.1.101/24 normalized is 192.168.1.0/24"
513 expected = read "192.168.1.0/24" :: Cidr
514 actual = normalize (read "192.168.1.101/24" :: Cidr)
516 test_normalize3 :: TestTree
518 testCase desc $ actual @?= expected
520 desc = "10.10.10.10/22 normalized is 10.10.8.0/22"
521 expected = read "10.10.8.0/22" :: Cidr
522 actual = normalize (read "10.10.10.10/22" :: Cidr)
525 prop_all_cidrs_contain_themselves :: TestTree
526 prop_all_cidrs_contain_themselves =
527 testProperty "All CIDRs contain themselves" prop
530 prop cidr1 = cidr1 `contains` cidr1
533 -- If cidr1 properly contains cidr2, then by definition cidr2
534 -- does not properly contain cidr1.
535 prop_contains_proper_antisymmetric :: TestTree
536 prop_contains_proper_antisymmetric =
537 testProperty "CIDR proper containment is an antisymmetric relation" prop
539 prop :: Cidr -> Cidr -> Property
541 (cidr1 `contains_proper` cidr2) ==>
542 (not (cidr2 `contains_proper` cidr1))
545 -- Running "normalize" a second time shouldn't do anything.
546 prop_normalize_idempotent :: TestTree
547 prop_normalize_idempotent =
548 testProperty "The CIDR \"normalize\" function is idempotent " prop
551 prop cidr = (normalize cidr) == (normalize (normalize cidr))