X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FIPv4Address.hs;h=38aec8dd39c5250279a05357db753c8aa2247cf2;hb=HEAD;hp=6153d282a681305bdcd8a83848ebe16ed40de9ba;hpb=e8b41784eaa68049f7a7354916c9c9920050db70;p=hath.git

diff --git a/src/IPv4Address.hs b/src/IPv4Address.hs
index 6153d28..f9fd8c2 100644
--- a/src/IPv4Address.hs
+++ b/src/IPv4Address.hs
@@ -1,25 +1,40 @@
-module IPv4Address
-( ipv4address_tests,
+module IPv4Address(
   IPv4Address(..),
-  max_address,
-  min_address,
-  most_sig_bit_different,
-) where
+  ipv4address_properties,
+  ipv4address_tests,
+  most_sig_bit_different )
+where
 
-import Data.Maybe (fromJust)
-import Test.HUnit
-import Test.QuickCheck
+import Data.Int ( Int32, Int64 )
+import Data.Word ( Word32 )
 
-import Maskable
-import Maskbits
-import Octet
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Test.Tasty.QuickCheck (
+  Arbitrary( arbitrary ),
+  Gen,
+  Large,
+  Property,
+  Small,
+  (==>),
+  testProperty )
+
+import Maskable ( Maskable( apply_mask) )
+import Maskbits (
+  Maskbits(
+    Zero, One, Two, Three, Four, Five, Six, Seven, Eight,
+    Nine, Ten, Eleven, Twelve, Thirteen, Fourteen, Fifteen, Sixteen,
+    Seventeen, Eighteen, Nineteen, Twenty, TwentyOne, TwentyTwo, TwentyThree,
+    TwentyFour, TwentyFive, TwentySix, TwentySeven, TwentyEight, TwentyNine,
+    Thirty, ThirtyOne, ThirtyTwo ) )
+import Octet ( Octet( b1, b2, b3, b4, b5, b6, b7, b8) )
 
 data IPv4Address =
   IPv4Address { octet1 :: Octet,
                 octet2 :: Octet,
                 octet3 :: Octet,
                 octet4 :: Octet }
-    deriving (Eq)
+    deriving (Eq, Ord)
 
 
 instance Show IPv4Address where
@@ -46,106 +61,174 @@ instance Arbitrary IPv4Address where
 
 instance Maskable IPv4Address where
 
-  apply_mask addr mask bit
-      | mask == ThirtyTwo = addr
-      | mask == ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
-      | mask == Thirty = addr { octet4 = (apply_mask oct4 Six bit) }
-      | mask == TwentyNine = addr { octet4 = (apply_mask oct4 Five bit) }
-      | mask == TwentyEight = addr { octet4 = (apply_mask oct4 Four bit) }
-      | mask == TwentySeven = addr { octet4 = (apply_mask oct4 Three bit) }
-      | mask == TwentySix = addr { octet4 = (apply_mask oct4 Two bit) }
-      | mask == TwentyFive = addr { octet4 = (apply_mask oct4 One bit) }
-      | mask == TwentyFour = addr { octet4 = (apply_mask oct4 Zero bit) }
-      | mask == TwentyThree = addr { octet3 = (apply_mask oct3 Seven bit),
-                                    octet4 = (apply_mask oct4 Zero bit) }
-      | mask == TwentyTwo = addr { octet3 = (apply_mask oct3 Six bit),
-                                  octet4 = (apply_mask oct4 Zero bit) }
-      | mask == TwentyOne = addr { octet3 = (apply_mask oct3 Five bit),
-                                  octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Twenty = addr { octet3 = (apply_mask oct3 Four bit),
-                               octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Nineteen = addr { octet3 = (apply_mask oct3 Three bit),
-                                 octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Eighteen = addr { octet3 = (apply_mask oct3 Two bit),
-                                 octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Seventeen = addr { octet3 = (apply_mask oct3 One bit),
-                                  octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Sixteen = addr { octet3 = (apply_mask oct3 Zero bit),
-                                octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Fifteen = addr { octet2 = (apply_mask oct2 Seven bit),
-                                octet3 = (apply_mask oct3 Zero bit),
-                                octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Fourteen = addr { octet2 = (apply_mask oct2 Six bit),
-                                 octet3 = (apply_mask oct3 Zero bit),
-                                 octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Thirteen = addr { octet2 = (apply_mask oct2 Five bit),
-                                 octet3 = (apply_mask oct3 Zero bit),
-                                 octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Twelve = addr { octet2 = (apply_mask oct2 Four bit),
-                               octet3 = (apply_mask oct3 Zero bit),
-                               octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Eleven = addr { octet2 = (apply_mask oct2 Three bit),
-                               octet3 = (apply_mask oct3 Zero bit),
-                               octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Ten = addr { octet2 = (apply_mask oct2 Two bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Nine = addr { octet2 = (apply_mask oct2 One bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Eight = addr { octet2 = (apply_mask oct2 Zero bit),
-                              octet3 = (apply_mask oct3 Zero bit),
-                              octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Seven = addr { octet1 = (apply_mask oct1 Seven bit),
-                              octet2 = (apply_mask oct2 Zero bit),
-                              octet3 = (apply_mask oct3 Zero bit),
-                              octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Six = addr { octet1 = (apply_mask oct1 Six bit),
-                            octet2 = (apply_mask oct2 Zero bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Five = addr { octet1 = (apply_mask oct1 Five bit),
-                             octet2 = (apply_mask oct2 Zero bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Four = addr { octet1 = (apply_mask oct1 Four bit),
-                             octet2 = (apply_mask oct2 Zero bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Three = addr { octet1 = (apply_mask oct1 Three bit),
-                              octet2 = (apply_mask oct2 Zero bit),
-                              octet3 = (apply_mask oct3 Zero bit),
-                              octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Two = addr { octet1 = (apply_mask oct1 Two bit),
-                            octet2 = (apply_mask oct2 Zero bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == One = addr { octet1 = (apply_mask oct1 One bit),
-                            octet2 = (apply_mask oct2 Zero bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Zero = addr { octet1 = (apply_mask oct1 Zero bit),
-                             octet2 = (apply_mask oct2 Zero bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      where
-        oct1 = (octet1 addr)
-        oct2 = (octet2 addr)
-        oct3 = (octet3 addr)
-        oct4 = (octet4 addr)
+  apply_mask addr mask bit =
+   apply_mask' mask
+   where
+     oct1 = octet1 addr
+     oct2 = octet2 addr
+     oct3 = octet3 addr
+     oct4 = octet4 addr
+
+     -- A copy of 'addr' with the fourth octet zeroed (or oned).
+     new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
+
+     -- Likewise for new_addr1's third octet.
+     new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
+
+     -- And new_addr2's second octet.
+     new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
+
+     -- This helper function allows us to pattern-match cleanly.
+     apply_mask' :: Maskbits -> IPv4Address
+
+     apply_mask' ThirtyTwo = addr
+
+     apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
+
+     apply_mask' Thirty =
+       addr { octet4 = (apply_mask oct4 Six bit) }
+
+     apply_mask' TwentyNine =
+       addr { octet4 = (apply_mask oct4 Five bit) }
+
+     apply_mask' TwentyEight =
+       addr { octet4 = (apply_mask oct4 Four bit) }
+
+     apply_mask' TwentySeven =
+       addr { octet4 = (apply_mask oct4 Three bit) }
+
+     apply_mask' TwentySix =
+       addr { octet4 = (apply_mask oct4 Two bit) }
+
+     apply_mask' TwentyFive =
+       addr { octet4 = (apply_mask oct4 One bit) }
+
+     apply_mask' TwentyFour = new_addr1
+
+     apply_mask' TwentyThree =
+       new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
+
+     apply_mask' TwentyTwo =
+       new_addr1 { octet3 = (apply_mask oct3 Six bit) }
+
+     apply_mask' TwentyOne =
+       new_addr1 { octet3 = (apply_mask oct3 Five bit) }
+
+     apply_mask' Twenty =
+       new_addr1 { octet3 = (apply_mask oct3 Four bit) }
+
+     apply_mask' Nineteen =
+       new_addr1 { octet3 = (apply_mask oct3 Three bit) }
+
+     apply_mask' Eighteen =
+       new_addr1 { octet3 = (apply_mask oct3 Two bit) }
+
+     apply_mask' Seventeen =
+       new_addr1 { octet3 = (apply_mask oct3 One bit) }
+
+     apply_mask' Sixteen =
+       new_addr2
+
+     apply_mask' Fifteen =
+       new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
+
+     apply_mask' Fourteen =
+       new_addr2 { octet2 = (apply_mask oct2 Six bit) }
+
+     apply_mask' Thirteen =
+       new_addr2 { octet2 = (apply_mask oct2 Five bit) }
+
+     apply_mask' Twelve =
+       new_addr2 { octet2 = (apply_mask oct2 Four bit) }
+
+     apply_mask' Eleven =
+       new_addr2 { octet2 = (apply_mask oct2 Three bit) }
+
+     apply_mask' Ten =
+       new_addr2 { octet2 = (apply_mask oct2 Two bit) }
+
+     apply_mask' Nine =
+       new_addr2 { octet2 = (apply_mask oct2 One bit) }
+
+     apply_mask' Eight =
+       new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
+
+     apply_mask' Seven =
+       new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
+
+     apply_mask' Six =
+       new_addr3 { octet1 = (apply_mask oct1 Six bit) }
+
+     apply_mask' Five =
+       new_addr3 { octet1 = (apply_mask oct1 Five bit) }
 
+     apply_mask' Four =
+       new_addr3 { octet1 = (apply_mask oct1 Four bit) }
 
--- | The minimum possible IPv4 address, 0.0.0.0.
-min_address :: IPv4Address
-min_address =
-  IPv4Address min_octet min_octet min_octet min_octet
+     apply_mask' Three =
+       new_addr3 { octet1 = (apply_mask oct1 Three bit) }
 
+     apply_mask' Two =
+       new_addr3 { octet1 = (apply_mask oct1 Two bit) }
 
--- | The maximum possible IPv4 address, 255.255.255.255.
-max_address :: IPv4Address
-max_address =
-  IPv4Address max_octet max_octet max_octet max_octet
+     apply_mask' One =
+       new_addr3 { octet1 = (apply_mask oct1 One bit) }
 
+     apply_mask' Zero =
+       new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
+
+
+instance Bounded IPv4Address where
+  -- | The minimum possible IPv4 address, 0.0.0.0.
+  minBound = IPv4Address minBound minBound minBound minBound
+
+  -- | The maximum possible IPv4 address, 255.255.255.255.
+  maxBound = IPv4Address maxBound maxBound maxBound maxBound
+
+
+
+
+instance Enum IPv4Address where
+  -- | Convert an 'Int' @x@ to an 'IPv4Address'. Each octet of @x@ is
+  --   right-shifted by the appropriate number of bits, and the fractional
+  --   part is dropped.
+  toEnum signed_x =
+    IPv4Address oct1 oct2 oct3 oct4
+    where
+      -- Convert the input Int to a Word32 before we proceed. On x86,
+      -- the Int that we get could be negative (half of all IP
+      -- addresses correspond to negative numbers), and then the magic
+      -- below doesn't work. The Word32 type is unsigned, so we do the
+      -- math on that and then convert everything back to Int later on
+      -- once we have four much-smaller non-negative numbers.
+      x = fromIntegral signed_x :: Word32
+
+      -- Chop off the higher octets. x1 = x `mod` 2^32, would be
+      -- redundant.
+      x2 = x `mod` (2 ^ (24 :: Integer))
+      x3 = x `mod` (2 ^ (16 :: Integer))
+      x4 = (fromIntegral $ x `mod` (2 ^ (8 :: Integer))) :: Int
+      -- Perform right-shifts. x4 doesn't need a shift.
+      shifted_x1 = (fromIntegral $ x  `quot` (2 ^ (24 :: Integer))) :: Int
+      shifted_x2 = (fromIntegral $ x2 `quot` (2 ^ (16 :: Integer))) :: Int
+      shifted_x3 = (fromIntegral $ x3 `quot` (2 ^ (8  :: Integer))) :: Int
+      oct1 = toEnum shifted_x1 :: Octet
+      oct2 = toEnum shifted_x2 :: Octet
+      oct3 = toEnum shifted_x3 :: Octet
+      oct4 = toEnum x4 :: Octet
+
+  -- | Convert @addr@ to an 'Int' by converting each octet to an 'Int'
+  --   and shifting the result to the left by 0,8.16, or 24 bits.
+  fromEnum addr =
+    (shifted_oct1) + (shifted_oct2) + (shifted_oct3) + oct4
+    where
+      oct1 = fromEnum (octet1 addr)
+      oct2 = fromEnum (octet2 addr)
+      oct3 = fromEnum (octet3 addr)
+      oct4 = fromEnum (octet4 addr)
+      shifted_oct1 = oct1 * (2 ^ (24 :: Integer))
+      shifted_oct2 = oct2 * (2 ^ (16 :: Integer))
+      shifted_oct3 = oct3 * (2 ^ (8  :: Integer))
 
 -- | Given two addresses, find the number of the most significant bit
 --   where they differ. If the addresses are the same, return
@@ -261,42 +344,175 @@ most_sig_bit_different addr1 addr2
     oct4b = (octet4 addr2)
 
 
+-- Test lists.
+ipv4address_tests :: TestTree
+ipv4address_tests =
+  testGroup "IPv4 Address Tests" [
+    test_enum,
+    test_maxBound,
+    test_minBound,
+    test_most_sig_bit_different1,
+    test_most_sig_bit_different2,
+    test_ord_instance1,
+    test_ord_instance2,
+    test_ord_instance3,
+    test_ord_instance4,
+    test_to_enum ]
+
+ipv4address_properties :: TestTree
+ipv4address_properties =
+  testGroup
+    "IPv4 Address Properties "
+    [ prop_from_enum_to_enum_inverses_x32,
+      prop_from_enum_to_enum_inverses_x64 ]
+
+-- QuickCheck properties
+--
+-- We have two different tests to show that toEnum and fromEnum are
+-- inverses of one another. This part of the code isn't really
+-- type-safe, because the stupid Enum class insists that we use a
+-- machine 'Int' for our representation. Since IPv4 addresses can
+-- correspond to very large 32-bit integers, there's a possibility
+-- that our math is wrong in 32- but not 64-bits, and vice-versa.
+--
+-- tl;dr we want to ensure that this test passes when the 'Int' type
+-- is both 32-bit and 64-bit.
+
+-- Generate "Small" 64-bit numbers, because almost all 64-bit integers are
+-- too large to satisfy our predicate (i.e. also be 32-bit integers).
+prop_from_enum_to_enum_inverses_x64 :: TestTree
+prop_from_enum_to_enum_inverses_x64 =
+  testProperty "fromEnum and toEnum are inverses (x64)" prop
+  where
+    prop :: (Small Int64) -> Property
+    prop x =
+      0 <= x && x <= (2 ^ (32 :: Integer)) - 1 ==>
+        fromIntegral (fromEnum (toEnum (fromIntegral x) :: IPv4Address)) == x
+
+-- According to the QuickCheck documentation, we need the "Large"
+-- modifier to ensure that the test cases are drawn from the entire
+-- range of Int32 values.
+prop_from_enum_to_enum_inverses_x32 :: TestTree
+prop_from_enum_to_enum_inverses_x32 =
+  testProperty "fromEnum and toEnum are inverses (x32)" prop
+  where
+    prop :: (Large Int32) -> Bool
+    prop x =
+      fromIntegral (fromEnum (toEnum (fromIntegral x) :: IPv4Address)) == x
 
 -- HUnit Tests
 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
 mk_testaddr a b c d =
   IPv4Address oct1 oct2 oct3 oct4
   where
-    oct1 = fromJust $ octet_from_int a
-    oct2 = fromJust $ octet_from_int b
-    oct3 = fromJust $ octet_from_int c
-    oct4 = fromJust $ octet_from_int d
+    oct1 = toEnum a :: Octet
+    oct2 = toEnum b :: Octet
+    oct3 = toEnum c :: Octet
+    oct4 = toEnum d :: Octet
+
+
+test_minBound :: TestTree
+test_minBound =
+  testCase desc $ actual @?= expected
+  where
+    desc = "minBound should be 0.0.0.0"
+    expected = mk_testaddr 0 0 0 0
+    actual = minBound :: IPv4Address
 
 
-test_most_sig_bit_different1 :: Test
+test_maxBound :: TestTree
+test_maxBound =
+  testCase desc $ actual @?= expected
+  where
+    desc = "maxBound should be 255.255.255.255"
+    expected = mk_testaddr 255 255 255 255
+    actual = maxBound :: IPv4Address
+
+
+test_enum :: TestTree
+test_enum =
+  testCase desc $ actual @?= expected
+  where
+    desc = "enumerating a /24 gives the correct addresses"
+    expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ]
+    lb = mk_testaddr 192 168 0 0
+    ub = mk_testaddr 192 168 0 255
+    actual = map show [lb..ub]
+
+
+test_most_sig_bit_different1 :: TestTree
 test_most_sig_bit_different1 =
-  TestCase $ assertEqual "10.1.1.0 and 10.1.0.0 differ in bit 24"
-             TwentyFour
-             bit
+  testCase desc $ actual @?= expected
   where
+    desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
     addr1 = mk_testaddr 10 1 1 0
     addr2 = (mk_testaddr 10 1 0 0)
-    bit = most_sig_bit_different addr1 addr2
+    expected = TwentyFour
+    actual = most_sig_bit_different addr1 addr2
 
 
 
-test_most_sig_bit_different2 :: Test
+test_most_sig_bit_different2 :: TestTree
 test_most_sig_bit_different2 =
-  TestCase $ assertEqual "10.1.2.0 and 10.1.1.0 differ in bit 23"
-               TwentyThree
-               bit
+  testCase desc $ actual @?= expected
   where
+    desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
     addr1 = mk_testaddr 10 1 2 0
     addr2 = mk_testaddr 10 1 1 0
-    bit = most_sig_bit_different addr1 addr2
+    expected = TwentyThree
+    actual = most_sig_bit_different addr1 addr2
 
 
-ipv4address_tests :: [Test]
-ipv4address_tests =
-  [ test_most_sig_bit_different1,
-    test_most_sig_bit_different2 ]
+test_to_enum :: TestTree
+test_to_enum =
+  testCase desc $ actual @?= expected
+  where
+    desc     = "192.168.0.0 in base-10 is 3232235520"
+    expected = mk_testaddr 192 168 0 0
+    -- We declare the big number as Word32 because otherwise, on x86,
+    -- we get a warning that it's too big to fit in a 32-bit integer.
+    -- Ultimately we convert it to a (negative) Int on those systems
+    -- anyway, but the gymnastics declare our intent to the compiler.
+    actual   = toEnum (fromIntegral (3232235520 :: Word32)) :: IPv4Address
+
+
+test_ord_instance1 :: TestTree
+test_ord_instance1 =
+  testCase desc $ actual @?= expected
+  where
+    desc     = "127.0.0.0 is less than 127.0.0.1"
+    addr1 = mk_testaddr 127 0 0 0
+    addr2 = mk_testaddr 127 0 0 1
+    expected = True
+    actual   = addr1 <= addr2
+
+
+test_ord_instance2 :: TestTree
+test_ord_instance2 =
+  testCase desc $ actual @?= expected
+  where
+    desc     = "127.0.0.0 is less than 127.0.1.0"
+    addr1 = mk_testaddr 127 0 0 0
+    addr2 = mk_testaddr 127 0 1 0
+    expected = True
+    actual   = addr1 <= addr2
+
+test_ord_instance3 :: TestTree
+test_ord_instance3 =
+  testCase desc $ actual @?= expected
+  where
+    desc     = "127.0.0.0 is less than 127.1.0.0"
+    addr1 = mk_testaddr 127 0 0 0
+    addr2 = mk_testaddr 127 1 0 0
+    expected = True
+    actual   = addr1 <= addr2
+
+test_ord_instance4 :: TestTree
+test_ord_instance4 =
+  testCase desc $ actual @?= expected
+  where
+    desc     = "127.0.0.0 is less than 128.0.0.0"
+    addr1 = mk_testaddr 127 0 0 0
+    addr2 = mk_testaddr 128 0 0 0
+    expected = True
+    actual   = addr1 <= addr2