src/Octet.hs

   1 module Octet (
   2   Octet(..),
   3   octet_properties,
   4   octet_tests )
   5 where
   6
   7 import Test.QuickCheck ( Gen ) -- Not re-exported by tasty
   8 import Test.Tasty ( TestTree, testGroup )
   9 import Test.Tasty.HUnit ( (@?=), testCase )
  10 import Test.Tasty.QuickCheck (
  11   Arbitrary(..),
  12   Property,
  13   (==>),
  14   testProperty )
  15
  16 import Bit as B (Bit(..))
  17 import Maskable (Maskable(..))
  18 import Maskbits (Maskbits(..))
  19
  20 -- | An Octet consists of eight bits. For our purposes, the most
  21 --   significant bit will come "first." That is, b1 is in the 2^7
  22 --   place while b8 is in the 2^0 place.
  23 data Octet =
  24   Octet { b1 :: Bit,
  25           b2 :: Bit,
  26           b3 :: Bit,
  27           b4 :: Bit,
  28           b5 :: Bit,
  29           b6 :: Bit,
  30           b7 :: Bit,
  31           b8 :: Bit }
  32     deriving (Eq)
  33
  34
  35 instance Show Octet where
  36   show oct = show (fromEnum oct)
  37
  38
  39 instance Arbitrary Octet where
  40   arbitrary = do
  41     a1 <- arbitrary :: Gen Bit
  42     a2 <- arbitrary :: Gen Bit
  43     a3 <- arbitrary :: Gen Bit
  44     a4 <- arbitrary :: Gen Bit
  45     a5 <- arbitrary :: Gen Bit
  46     a6 <- arbitrary :: Gen Bit
  47     a7 <- arbitrary :: Gen Bit
  48     a8 <- arbitrary :: Gen Bit
  49     return (Octet a1 a2 a3 a4 a5 a6 a7 a8)
  50
  51
  52 instance Maskable Octet where
  53   apply_mask oct Eight _ =  oct
  54
  55   apply_mask oct Seven bit =
  56     oct { b8 = bit }
  57
  58   apply_mask oct Six bit =
  59     oct { b8 = bit, b7 = bit }
  60
  61   apply_mask oct Five bit =
  62     oct { b8 = bit, b7 = bit, b6 = bit }
  63
  64   apply_mask oct Four bit =
  65     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit }
  66
  67   apply_mask oct Three bit =
  68     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit }
  69
  70   apply_mask oct Two bit =
  71     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit }
  72
  73   apply_mask oct Maskbits.One bit =
  74     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
  75           b4 = bit, b3 = bit, b2 = bit }
  76
  77   apply_mask oct Maskbits.Zero bit =
  78     oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
  79           b4 = bit, b3 = bit, b2 = bit, b1 = bit }
  80
  81   -- The Maskbits must be in [Eight..ThirtyTwo].
  82   apply_mask oct _ _ = oct
  83
  84
  85 instance Ord Octet where
  86   (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8)
  87     | x1 > y1 = False
  88     | x2 > y2 = False
  89     | x3 > y3 = False
  90     | x4 > y4 = False
  91     | x5 > y5 = False
  92     | x6 > y6 = False
  93     | x7 > y7 = False
  94     | x8 > y8 = False
  95     | otherwise = True
  96
  97
  98 instance Bounded Octet where
  99   -- | The octet with the least possible value.
 100   minBound =
 101     Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
 102
 103   -- | The octet with the greatest possible value.
 104   maxBound =
 105     Octet B.One B.One B.One B.One B.One B.One B.One B.One
 106
 107
 108 instance Enum Octet where
 109
 110   -- | Create an 'Octet' from an 'Int'. The docs for Enum say we
 111   --   should throw a runtime error on out-of-bounds, so we do.
 112   toEnum x
 113     | x < minBound || x > maxBound = error "octet out of bounds"
 114     | otherwise = Octet a1 a2 a3 a4 a5 a6 a7 a8
 115         where
 116           a1 = if (x >= 128) then B.One else B.Zero
 117           a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
 118           a3 = if ((x `mod` 64)  >= 32) then B.One else B.Zero
 119           a4 = if ((x `mod` 32)  >= 16) then B.One else B.Zero
 120           a5 = if ((x `mod` 16)  >= 8)  then B.One else B.Zero
 121           a6 = if ((x `mod` 8)   >= 4)  then B.One else B.Zero
 122           a7 = if ((x `mod` 4)   >= 2)  then B.One else B.Zero
 123           a8 = if ((x `mod` 2)   == 1)  then B.One else B.Zero
 124
 125   -- | Convert each bit to its integer value, and multiply by the
 126   --   appropriate power of two. Sum them up, and we should get an integer
 127   --   between 0 and 255.
 128   fromEnum x =
 129     128 * (fromEnum (b1 x)) +
 130     64  * (fromEnum (b2 x)) +
 131     32  * (fromEnum (b3 x)) +
 132     16  * (fromEnum (b4 x)) +
 133     8   * (fromEnum (b5 x)) +
 134     4   * (fromEnum (b6 x)) +
 135     2   * (fromEnum (b7 x)) +
 136     1   * (fromEnum (b8 x))
 137
 138
 139
 140 instance Read Octet where
 141   readsPrec _ s =
 142     case (reads s :: [(Int, String)]) of
 143       []              -> []
 144       (x,leftover):_  -> go x leftover
 145     where
 146       go :: Int -> String -> [(Octet, String)]
 147       go x' leftover'
 148         | x' < minBound || x' > maxBound = []
 149         | otherwise = [(toEnum x', leftover')]
 150
 151
 152 -- Test lists.
 153 octet_tests :: TestTree
 154 octet_tests =
 155   testGroup "Octet Tests" [
 156     test_octet_from_int1,
 157     test_octet_mask1,
 158     test_octet_mask2 ]
 159
 160 octet_properties :: TestTree
 161 octet_properties =
 162   testGroup
 163     "Octet Properties "
 164     [ prop_from_enum_to_enum_inverses,
 165       prop_read_show_inverses ]
 166
 167 -- QuickCheck properties
 168 prop_from_enum_to_enum_inverses :: TestTree
 169 prop_from_enum_to_enum_inverses =
 170   testProperty "fromEnum and toEnum are inverses" prop
 171   where
 172     prop :: Int -> Property
 173     prop x =
 174       (0 <= x) && (x <= 255) ==>
 175         fromEnum (toEnum x :: Octet) == x
 176
 177 prop_read_show_inverses :: TestTree
 178 prop_read_show_inverses =
 179   testProperty "read and show are inverses" prop
 180   where
 181     prop :: Int -> Property
 182     prop x = (0 <= x) && (x <= 255) ==> x' == x
 183       where
 184         oct :: Octet
 185         oct = read $ show x
 186
 187         x' :: Int
 188         x' = read $ show oct
 189
 190
 191 -- HUnit Tests
 192 test_octet_from_int1 :: TestTree
 193 test_octet_from_int1 =
 194   testCase desc $ actual @?= expected
 195   where
 196     desc = "octet_from_int 128 should parse as 10000000"
 197     expected = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
 198     actual = toEnum 128
 199
 200
 201 test_octet_mask1 :: TestTree
 202 test_octet_mask1 =
 203   testCase desc $ actual @?= expected
 204   where
 205     desc = "The network bits of 255/4 should equal 240"
 206     expected = toEnum 240 :: Octet
 207     actual = apply_mask (toEnum 255) Four B.Zero
 208
 209
 210 test_octet_mask2 :: TestTree
 211 test_octet_mask2 =
 212   testCase desc $ actual @?= expected
 213   where
 214     desc = "The network bits of 255/1 should equal 128"
 215     expected = toEnum 128 :: Octet
 216     actual = apply_mask (toEnum 255) Maskbits.One B.Zero