]> gitweb.michael.orlitzky.com - hath.git/blobdiff - src/Cidr.hs
Update for QuickCheck 2.
[hath.git] / src / Cidr.hs
index 7bb3ac2c41229b286f67f39a8ce58c24274171b7..422a0adf076216f16b128791a610eee54fc9ca42 100644 (file)
@@ -2,13 +2,26 @@ module Cidr
 ( Cidr(..),
   cidr_from_string,
   cidr_tests,
-  combine_all
+  combine_all,
+  contains,
+  contains_proper,
+  max_octet1,
+  max_octet2,
+  max_octet3,
+  max_octet4,
+  min_octet1,
+  min_octet2,
+  min_octet3,
+  min_octet4,
+  prop_all_cidrs_contain_themselves,
+  prop_contains_proper_intransitive
 ) where
 
 import Data.List (nubBy)
 import Test.HUnit
 import Test.QuickCheck
 
+import qualified Bit as B
 import IPv4Address
 import ListUtils
 import Maskable
@@ -18,7 +31,7 @@ import Octet
 
 data Cidr = None | Cidr { ipv4address :: IPv4Address,
                           maskbits :: Maskbits }
-            deriving (Eq)
+
 
 
 instance Show Cidr where
@@ -32,7 +45,9 @@ instance Arbitrary Cidr where
       mask <- arbitrary :: Gen Maskbits
       return (Cidr ipv4 mask)
 
-    coarbitrary _ = variant 0
+
+instance Eq Cidr where
+  cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
 
 
 -- Two CIDR ranges are equivalent if they have the same network bits
@@ -42,13 +57,16 @@ equivalent Cidr.None Cidr.None = True
 equivalent Cidr.None _ = False
 equivalent _ Cidr.None = False
 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
-    (mbits1 == mbits2) && ((apply_mask addr1 mbits1) == (apply_mask addr2 mbits2))
+    (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
 
 -- Returns the mask portion of a CIDR address. That is, everything
 -- after the trailing slash.
 maskbits_from_cidr_string :: String -> Maskbits
-maskbits_from_cidr_string s =
-    maskbits_from_string ((splitWith (`elem` "/") s) !! 1)
+maskbits_from_cidr_string s
+    | length partlist == 2 = maskbits_from_string (partlist !! 1)
+    | otherwise = Maskbits.None
+      where
+        partlist = (splitWith (`elem` "/") s)
 
 
 -- Takes an IP address String in CIDR notation, and returns a list of
@@ -74,6 +92,46 @@ cidr_from_string s
 
 
 
+min_host :: Cidr -> IPv4Address
+min_host Cidr.None                 = IPv4Address.None
+min_host (Cidr IPv4Address.None _) = IPv4Address.None
+min_host (Cidr _ Maskbits.None)    = IPv4Address.None
+min_host (Cidr addr mask) = apply_mask addr mask B.Zero
+
+
+max_host :: Cidr -> IPv4Address
+max_host Cidr.None                 = IPv4Address.None
+max_host (Cidr IPv4Address.None _) = IPv4Address.None
+max_host (Cidr _ Maskbits.None)    = IPv4Address.None
+max_host (Cidr addr mask) = apply_mask addr mask B.One
+
+
+min_octet1 :: Cidr -> Octet
+min_octet1 cidr = octet1 (min_host cidr)
+
+min_octet2 :: Cidr -> Octet
+min_octet2 cidr = octet2 (min_host cidr)
+
+min_octet3 :: Cidr -> Octet
+min_octet3 cidr = octet3 (min_host cidr)
+
+min_octet4 :: Cidr -> Octet
+min_octet4 cidr = octet4 (min_host cidr)
+
+max_octet1 :: Cidr -> Octet
+max_octet1 cidr = octet1 (max_host cidr)
+
+max_octet2 :: Cidr -> Octet
+max_octet2 cidr = octet2 (max_host cidr)
+
+max_octet3 :: Cidr -> Octet
+max_octet3 cidr = octet3 (max_host cidr)
+
+max_octet4 :: Cidr -> Octet
+max_octet4 cidr = octet4 (max_host cidr)
+
+
+
 -- Return true if the first argument (a CIDR range) contains the
 -- second (another CIDR range). There are a lot of ways we can be fed
 -- junk here. For lack of a better alternative, just return False when
@@ -117,13 +175,13 @@ contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
     | mbits1 > mbits2 = False
     | otherwise = addr1masked == addr2masked
     where
-      addr1masked = apply_mask addr1 mbits1
-      addr2masked = apply_mask addr2 mbits1
+      addr1masked = apply_mask addr1 mbits1 B.Zero
+      addr2masked = apply_mask addr2 mbits1 B.Zero
 
 
 contains_proper :: Cidr -> Cidr -> Bool
 contains_proper cidr1 cidr2 =
-    (cidr1 `contains` cidr2) && (not (cidr1 == cidr2))
+    (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
 
 
 -- A CIDR range is redundant (with respect to the given list) if
@@ -138,9 +196,15 @@ redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
 -- adjacent Cidrs are combined into a larger one, they will be removed
 -- in the second step since the larger Cidr must contain the smaller
 -- two.
+--
+-- Once this is done, we see whether or not the result is different
+-- than the argument that was passed in. If nothing changed, we're
+-- done and return the list that was passed to us. However, if
+-- something changed, we recurse and try to combine the list again.
 combine_all :: [Cidr] -> [Cidr]
-combine_all cidrs =
-    combine_contained unique_cidrs
+combine_all cidrs
+  | cidrs == (combine_contained unique_cidrs) = cidrs
+  | otherwise = combine_all (combine_contained unique_cidrs)
     where
       unique_cidrs = nubBy equivalent valid_cidr_combinations
       valid_cidr_combinations = filter (/= Cidr.None) cidr_combinations
@@ -189,6 +253,22 @@ adjacent cidr1 cidr2
 
 -- HUnit Tests
 
+test_min_host1 :: Test
+test_min_host1 =
+    TestCase $ assertEqual "The minimum host in 10.0.0.0/24 is 10.0.0.0" expected actual
+    where
+      actual = show $ min_host (cidr_from_string "10.0.0.0/24")
+      expected = "10.0.0.0"
+
+
+test_max_host1 :: Test
+test_max_host1 =
+    TestCase $ assertEqual "The maximum host in 10.0.0.0/24 is 10.0.0.255" expected actual
+    where
+      actual = show $ max_host (cidr_from_string "10.0.0.0/24")
+      expected = "10.0.0.255"
+
+
 test_equality1 :: Test
 test_equality1 =
     TestCase $ assertEqual "10.1.1.0/23 equals itself" True (cidr1 == cidr1)
@@ -260,7 +340,7 @@ test_adjacent4 =
 
 test_combine_contained1 :: Test
 test_combine_contained1 =
-    TestCase $ assertEqual "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" expected_cidrs (combine_all test_cidrs)
+    TestCase $ assertEqual "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" expected_cidrs (combine_contained test_cidrs)
     where
       cidr1 = cidr_from_string "10.0.0.0/8"
       cidr2 = cidr_from_string "10.1.0.0/16"
@@ -271,13 +351,50 @@ test_combine_contained1 =
 
 test_combine_contained2 :: Test
 test_combine_contained2 =
-    TestCase $ assertEqual "192.168.1.0/24 combines with itself" [cidr1] (combine_all [cidr1, cidr1])
+    TestCase $ assertEqual "192.168.3.0/23 does not contain 192.168.1.0/24" [cidr1, cidr2] (combine_contained [cidr1, cidr2])
     where
-      cidr1 = cidr_from_string "192.168.1.0/24"
+      cidr1 = cidr_from_string "192.168.3.0/23"
+      cidr2 = cidr_from_string "192.168.1.0/24"
+
+
+test_combine_all1 :: Test
+test_combine_all1 =
+    TestCase $ assertEqual "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" expected_cidrs (combine_all test_cidrs)
+    where
+      cidr1 = cidr_from_string "10.0.0.0/24"
+      cidr2 = cidr_from_string "10.0.1.0/24"
+      cidr3 = cidr_from_string "10.0.2.0/24"
+      cidr4 = cidr_from_string "10.0.3.0/23"
+      cidr5 = cidr_from_string "10.0.0.0/23"
+      expected_cidrs = [cidr_from_string "10.0.0.0/22"]
+      test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
+
+
+test_combine_all2 :: Test
+test_combine_all2 =
+    TestCase $ assertEqual "127.0.0.1/32 combines with itself recursively" expected_cidrs (combine_all test_cidrs)
+    where
+      cidr1 = cidr_from_string "127.0.0.1/32"
+      expected_cidrs = [cidr1]
+      test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
+
+
+test_combine_all3 :: Test
+test_combine_all3 =
+    TestCase $ assertEqual "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" expected_cidrs (combine_all test_cidrs)
+    where
+      cidr1 = cidr_from_string "10.0.0.16/32"
+      cidr2 = cidr_from_string "10.0.0.17/32"
+      cidr3 = cidr_from_string "10.0.0.18/32"
+      cidr4 = cidr_from_string "10.0.0.19/32"
+      expected_cidrs = [cidr_from_string "10.0.0.16/30"]
+      test_cidrs = [cidr1, cidr2, cidr3, cidr4]
 
 
 cidr_tests :: [Test]
-cidr_tests = [ test_equality1,
+cidr_tests = [ test_min_host1,
+               test_max_host1,
+               test_equality1,
                test_contains1,
                test_contains2,
                test_contains_proper1,
@@ -287,5 +404,21 @@ cidr_tests = [ test_equality1,
                test_adjacent3,
                test_adjacent4,
                test_combine_contained1,
-               test_combine_contained2
+               test_combine_contained2,
+               test_combine_all1,
+               test_combine_all2,
+               test_combine_all3
              ]
+
+
+-- QuickCheck Tests
+prop_all_cidrs_contain_themselves :: Cidr -> Bool
+prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
+
+
+-- If cidr1 properly contains cidr2, then by definition cidr2
+-- does not properly contain cidr1.
+prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
+prop_contains_proper_intransitive cidr1 cidr2 =
+    (cidr1 `contains_proper` cidr2) ==>
+      (not (cidr2 `contains_proper` cidr1))