X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOctet.hs;h=55f075e8a5810247dc9d7df2342b741ea6f82d30;hb=eee156f562f9c1c1194a67cef12f146304d88ce9;hp=7faf1d7851c18ac864147c2b5220c568ffe1a5b4;hpb=9200fe5fcab505e5a331514a6ee687c6f78011b1;p=hath.git diff --git a/src/Octet.hs b/src/Octet.hs index 7faf1d7..55f075e 100644 --- a/src/Octet.hs +++ b/src/Octet.hs @@ -1,134 +1,216 @@ -module Octet where - -import Test.HUnit -import Test.QuickCheck - -import Bit as B -import Maskable -import Maskbits - --- An Octet consists of eight bits. For our purposes, the most --- significant bit will come "first." That is, b1 is in the 2^7 --- place while b8 is in the 2^0 place. -data Octet = None | Octet { b1 :: Bit, - b2 :: Bit, - b3 :: Bit, - b4 :: Bit, - b5 :: Bit, - b6 :: Bit, - b7 :: Bit, - b8 :: Bit } - deriving (Eq) +module Octet ( + Octet(..), + octet_properties, + octet_tests ) +where + +import Test.QuickCheck ( Gen ) -- Not re-exported by tasty +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( (@?=), testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Property, + (==>), + testProperty ) + +import Bit as B (Bit(..)) +import Maskable (Maskable(..)) +import Maskbits (Maskbits(..)) + +-- | An Octet consists of eight bits. For our purposes, the most +-- significant bit will come "first." That is, b1 is in the 2^7 +-- place while b8 is in the 2^0 place. +data Octet = + Octet { b1 :: Bit, + b2 :: Bit, + b3 :: Bit, + b4 :: Bit, + b5 :: Bit, + b6 :: Bit, + b7 :: Bit, + b8 :: Bit } + deriving (Eq) instance Show Octet where - show Octet.None = "None" - show oct = show (octet_to_int oct) + show oct = show (fromEnum oct) instance Arbitrary Octet where - arbitrary = do - a1 <- arbitrary :: Gen Bit - a2 <- arbitrary :: Gen Bit - a3 <- arbitrary :: Gen Bit - a4 <- arbitrary :: Gen Bit - a5 <- arbitrary :: Gen Bit - a6 <- arbitrary :: Gen Bit - a7 <- arbitrary :: Gen Bit - a8 <- arbitrary :: Gen Bit - return (Octet a1 a2 a3 a4 a5 a6 a7 a8) + arbitrary = do + a1 <- arbitrary :: Gen Bit + a2 <- arbitrary :: Gen Bit + a3 <- arbitrary :: Gen Bit + a4 <- arbitrary :: Gen Bit + a5 <- arbitrary :: Gen Bit + a6 <- arbitrary :: Gen Bit + a7 <- arbitrary :: Gen Bit + a8 <- arbitrary :: Gen Bit + return (Octet a1 a2 a3 a4 a5 a6 a7 a8) instance Maskable Octet where - apply_mask _ Maskbits.None _ = Octet.None - apply_mask Octet.None _ _ = Octet.None - apply_mask oct mask bit - | mask == Eight = oct - | mask == Seven = oct { b8 = bit } - | mask == Six = oct { b8 = bit, b7 = bit } - | mask == Five = oct { b8 = bit, b7 = bit, b6 = bit } - | mask == Four = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit } - | mask == Three = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit } - | mask == Two = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit } - | mask == Maskbits.One = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit, b2 = bit } - | mask == Maskbits.Zero = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit, b2 = bit, b1 = bit } - | otherwise = Octet.None - - --- Convert each bit to its integer value, and multiply by the --- appropriate power of two. Sum them up, and we should get an integer --- between 0 and 255. -octet_to_int :: Octet -> Int -octet_to_int x = - 128 * (bit_to_int (b1 x)) + - 64 * (bit_to_int (b2 x)) + - 32 * (bit_to_int (b3 x)) + - 16 * (bit_to_int (b4 x)) + - 8 * (bit_to_int (b5 x)) + - 4 * (bit_to_int (b6 x)) + - 2 * (bit_to_int (b7 x)) + - 1 * (bit_to_int (b8 x)) - - - -octet_from_int :: Int -> Octet -octet_from_int x - | (x < 0) || (x > 255) = Octet.None - | otherwise = (Octet a1 a2 a3 a4 a5 a6 a7 a8) - where - a1 = if (x >= 128) then B.One else B.Zero - a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero - a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero - a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero - a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero - a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero - a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero - a8 = if ((x `mod` 2) == 1) then B.One else B.Zero - - -octet_from_string :: String -> Octet -octet_from_string s = + apply_mask oct Eight _ = oct + + apply_mask oct Seven bit = + oct { b8 = bit } + + apply_mask oct Six bit = + oct { b8 = bit, b7 = bit } + + apply_mask oct Five bit = + oct { b8 = bit, b7 = bit, b6 = bit } + + apply_mask oct Four bit = + oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit } + + apply_mask oct Three bit = + oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit } + + apply_mask oct Two bit = + oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit } + + apply_mask oct Maskbits.One bit = + oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, + b4 = bit, b3 = bit, b2 = bit } + + apply_mask oct Maskbits.Zero bit = + oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, + b4 = bit, b3 = bit, b2 = bit, b1 = bit } + + -- The Maskbits must be in [Eight..ThirtyTwo]. + apply_mask oct _ _ = oct + + +instance Ord Octet where + (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8) + | x1 > y1 = False + | x2 > y2 = False + | x3 > y3 = False + | x4 > y4 = False + | x5 > y5 = False + | x6 > y6 = False + | x7 > y7 = False + | x8 > y8 = False + | otherwise = True + + +instance Bounded Octet where + -- | The octet with the least possible value. + minBound = + Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero + + -- | The octet with the greatest possible value. + maxBound = + Octet B.One B.One B.One B.One B.One B.One B.One B.One + + +instance Enum Octet where + + -- | Create an 'Octet' from an 'Int'. The docs for Enum say we + -- should throw a runtime error on out-of-bounds, so we do. + toEnum x + | x < minBound || x > maxBound = error "octet out of bounds" + | otherwise = Octet a1 a2 a3 a4 a5 a6 a7 a8 + where + a1 = if (x >= 128) then B.One else B.Zero + a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero + a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero + a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero + a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero + a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero + a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero + a8 = if ((x `mod` 2) == 1) then B.One else B.Zero + + -- | Convert each bit to its integer value, and multiply by the + -- appropriate power of two. Sum them up, and we should get an integer + -- between 0 and 255. + fromEnum x = + 128 * (fromEnum (b1 x)) + + 64 * (fromEnum (b2 x)) + + 32 * (fromEnum (b3 x)) + + 16 * (fromEnum (b4 x)) + + 8 * (fromEnum (b5 x)) + + 4 * (fromEnum (b6 x)) + + 2 * (fromEnum (b7 x)) + + 1 * (fromEnum (b8 x)) + + + +instance Read Octet where + readsPrec _ s = case (reads s :: [(Int, String)]) of - [] -> Octet.None - x:_ -> octet_from_int (fst x) - - --- The octet with the least possible value. -min_octet :: Octet -min_octet = Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero - - --- The octet with the greatest possible value. -max_octet :: Octet -max_octet = Octet B.One B.One B.One B.One B.One B.One B.One B.One - + [] -> [] + (x,leftover):_ -> go x leftover + where + go :: Int -> String -> [(Octet, String)] + go x' leftover' + | x' < minBound || x' > maxBound = [] + | otherwise = [(toEnum x', leftover')] + + +-- Test lists. +octet_tests :: TestTree +octet_tests = + testGroup "Octet Tests" [ + test_octet_from_int1, + test_octet_mask1, + test_octet_mask2 ] + +octet_properties :: TestTree +octet_properties = + testGroup + "Octet Properties " + [ prop_from_enum_to_enum_inverses, + prop_read_show_inverses ] + +-- QuickCheck properties +prop_from_enum_to_enum_inverses :: TestTree +prop_from_enum_to_enum_inverses = + testProperty "fromEnum and toEnum are inverses" prop + where + prop :: Int -> Property + prop x = + (0 <= x) && (x <= 255) ==> + fromEnum (toEnum x :: Octet) == x + +prop_read_show_inverses :: TestTree +prop_read_show_inverses = + testProperty "read and show are inverses" prop + where + prop :: Int -> Property + prop x = (0 <= x) && (x <= 255) ==> x' == x + where + oct :: Octet + oct = read $ show x + + x' :: Int + x' = read $ show oct -- HUnit Tests -test_octet_from_int1 :: Test +test_octet_from_int1 :: TestTree test_octet_from_int1 = - TestCase $ assertEqual "octet_from_int 128 should parse as 10000000" oct1 (octet_from_int 128) - where - oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero + testCase desc $ actual @?= expected + where + desc = "octet_from_int 128 should parse as 10000000" + expected = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero + actual = toEnum 128 -test_octet_mask1 :: Test +test_octet_mask1 :: TestTree test_octet_mask1 = - TestCase $ assertEqual "The network bits of 255/4 should equal 240" oct2 (apply_mask oct1 Four B.Zero) - where - oct1 = octet_from_int 255 - oct2 = octet_from_int 240 + testCase desc $ actual @?= expected + where + desc = "The network bits of 255/4 should equal 240" + expected = toEnum 240 :: Octet + actual = apply_mask (toEnum 255) Four B.Zero -test_octet_mask2 :: Test +test_octet_mask2 :: TestTree test_octet_mask2 = - TestCase $ assertEqual "The network bits of 255/1 should equal 128" oct2 (apply_mask oct1 Maskbits.One B.Zero) - where - oct1 = octet_from_int 255 - oct2 = octet_from_int 128 - - -octet_tests :: [Test] -octet_tests = [ test_octet_from_int1, - test_octet_mask1, - test_octet_mask2 ] + testCase desc $ actual @?= expected + where + desc = "The network bits of 255/1 should equal 128" + expected = toEnum 128 :: Octet + actual = apply_mask (toEnum 255) Maskbits.One B.Zero