src/Octet.hs

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