Add a bunch of tests for our weird CIDR order.

diff --git a/src/Cidr.hs b/src/Cidr.hs
index 007e94b9425ae819e3c624ae4765bdf3017d3a42..9ed146ab92a08c1c889a610b23e69e5314a3efa8 100644 (file)
--- a/src/Cidr.hs
+++ b/src/Cidr.hs
@@ -65,6 +65,19 @@ instance Eq Cidr where
   cidr1 == cidr2 = (cidr1 <= cidr2) && (cidr2 <= cidr1)
 
 instance Ord Cidr where
+  -- | The CIDR order is simply numeric, with the IPv4Address being
+  --   considered first, before the mask. There was an arbitrary
+  --   choice that had to be made here: which CIDR is smaller,
+  --   127.0.0.1/8, or 127.0.0.1/32?
+  --
+  --   The arguments for 127.0.0.1/8 <= 127.0.0.1/32 are that it
+  --   agrees with the numeric sort order on masks, and that it's
+  --   generally nicer to see the big networks before the small ones.
+  --
+  --   On the other hand, this order disagrees with the containment
+  --   partial order, since 127.0.0.1/32 is contained properly in
+  --   127.0.0.1/8.
+  --
   cidr1 <= cidr2 = if addr1 == addr2 then mask1 <= mask2 else addr1 <= addr2
     where
       Cidr addr1 mask1 = normalize cidr1
@@ -296,7 +309,8 @@ cidr_tests =
     test_combine_all3,
     test_normalize1,
     test_normalize2,
-    test_normalize3 ]
+    test_normalize3,
+    test_big_networks_come_first ]
 
 cidr_properties :: TestTree
 cidr_properties =
@@ -308,7 +322,11 @@ cidr_properties =
       prop_ord_instance_antisymmetric,
       prop_ord_instance_reflexive,
       prop_ord_instance_transitive,
-      prop_ord_uses_addr_when_masks_equal ]
+      prop_ord_uses_addr_when_masks_equal,
+      prop_ord_uses_mask_when_addrs_equal,
+      prop_ord_and_contains_disagree,
+      prop_ord_minimum,
+      prop_ord_maximum ]
 
 
 -- HUnit Tests
@@ -529,6 +547,18 @@ test_normalize3 =
     expected = read "10.10.8.0/22" :: Cidr
     actual = normalize (read "10.10.10.10/22" :: Cidr)
 
+-- | Test a stated property of the Ord instance, namely that the big
+--   network 127.0.0.1/8 comes before the small network 127.0.0.1/32.
+test_big_networks_come_first :: TestTree
+test_big_networks_come_first =
+  testCase desc $ actual @?= expected
+  where
+    desc = "127.0.0.1/8 comes before 127.0.0.1/32"
+    big = read "127.0.0.1/8" :: Cidr
+    small = read "127.0.0.1/32" :: Cidr
+    expected = True
+    actual = big <= small -- not a typo
+
 -- QuickCheck Tests
 prop_all_cidrs_contain_themselves :: TestTree
 prop_all_cidrs_contain_themselves =
@@ -609,3 +639,48 @@ prop_ord_uses_addr_when_masks_equal =
       where
         (Cidr addr1 mask1) = normalize cidr1
         (Cidr addr2 mask2) = normalize cidr2
+
+
+-- If we have two CIDRs whose normalized addresses agree, then we want
+-- to use the mask order, i.e. that big networks come before small
+-- networks. This disagrees with containment order.
+prop_ord_uses_mask_when_addrs_equal :: TestTree
+prop_ord_uses_mask_when_addrs_equal =
+  localOption (QuickCheckTests 500) $
+    testProperty "The CIDR order is by mask when the addresses agree" prop
+  where
+    prop :: Cidr -> Cidr -> Property
+    prop cidr1 cidr2 =
+      (addr1 == addr2) ==> (cidr1 <= cidr2) == (mask1 <= mask2)
+      where
+        (Cidr addr1 mask1) = normalize cidr1
+        (Cidr addr2 mask2) = normalize cidr2
+
+
+-- Big networks come first.
+prop_ord_and_contains_disagree :: TestTree
+prop_ord_and_contains_disagree =
+  testProperty "The CIDR order disagrees with containment" prop
+  where
+    prop :: Cidr -> Cidr -> Property
+    prop cidr1 cidr2 = (cidr1 `contains` cidr2) ==> (cidr1 <= cidr2)
+
+
+-- The biggest network always comes first.
+prop_ord_minimum :: TestTree
+prop_ord_minimum =
+  testProperty "The CIDR order has 0.0.0.0/0 as a minimum" prop
+  where
+    min_cidr = read "0.0.0.0/0" :: Cidr
+    prop :: Cidr -> Bool
+    prop cidr = min_cidr <= cidr
+
+
+-- The CIDR order also has a maximum.
+prop_ord_maximum :: TestTree
+prop_ord_maximum =
+  testProperty "The CIDR order has 255.255.255.255/32 as a maximum" prop
+  where
+    max_cidr = read "255.255.255.255/32" :: Cidr
+    prop :: Cidr -> Bool
+    prop cidr = max_cidr >= cidr