+
+-- Normalization should not affect equality of two CIDRs.
+prop_normalize_preserves_equality :: TestTree
+prop_normalize_preserves_equality =
+ testProperty "The CIDR \"normalize\" function preserves equality" prop
+ where
+ prop :: Cidr -> Cidr -> Bool
+ prop cidr1 cidr2 = (cidr1 == cidr2) == (normalize cidr1 == normalize cidr2)
+
+
+prop_ord_instance_reflexive :: TestTree
+prop_ord_instance_reflexive =
+ testProperty "The CIDR order is reflexive" prop
+ where
+ prop :: Cidr -> Bool
+ prop cidr = cidr <= cidr
+
+
+prop_ord_instance_transitive :: TestTree
+prop_ord_instance_transitive =
+ testProperty "The CIDR order is transitive" prop
+ where
+ prop :: Cidr -> Cidr -> Cidr -> Property
+ prop cidr1 cidr2 cidr3 =
+ (cidr1 <= cidr2 && cidr2 <= cidr3) ==> cidr1 <= cidr3
+
+-- This is how Eq is currently implemented, but it is useful to have
+-- around in case that changes. Try fewer instances of this than usual
+-- because it's a rare condition.
+prop_ord_instance_antisymmetric :: TestTree
+prop_ord_instance_antisymmetric =
+ localOption (QuickCheckTests 500) $
+ testProperty "The CIDR order is antisymmetric" prop
+ where
+ prop :: Cidr -> Cidr -> Property
+ prop cidr1 cidr2 =
+ (cidr1 <= cidr2 && cidr2 <= cidr1) ==> cidr1 == cidr2
+
+
+-- When comparing two CIDRs with the same mask, the comparison
+-- should be numeric (i.e. whatever the IPv4Address does).
+-- Of course, we have to normalize first.
+prop_ord_uses_addr_when_masks_equal :: TestTree
+prop_ord_uses_addr_when_masks_equal =
+ testProperty "The CIDR order is the IPv4Address order for equal masks" prop
+ where
+ prop :: Cidr -> Cidr -> Property
+ prop cidr1 cidr2 =
+ (mask1 == mask2) ==> (cidr1 <= cidr2) == (addr1 <= addr2)
+ 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