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 instance Ord Octet where
  82   (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8)
  83     | x1 > y1 = False
  84     | x2 > y2 = False
  85     | x3 > y3 = False
  86     | x4 > y4 = False
  87     | x5 > y5 = False
  88     | x6 > y6 = False
  89     | x7 > y7 = False
  90     | x8 > y8 = False
  91     | otherwise = True
  92
  93
  94 instance Bounded Octet where
  95   -- | The octet with the least possible value.
  96   minBound =
  97     Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
  98
  99   -- | The octet with the greatest possible value.
 100   maxBound =
 101     Octet B.One B.One B.One B.One B.One B.One B.One B.One
 102
 103
 104 instance Enum Octet where
 105   -- We're supposed to throw a runtime error if you call (succ
 106   -- maxBound), so the fromJust here doesn't introduce any additional
 107   -- badness.
 108   toEnum = fromJust . octet_from_int
 109   fromEnum = octet_to_int
 110
 111 -- | Convert each bit to its integer value, and multiply by the
 112 --   appropriate power of two. Sum them up, and we should get an integer
 113 --   between 0 and 255.
 114 octet_to_int :: Octet -> Int
 115 octet_to_int x =
 116   128 * (bit_to_int (b1 x)) +
 117   64  * (bit_to_int (b2 x)) +
 118   32  * (bit_to_int (b3 x)) +
 119   16  * (bit_to_int (b4 x)) +
 120   8   * (bit_to_int (b5 x)) +
 121   4   * (bit_to_int (b6 x)) +
 122   2   * (bit_to_int (b7 x)) +
 123   1   * (bit_to_int (b8 x))
 124
 125
 126
 127 octet_from_int :: Int -> Maybe Octet
 128 octet_from_int x
 129   | (x < 0) || (x > 255) = Nothing
 130   | otherwise = Just (Octet a1 a2 a3 a4 a5 a6 a7 a8)
 131   where
 132     a1 = if (x >= 128) then B.One else B.Zero
 133     a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
 134     a3 = if ((x `mod` 64)  >= 32) then B.One else B.Zero
 135     a4 = if ((x `mod` 32)  >= 16) then B.One else B.Zero
 136     a5 = if ((x `mod` 16)  >= 8)  then B.One else B.Zero
 137     a6 = if ((x `mod` 8)   >= 4)  then B.One else B.Zero
 138     a7 = if ((x `mod` 4)   >= 2)  then B.One else B.Zero
 139     a8 = if ((x `mod` 2)   == 1)  then B.One else B.Zero
 140
 141
 142 octet_from_string :: String -> Maybe Octet
 143 octet_from_string s =
 144   case (reads s :: [(Int, String)]) of
 145     []   -> Nothing
 146     x:_ -> octet_from_int (fst x)
 147
 148
 149
 150 -- HUnit Tests
 151 test_octet_from_int1 :: Test
 152 test_octet_from_int1 =
 153   testCase desc $ assertEqual desc oct1 oct2
 154   where
 155     desc = "octet_from_int 128 should parse as 10000000"
 156     oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
 157     oct2 = fromJust $ octet_from_int 128
 158
 159 test_octet_mask1 :: Test
 160 test_octet_mask1 =
 161   testCase desc $
 162     assertEqual desc oct2 (apply_mask oct1 Four B.Zero)
 163   where
 164     desc = "The network bits of 255/4 should equal 240"
 165     oct1 = fromJust $ octet_from_int 255
 166     oct2 = fromJust $ octet_from_int 240
 167
 168
 169 test_octet_mask2 :: Test
 170 test_octet_mask2 =
 171   testCase desc $
 172     assertEqual desc oct2 (apply_mask oct1 Maskbits.One B.Zero)
 173   where
 174     desc = "The network bits of 255/1 should equal 128"
 175     oct1 = fromJust $ octet_from_int 255
 176     oct2 = fromJust $ octet_from_int 128
 177
 178
 179 octet_tests :: Test
 180 octet_tests =
 181   testGroup "Octet Tests" [
 182     test_octet_from_int1,
 183     test_octet_mask1,
 184     test_octet_mask2 ]