Fix four compiler warnings.

[hath.git] / src / Cidr.hs

diff --git a/src/Cidr.hs b/src/Cidr.hs
index 98c42c7e6bdab38a0f2d1da47c142aba445c7182..823f43fc8b6160cd915aa7d0afd17938399250d3 100644 (file)
--- a/src/Cidr.hs
+++ b/src/Cidr.hs
@@ -5,6 +5,14 @@ module Cidr
   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
@@ -13,6 +21,7 @@ import Data.List (nubBy)
 import Test.HUnit
 import Test.QuickCheck
 
+import qualified Bit as B
 import IPv4Address
 import ListUtils
 import Maskable
@@ -46,13 +55,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
@@ -78,6 +90,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
@@ -121,8 +173,8 @@ 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
@@ -193,6 +245,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)
@@ -304,7 +372,9 @@ test_combine_all2 =
 
 
 cidr_tests :: [Test]
-cidr_tests = [ test_equality1,
+cidr_tests = [ test_min_host1,
+               test_max_host1,
+               test_equality1,
                test_contains1,
                test_contains2,
                test_contains_proper1,