src/Cidr.hs

   1 -- | The CIDR modules contains most of the functions used for working
   2 --   with the CIDR type.
   3 module Cidr
   4 ( Cidr(..),
   5   cidr_properties,
   6   cidr_tests,
   7   combine_all,
   8   contains,
   9   contains_proper,
  10   enumerate,
  11   max_octet1,
  12   max_octet2,
  13   max_octet3,
  14   max_octet4,
  15   min_octet1,
  16   min_octet2,
  17   min_octet3,
  18   min_octet4,
  19   normalize
  20 ) where
  21
  22 import Data.List (nub)
  23 import Data.List.Split (splitOneOf)
  24 import Data.Maybe (catMaybes, mapMaybe)
  25
  26 import Test.Tasty ( TestTree, localOption, testGroup )
  27 import Test.Tasty.HUnit ( (@?=), testCase )
  28 import Test.Tasty.QuickCheck (
  29   Arbitrary( arbitrary ),
  30   Gen,
  31   Property,
  32   QuickCheckTests( QuickCheckTests ),
  33   (==>),
  34   testProperty )
  35 import Text.Read (readMaybe)
  36
  37 import qualified Bit as B (Bit(..))
  38 import IPv4Address (
  39   IPv4Address( IPv4Address, octet1, octet2, octet3, octet4 ),
  40   most_sig_bit_different )
  41 import Maskable (Maskable(apply_mask))
  42 import Maskbits ( Maskbits(Zero) )
  43 import Octet (Octet())
  44
  45
  46 data Cidr = Cidr { ipv4address :: IPv4Address,
  47                    maskbits :: Maskbits }
  48
  49
  50 instance Show Cidr where
  51     show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
  52
  53
  54 instance Arbitrary Cidr where
  55     arbitrary = do
  56       ipv4 <- arbitrary :: Gen IPv4Address
  57       mask <- arbitrary :: Gen Maskbits
  58       return (Cidr ipv4 mask)
  59
  60
  61 instance Eq Cidr where
  62   -- | Two CIDRs are equal if they have the same network bits and if
  63   --   their masks are the same. In other words, if they are the same
  64   --   after normalization.
  65   cidr1 == cidr2 = (cidr1 <= cidr2) && (cidr2 <= cidr1)
  66
  67 instance Ord Cidr where
  68   cidr1 <= cidr2 = if addr1 == addr2 then mask1 <= mask2 else addr1 <= addr2
  69     where
  70       Cidr addr1 mask1 = normalize cidr1
  71       Cidr addr2 mask2 = normalize cidr2
  72
  73 -- | Returns the mask portion of a CIDR address. That is, everything
  74 --   after the trailing slash.
  75 maskbits_from_cidr_string :: String -> Maybe Maskbits
  76 maskbits_from_cidr_string s
  77   | length partlist == 2 = readMaybe (partlist !! 1)
  78   | otherwise = Nothing
  79     where
  80       partlist = splitOneOf "/" s
  81
  82
  83 -- | Takes an IP address String in CIDR notation, and returns a list
  84 --   of its octets (as Ints).
  85 octets_from_cidr_string :: String -> [Octet]
  86 octets_from_cidr_string s =
  87   case parts of
  88     (p1:p2:p3:p4:_) -> mapMaybe readMaybe [p1,p2,p3,p4]
  89     _ -> []
  90   where
  91     parts = splitOneOf "./" s
  92
  93 instance Read Cidr where
  94   -- | Parse everything or nothing.
  95   readsPrec _ s =
  96     case (octets_from_cidr_string s) of
  97       [oct1, oct2, oct3, oct4] ->
  98         case (maskbits_from_cidr_string s) of
  99           Just mbits ->
 100             [(Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits, "")]
 101           _ -> []
 102       _ -> []
 103
 104
 105 -- | Given a CIDR, return the minimum valid IPv4 address contained
 106 --   within it.
 107 min_host :: Cidr -> IPv4Address
 108 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
 109
 110 -- | Given a CIDR, return the maximum valid IPv4 address contained
 111 --   within it.
 112 max_host :: Cidr -> IPv4Address
 113 max_host (Cidr addr mask) = apply_mask addr mask B.One
 114
 115 -- | Given a CIDR, return the first octet of the minimum valid IPv4
 116 --   address contained within it.
 117 min_octet1 :: Cidr -> Octet
 118 min_octet1 cidr = octet1 (min_host cidr)
 119
 120 -- | Given a CIDR, return the second octet of the minimum valid IPv4
 121 --   address contained within it.
 122 min_octet2 :: Cidr -> Octet
 123 min_octet2 cidr = octet2 (min_host cidr)
 124
 125 -- | Given a CIDR, return the third octet of the minimum valid IPv4
 126 --   address contained within it.
 127 min_octet3 :: Cidr -> Octet
 128 min_octet3 cidr = octet3 (min_host cidr)
 129
 130 -- | Given a CIDR, return the fourth octet of the minimum valid IPv4
 131 --   address contained within it.
 132 min_octet4 :: Cidr -> Octet
 133 min_octet4 cidr = octet4 (min_host cidr)
 134
 135 -- | Given a CIDR, return the first octet of the maximum valid IPv4
 136 --   address contained within it.
 137 max_octet1 :: Cidr -> Octet
 138 max_octet1 cidr = octet1 (max_host cidr)
 139
 140 -- | Given a CIDR, return the second octet of the maximum valid IPv4
 141 --   address contained within it.
 142 max_octet2 :: Cidr -> Octet
 143 max_octet2 cidr = octet2 (max_host cidr)
 144
 145 -- | Given a CIDR, return the third octet of the maximum valid IPv4
 146 --   address contained within it.
 147 max_octet3 :: Cidr -> Octet
 148 max_octet3 cidr = octet3 (max_host cidr)
 149
 150 -- | Given a CIDR, return the fourth octet of the maximum valid IPv4
 151 --   address contained within it.
 152 max_octet4 :: Cidr -> Octet
 153 max_octet4 cidr = octet4 (max_host cidr)
 154
 155
 156
 157 -- | Return true if the first argument (a CIDR range) contains the
 158 --   second (another CIDR range). There are a lot of ways we can be
 159 --   fed junk here. For lack of a better alternative, just return
 160 --   False when we are given nonsense.
 161 --
 162 --   If the number of bits in the network part of the first address is
 163 --   larger than the number of bits in the second, there is no way
 164 --   that the first range can contain the second. For, if the number
 165 --   of network bits is larger, then the number of host bits must be
 166 --   smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
 167 --   certainly does not contain cidr2.
 168 --
 169 --   On the other hand, if the first argument (cidr1) has fewer (or
 170 --   the same number of) network bits as the second, it can contain
 171 --   the second. In this case, we need to check that every host in
 172 --   cidr2 is contained in cidr1. If a host in cidr2 is contained in
 173 --   cidr1, then at least mbits1 of an address in cidr2 will match
 174 --   cidr1. For example,
 175 --
 176 --   cidr1 = 192.168.1.0\/23, cidr2 = 192.168.1.100\/24
 177 --
 178 --   Here, cidr2 contains all of 192.168.1.0 through
 179 --   192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
 180 --   192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
 181 --   what we want to check is that cidr2 "begins with" something that
 182 --   cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
 183 --   cidr2 DOES, cidr1 contains cidr2..
 184 --
 185 --   The way that we check this is to apply cidr1's mask to cidr2's
 186 --   address and see if the result is the same as cidr1's mask applied
 187 --   to cidr1's address.
 188 --
 189 contains :: Cidr -> Cidr -> Bool
 190 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
 191   | mbits1 > mbits2 = False
 192   | otherwise = addr1masked == addr2masked
 193   where
 194     addr1masked = apply_mask addr1 mbits1 B.Zero
 195     addr2masked = apply_mask addr2 mbits1 B.Zero
 196
 197
 198 -- | Contains but is not equal to.
 199 contains_proper :: Cidr -> Cidr -> Bool
 200 contains_proper cidr1 cidr2 =
 201     (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
 202
 203
 204 -- | A CIDR range is redundant (with respect to the given list) if
 205 --   another CIDR range in that list properly contains it.
 206 redundant :: [Cidr] -> Cidr -> Bool
 207 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
 208
 209
 210 -- | First, we look at all possible pairs of cidrs, and combine the
 211 --   adjacent ones in to a new list. Then, we concatenate that list
 212 --   with the original one, and filter out all of the redundancies. If
 213 --   two adjacent Cidrs are combined into a larger one, they will be
 214 --   removed in the second step since the larger Cidr must contain the
 215 --   smaller two.
 216 --
 217 --   Once this is done, we see whether or not the result is different
 218 --   than the argument that was passed in. If nothing changed, we're
 219 --   done and return the list that was passed to us. However, if
 220 --   something changed, we recurse and try to combine the list again.
 221 combine_all :: [Cidr] -> [Cidr]
 222 combine_all cidrs
 223   | cidrs == (combine_contained unique_cidrs) = cidrs
 224   | otherwise = combine_all (combine_contained unique_cidrs)
 225     where
 226       unique_cidrs = nub cidr_combinations
 227       cidr_combinations =
 228         cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
 229
 230
 231 -- | Take a list of CIDR ranges and filter out all of the ones that
 232 --   are contained entirelt within some other range in the list.
 233 combine_contained :: [Cidr] -> [Cidr]
 234 combine_contained cidrs =
 235   filter (not . (redundant cidrs)) cidrs
 236
 237
 238 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
 239 --   decrement the maskbits of cidr1 and return that; it will contain
 240 --   both cidr1 and cidr2.
 241 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
 242 combine_adjacent cidr1 cidr2
 243   | not (adjacent cidr1 cidr2) = Nothing
 244   | (maskbits cidr1 == Zero) = Nothing
 245   | otherwise = Just $ cidr1 { maskbits = pred (maskbits cidr1) }
 246
 247
 248
 249 -- | Determine whether or not two CIDR ranges are adjacent. If two
 250 --   ranges lie consecutively within the IP space, they can be
 251 --   combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
 252 --   and can be combined in to 10.1.0.0/23.
 253 adjacent :: Cidr -> Cidr -> Bool
 254 adjacent cidr1 cidr2
 255   | mbits1 /= mbits2 = False
 256   | mbits1 == Maskbits.Zero = False -- They're equal.
 257   | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
 258   where
 259     addr1 = ipv4address cidr1
 260     addr2 = ipv4address cidr2
 261     mbits1 = maskbits cidr1
 262     mbits2 = maskbits cidr2
 263
 264
 265 enumerate :: Cidr -> [IPv4Address]
 266 enumerate cidr = [(min_host cidr)..(max_host cidr)]
 267
 268
 269 -- | Replace any masked bits in this CIDR's IPv4Address with zeros.
 270 normalize :: Cidr -> Cidr
 271 normalize (Cidr addr mask) =
 272   Cidr nrml_addr mask
 273   where
 274     nrml_addr = apply_mask addr mask B.Zero
 275
 276 -- Test lists.
 277 cidr_tests :: TestTree
 278 cidr_tests =
 279   testGroup "CIDR Tests" [
 280     test_enumerate,
 281     test_min_host1,
 282     test_max_host1,
 283     test_equality1,
 284     test_contains1,
 285     test_contains2,
 286     test_contains_proper1,
 287     test_contains_proper2,
 288     test_adjacent1,
 289     test_adjacent2,
 290     test_adjacent3,
 291     test_adjacent4,
 292     test_combine_contained1,
 293     test_combine_contained2,
 294     test_combine_all1,
 295     test_combine_all2,
 296     test_combine_all3,
 297     test_normalize1,
 298     test_normalize2,
 299     test_normalize3 ]
 300
 301 cidr_properties :: TestTree
 302 cidr_properties =
 303   testGroup "CIDR Properties" [
 304       prop_all_cidrs_contain_themselves,
 305       prop_contains_proper_antisymmetric,
 306       prop_normalize_idempotent,
 307       prop_normalize_preserves_equality,
 308       prop_ord_instance_antisymmetric,
 309       prop_ord_instance_reflexive,
 310       prop_ord_instance_transitive,
 311       prop_ord_uses_addr_when_masks_equal ]
 312
 313
 314 -- HUnit Tests
 315 test_enumerate :: TestTree
 316 test_enumerate =
 317   testCase desc $ actual @?= expected
 318   where
 319     desc = "192.168.0.240/30 is enumerated correctly"
 320     oct1 = toEnum 192 :: Octet
 321     oct2 = toEnum 168 :: Octet
 322     oct3 = minBound :: Octet
 323     mk_ip = IPv4Address oct1 oct2 oct3
 324     addr1 = mk_ip $ toEnum 240
 325     addr2 = mk_ip $ toEnum 241
 326     addr3 = mk_ip $ toEnum 242
 327     addr4 = mk_ip $ toEnum 243
 328     expected = [addr1, addr2, addr3, addr4]
 329     actual = enumerate (read "192.168.0.240/30" :: Cidr)
 330
 331 test_min_host1 :: TestTree
 332 test_min_host1 =
 333   testCase desc $ actual @?= expected
 334   where
 335     desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
 336     actual = show $ min_host (read "10.0.0.0/24" :: Cidr)
 337     expected = "10.0.0.0"
 338
 339
 340 test_max_host1 :: TestTree
 341 test_max_host1 =
 342   testCase desc $ actual @?= expected
 343   where
 344     desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
 345     actual = show $ max_host (read "10.0.0.0/24" :: Cidr)
 346     expected = "10.0.0.255"
 347
 348
 349 test_equality1 :: TestTree
 350 test_equality1 =
 351   testCase desc $ actual @?= expected
 352   where
 353     desc = "10.1.1.0/23 equals itself"
 354     actual = read "10.1.1.0/23" :: Cidr
 355     expected = read "10.1.1.0/23" :: Cidr
 356
 357
 358 test_contains1 :: TestTree
 359 test_contains1 =
 360   testCase desc $ actual @?= expected
 361   where
 362     desc = "10.1.1.0/23 contains 10.1.1.0/24"
 363     cidr1 = read "10.1.1.0/23" :: Cidr
 364     cidr2 = read "10.1.1.0/24" :: Cidr
 365     expected = True
 366     actual = cidr1 `contains` cidr2
 367
 368
 369 test_contains2 :: TestTree
 370 test_contains2 =
 371   testCase desc $ actual @?= expected
 372   where
 373     desc = "10.1.1.0/23 contains itself"
 374     cidr1 = read "10.1.1.0/23" :: Cidr
 375     expected = True
 376     actual = cidr1 `contains` cidr1
 377
 378
 379 test_contains_proper1 :: TestTree
 380 test_contains_proper1 =
 381   testCase desc $ actual @?= expected
 382   where
 383     desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
 384     cidr1 = read "10.1.1.0/23" :: Cidr
 385     cidr2 = read "10.1.1.0/24" :: Cidr
 386     expected = True
 387     actual = cidr1 `contains_proper` cidr2
 388
 389
 390 test_contains_proper2 :: TestTree
 391 test_contains_proper2 =
 392   testCase desc $ actual @?= expected
 393   where
 394     desc = "10.1.1.0/23 does not contain itself properly"
 395     cidr1 = read "10.1.1.0/23" :: Cidr
 396     expected = False
 397     actual = cidr1 `contains_proper` cidr1
 398
 399
 400 test_adjacent1 :: TestTree
 401 test_adjacent1 =
 402   testCase desc $ actual @?= expected
 403   where
 404     desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
 405     cidr1 = read "10.1.0.0/24" :: Cidr
 406     cidr2 = read "10.1.1.0/24" :: Cidr
 407     expected = True
 408     actual = cidr1 `adjacent` cidr2
 409
 410
 411 test_adjacent2 :: TestTree
 412 test_adjacent2 =
 413   testCase desc $ actual @?= expected
 414   where
 415     desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
 416     cidr1 = read "10.1.0.0/23" :: Cidr
 417     cidr2 = read "10.1.0.0/24" :: Cidr
 418     expected = False
 419     actual = cidr1 `adjacent` cidr2
 420
 421
 422 test_adjacent3 :: TestTree
 423 test_adjacent3 =
 424   testCase desc $ actual @?= expected
 425   where
 426     desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
 427     cidr1 = read "10.1.0.0/24" :: Cidr
 428     cidr2 = read "10.2.5.0/24" :: Cidr
 429     expected = False
 430     actual = cidr1 `adjacent` cidr2
 431
 432
 433 test_adjacent4 :: TestTree
 434 test_adjacent4 =
 435   testCase desc $ actual @?= expected
 436   where
 437     desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
 438     cidr1 = read "10.1.1.0/24" :: Cidr
 439     cidr2 = read "10.1.2.0/24" :: Cidr
 440     expected = False
 441     actual = cidr1 `adjacent` cidr2
 442
 443 test_combine_contained1 :: TestTree
 444 test_combine_contained1 =
 445   testCase desc $ actual @?= expected
 446   where
 447     desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
 448     cidr1 = read "10.0.0.0/8" :: Cidr
 449     cidr2 = read "10.1.0.0/16" :: Cidr
 450     cidr3 = read "10.1.1.0/24" :: Cidr
 451     test_cidrs = [cidr1, cidr2, cidr3]
 452     expected = [cidr1]
 453     actual = combine_contained test_cidrs
 454
 455 test_combine_contained2 :: TestTree
 456 test_combine_contained2 =
 457   testCase desc $ actual @?= expected
 458   where
 459     desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
 460     cidr1 = read "192.168.3.0/23" :: Cidr
 461     cidr2 = read "192.168.1.0/24" :: Cidr
 462     expected = [cidr1, cidr2]
 463     actual = combine_contained [cidr1, cidr2]
 464
 465
 466 test_combine_all1 :: TestTree
 467 test_combine_all1 =
 468   testCase desc $ actual @?= expected
 469   where
 470     desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
 471            ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
 472     cidr1 = read "10.0.0.0/24" :: Cidr
 473     cidr2 = read "10.0.1.0/24" :: Cidr
 474     cidr3 = read "10.0.2.0/24" :: Cidr
 475     cidr4 = read "10.0.3.0/23" :: Cidr
 476     cidr5 = read "10.0.0.0/23" :: Cidr
 477     test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
 478     expected = [read "10.0.0.0/22" :: Cidr]
 479     actual = combine_all test_cidrs
 480
 481
 482 test_combine_all2 :: TestTree
 483 test_combine_all2 =
 484   testCase desc $ actual @?= expected
 485   where
 486     desc = "127.0.0.1/32 combines with itself recursively"
 487     cidr1 = read "127.0.0.1/32" :: Cidr
 488     test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
 489     expected = [cidr1]
 490     actual = combine_all test_cidrs
 491
 492
 493 test_combine_all3 :: TestTree
 494 test_combine_all3 =
 495   testCase desc $ actual @?= expected
 496   where
 497     desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
 498            ++ "10.0.0.19 get combined into 10.0.0.16/30"
 499     cidr1 = read "10.0.0.16/32" :: Cidr
 500     cidr2 = read "10.0.0.17/32" :: Cidr
 501     cidr3 = read "10.0.0.18/32" :: Cidr
 502     cidr4 = read "10.0.0.19/32" :: Cidr
 503     test_cidrs = [cidr1, cidr2, cidr3, cidr4]
 504     expected = [read "10.0.0.16/30" :: Cidr]
 505     actual = combine_all test_cidrs
 506
 507 test_normalize1 :: TestTree
 508 test_normalize1 =
 509   testCase desc $ actual @?= expected
 510   where
 511     desc = "127.0.0.1/8 normalized is 127.0.0.0/8"
 512     expected = read "127.0.0.0/8" :: Cidr
 513     actual = normalize (read "127.0.0.1/8" :: Cidr)
 514
 515
 516 test_normalize2 :: TestTree
 517 test_normalize2 =
 518   testCase desc $ actual @?= expected
 519   where
 520     desc = "192.168.1.101/24 normalized is 192.168.1.0/24"
 521     expected = read "192.168.1.0/24" :: Cidr
 522     actual = normalize (read "192.168.1.101/24" :: Cidr)
 523
 524 test_normalize3 :: TestTree
 525 test_normalize3 =
 526   testCase desc $ actual @?= expected
 527   where
 528     desc = "10.10.10.10/22 normalized is 10.10.8.0/22"
 529     expected = read "10.10.8.0/22" :: Cidr
 530     actual = normalize (read "10.10.10.10/22" :: Cidr)
 531
 532 -- QuickCheck Tests
 533 prop_all_cidrs_contain_themselves :: TestTree
 534 prop_all_cidrs_contain_themselves =
 535   testProperty "All CIDRs contain themselves" prop
 536   where
 537     prop :: Cidr -> Bool
 538     prop cidr1 = cidr1 `contains` cidr1
 539
 540
 541 -- If cidr1 properly contains cidr2, then by definition cidr2
 542 -- does not properly contain cidr1.
 543 prop_contains_proper_antisymmetric :: TestTree
 544 prop_contains_proper_antisymmetric =
 545   testProperty "CIDR proper containment is an antisymmetric relation" prop
 546   where
 547     prop :: Cidr -> Cidr -> Property
 548     prop cidr1 cidr2 =
 549       (cidr1 `contains_proper` cidr2) ==>
 550         (not (cidr2 `contains_proper` cidr1))
 551
 552
 553 -- Running "normalize" a second time shouldn't do anything.
 554 prop_normalize_idempotent :: TestTree
 555 prop_normalize_idempotent =
 556   testProperty "The CIDR \"normalize\" function is idempotent" prop
 557   where
 558     prop :: Cidr -> Bool
 559     prop cidr = (normalize cidr) == (normalize (normalize cidr))
 560
 561 -- Normalization should not affect equality of two CIDRs.
 562 prop_normalize_preserves_equality :: TestTree
 563 prop_normalize_preserves_equality =
 564   testProperty "The CIDR \"normalize\" function preserves equality" prop
 565   where
 566     prop :: Cidr -> Cidr -> Bool
 567     prop cidr1 cidr2 = (cidr1 == cidr2) == (normalize cidr1 == normalize cidr2)
 568
 569
 570 prop_ord_instance_reflexive :: TestTree
 571 prop_ord_instance_reflexive =
 572   testProperty "The CIDR order is reflexive" prop
 573   where
 574     prop :: Cidr -> Bool
 575     prop cidr = cidr <= cidr
 576
 577
 578 prop_ord_instance_transitive :: TestTree
 579 prop_ord_instance_transitive =
 580   testProperty "The CIDR order is transitive" prop
 581   where
 582     prop :: Cidr -> Cidr -> Cidr -> Property
 583     prop cidr1 cidr2 cidr3 =
 584       (cidr1 <= cidr2 && cidr2 <= cidr3) ==> cidr1 <= cidr3
 585
 586 -- This is how Eq is currently implemented, but it is useful to have
 587 -- around in case that changes. Try fewer instances of this than usual
 588 -- because it's a rare condition.
 589 prop_ord_instance_antisymmetric :: TestTree
 590 prop_ord_instance_antisymmetric =
 591   localOption (QuickCheckTests 500) $
 592     testProperty "The CIDR order is antisymmetric" prop
 593   where
 594     prop :: Cidr -> Cidr -> Property
 595     prop cidr1 cidr2 =
 596       (cidr1 <= cidr2 && cidr2 <= cidr1) ==> cidr1 == cidr2
 597
 598
 599 -- When comparing two CIDRs with the same mask, the comparison
 600 -- should be numeric (i.e. whatever the IPv4Address does).
 601 -- Of course, we have to normalize first.
 602 prop_ord_uses_addr_when_masks_equal :: TestTree
 603 prop_ord_uses_addr_when_masks_equal =
 604   testProperty "The CIDR order is the IPv4Address order for equal masks" prop
 605   where
 606     prop :: Cidr -> Cidr -> Property
 607     prop cidr1 cidr2 =
 608       (mask1 == mask2) ==> (cidr1 <= cidr2) == (addr1 <= addr2)
 609       where
 610         (Cidr addr1 mask1) = normalize cidr1
 611         (Cidr addr2 mask2) = normalize cidr2