src/Octet.hs

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