src/Octet.hs

   1 module Octet
   2 where
   3
   4 import Data.Maybe (fromJust)
   5 import Test.HUnit
   6 import Test.QuickCheck
   7
   8 import Bit as B
   9 import Maskable
  10 import Maskbits
  11
  12 -- | An Octet consists of eight bits. For our purposes, the most
  13 --   significant bit will come "first." That is, b1 is in the 2^7
  14 --   place while b8 is in the 2^0 place.
  15 data Octet =
  16   Octet { b1 :: Bit,
  17           b2 :: Bit,
  18           b3 :: Bit,
  19           b4 :: Bit,
  20           b5 :: Bit,
  21           b6 :: Bit,
  22           b7 :: Bit,
  23           b8 :: Bit }
  24     deriving (Eq)
  25
  26
  27 instance Show Octet where
  28   show oct = show (octet_to_int oct)
  29
  30
  31 instance Arbitrary Octet where
  32   arbitrary = do
  33     a1 <- arbitrary :: Gen Bit
  34     a2 <- arbitrary :: Gen Bit
  35     a3 <- arbitrary :: Gen Bit
  36     a4 <- arbitrary :: Gen Bit
  37     a5 <- arbitrary :: Gen Bit
  38     a6 <- arbitrary :: Gen Bit
  39     a7 <- arbitrary :: Gen Bit
  40     a8 <- arbitrary :: Gen Bit
  41     return (Octet a1 a2 a3 a4 a5 a6 a7 a8)
  42
  43
  44 instance Maskable Octet where
  45   apply_mask oct Eight _ =  oct
  46
  47   apply_mask oct Seven bit =
  48     oct { b8 = bit }
  49
  50   apply_mask oct Six bit =
  51     oct { b8 = bit, b7 = bit }
  52
  53   apply_mask oct Five bit =
  54     oct { b8 = bit, b7 = bit, b6 = bit }
  55
  56   apply_mask oct Four bit =
  57     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit }
  58
  59   apply_mask oct Three bit =
  60     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit }
  61
  62   apply_mask oct Two bit =
  63     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit }
  64
  65   apply_mask oct Maskbits.One bit =
  66     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
  67           b4 = bit, b3 = bit, b2 = bit }
  68
  69   apply_mask oct Maskbits.Zero bit =
  70     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
  71           b4 = bit, b3 = bit, b2 = bit, b1 = bit }
  72
  73   -- The Maskbits must be in [Eight..ThirtyTwo].
  74   apply_mask oct _ _ = oct
  75
  76
  77 -- | Convert each bit to its integer value, and multiply by the
  78 --   appropriate power of two. Sum them up, and we should get an integer
  79 --   between 0 and 255.
  80 octet_to_int :: Octet -> Int
  81 octet_to_int x =
  82   128 * (bit_to_int (b1 x)) +
  83   64  * (bit_to_int (b2 x)) +
  84   32  * (bit_to_int (b3 x)) +
  85   16  * (bit_to_int (b4 x)) +
  86   8   * (bit_to_int (b5 x)) +
  87   4   * (bit_to_int (b6 x)) +
  88   2   * (bit_to_int (b7 x)) +
  89   1   * (bit_to_int (b8 x))
  90
  91
  92
  93 octet_from_int :: Int -> Maybe Octet
  94 octet_from_int x
  95   | (x < 0) || (x > 255) = Nothing
  96   | otherwise = Just (Octet a1 a2 a3 a4 a5 a6 a7 a8)
  97   where
  98     a1 = if (x >= 128) then B.One else B.Zero
  99     a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
 100     a3 = if ((x `mod` 64)  >= 32) then B.One else B.Zero
 101     a4 = if ((x `mod` 32)  >= 16) then B.One else B.Zero
 102     a5 = if ((x `mod` 16)  >= 8)  then B.One else B.Zero
 103     a6 = if ((x `mod` 8)   >= 4)  then B.One else B.Zero
 104     a7 = if ((x `mod` 4)   >= 2)  then B.One else B.Zero
 105     a8 = if ((x `mod` 2)   == 1)  then B.One else B.Zero
 106
 107
 108 octet_from_string :: String -> Maybe Octet
 109 octet_from_string s =
 110   case (reads s :: [(Int, String)]) of
 111     []   -> Nothing
 112     x:_ -> octet_from_int (fst x)
 113
 114
 115 -- | The octet with the least possible value.
 116 min_octet :: Octet
 117 min_octet =
 118   Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
 119
 120
 121 -- | The octet with the greatest possible value.
 122 max_octet :: Octet
 123 max_octet =
 124   Octet B.One B.One B.One B.One B.One B.One B.One B.One
 125
 126
 127
 128 -- HUnit Tests
 129 test_octet_from_int1 :: Test
 130 test_octet_from_int1 =
 131   TestCase $ assertEqual "octet_from_int 128 should parse as 10000000" oct1 oct2
 132   where
 133     oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
 134     oct2 = fromJust $ octet_from_int 128
 135
 136 test_octet_mask1 :: Test
 137 test_octet_mask1 =
 138   TestCase $
 139     assertEqual
 140     "The network bits of 255/4 should equal 240"
 141     oct2
 142     (apply_mask oct1 Four B.Zero)
 143   where
 144     oct1 = fromJust $ octet_from_int 255
 145     oct2 = fromJust $ octet_from_int 240
 146
 147
 148 test_octet_mask2 :: Test
 149 test_octet_mask2 =
 150   TestCase $
 151     assertEqual
 152     "The network bits of 255/1 should equal 128"
 153     oct2
 154     (apply_mask oct1 Maskbits.One B.Zero)
 155   where
 156     oct1 = fromJust $ octet_from_int 255
 157     oct2 = fromJust $ octet_from_int 128
 158
 159
 160 octet_tests :: [Test]
 161 octet_tests =
 162   [ test_octet_from_int1,
 163     test_octet_mask1,
 164     test_octet_mask2 ]