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, Ord)
  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 Bounded Octet where
  87   -- | The octet with the least possible value.
  88   minBound =
  89     Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
  90
  91   -- | The octet with the greatest possible value.
  92   maxBound =
  93     Octet B.One B.One B.One B.One B.One B.One B.One B.One
  94
  95
  96 instance Enum Octet where
  97
  98   -- | Create an 'Octet' from an 'Int'. The docs for Enum say we
  99   --   should throw a runtime error on out-of-bounds, so we do.
 100   toEnum x
 101     | x < minBound || x > maxBound = error "octet out of bounds"
 102     | otherwise = Octet a1 a2 a3 a4 a5 a6 a7 a8
 103         where
 104           a1 = if (x >= 128) then B.One else B.Zero
 105           a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
 106           a3 = if ((x `mod` 64)  >= 32) then B.One else B.Zero
 107           a4 = if ((x `mod` 32)  >= 16) then B.One else B.Zero
 108           a5 = if ((x `mod` 16)  >= 8)  then B.One else B.Zero
 109           a6 = if ((x `mod` 8)   >= 4)  then B.One else B.Zero
 110           a7 = if ((x `mod` 4)   >= 2)  then B.One else B.Zero
 111           a8 = if ((x `mod` 2)   == 1)  then B.One else B.Zero
 112
 113   -- | Convert each bit to its integer value, and multiply by the
 114   --   appropriate power of two. Sum them up, and we should get an integer
 115   --   between 0 and 255.
 116   fromEnum x =
 117     128 * (fromEnum (b1 x)) +
 118     64  * (fromEnum (b2 x)) +
 119     32  * (fromEnum (b3 x)) +
 120     16  * (fromEnum (b4 x)) +
 121     8   * (fromEnum (b5 x)) +
 122     4   * (fromEnum (b6 x)) +
 123     2   * (fromEnum (b7 x)) +
 124     1   * (fromEnum (b8 x))
 125
 126
 127
 128 instance Read Octet where
 129   readsPrec _ s =
 130     case (reads s :: [(Int, String)]) of
 131       []              -> []
 132       (x,leftover):_  -> go x leftover
 133     where
 134       go :: Int -> String -> [(Octet, String)]
 135       go x' leftover'
 136         | x' < minBound || x' > maxBound = []
 137         | otherwise = [(toEnum x', leftover')]
 138
 139
 140 -- Test lists.
 141 octet_tests :: TestTree
 142 octet_tests =
 143   testGroup "Octet Tests" [
 144     test_octet_to_enum1,
 145     test_octet_mask1,
 146     test_octet_mask2 ]
 147
 148 octet_properties :: TestTree
 149 octet_properties =
 150   testGroup
 151     "Octet Properties "
 152     [ prop_from_enum_to_enum_inverses,
 153       prop_read_show_inverses,
 154       prop_ord_instances_agree ]
 155
 156 -- QuickCheck properties
 157 prop_from_enum_to_enum_inverses :: TestTree
 158 prop_from_enum_to_enum_inverses =
 159   testProperty "fromEnum and toEnum are inverses" prop
 160   where
 161     prop :: Int -> Property
 162     prop x =
 163       (0 <= x) && (x <= 255) ==>
 164         fromEnum (toEnum x :: Octet) == x
 165
 166 prop_read_show_inverses :: TestTree
 167 prop_read_show_inverses =
 168   testProperty "read and show are inverses" prop
 169   where
 170     prop :: Int -> Property
 171     prop x = (0 <= x) && (x <= 255) ==> x' == x
 172       where
 173         oct :: Octet
 174         oct = read $ show x
 175
 176         x' :: Int
 177         x' = read $ show oct
 178
 179 -- | Ensure that the Ord instance for Octets agrees with the Ord
 180 --   instance for Int (i.e. that numerical comparisons work).
 181 prop_ord_instances_agree :: TestTree
 182 prop_ord_instances_agree =
 183   testProperty "the Octet and Int Ord instances agree" prop
 184   where
 185     prop :: Int -> Int -> Property
 186     prop x y = (0 <= x) && (x <= 255) && (0 <= y) && (y <= 255) ==> ord == ord'
 187       where
 188         ord = (x <= y)
 189
 190         oct1 = toEnum x :: Octet
 191         oct2 = toEnum y :: Octet
 192         ord' = (oct1 <= oct2)
 193
 194 -- HUnit Tests
 195 test_octet_to_enum1 :: TestTree
 196 test_octet_to_enum1 =
 197   testCase desc $ actual @?= expected
 198   where
 199     desc = "toEnum 128 should parse as 10000000"
 200     expected = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
 201     actual = toEnum 128 :: Octet
 202
 203
 204 test_octet_mask1 :: TestTree
 205 test_octet_mask1 =
 206   testCase desc $ actual @?= expected
 207   where
 208     desc = "The network bits of 255/4 should equal 240"
 209     expected = toEnum 240 :: Octet
 210     actual = apply_mask (toEnum 255) Four B.Zero :: Octet
 211
 212
 213 test_octet_mask2 :: TestTree
 214 test_octet_mask2 =
 215   testCase desc $ actual @?= expected
 216   where
 217     desc = "The network bits of 255/1 should equal 128"
 218     expected = toEnum 128 :: Octet
 219     actual = apply_mask (toEnum 255) Maskbits.One B.Zero :: Octet