src/IPv4Address.hs

   1 module IPv4Address(
   2   IPv4Address(..),
   3   ipv4address_properties,
   4   ipv4address_tests,
   5   most_sig_bit_different )
   6 where
   7
   8 import Test.HUnit (assertEqual)
   9 import Test.Framework (Test, testGroup)
  10 import Test.Framework.Providers.HUnit (testCase)
  11 import Test.Framework.Providers.QuickCheck2 (testProperty)
  12 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
  13
  14 import Maskable (Maskable(..))
  15 import Maskbits (Maskbits(..))
  16 import Octet (Octet(..))
  17
  18 data IPv4Address =
  19   IPv4Address { octet1 :: Octet,
  20                 octet2 :: Octet,
  21                 octet3 :: Octet,
  22                 octet4 :: Octet }
  23     deriving (Eq)
  24
  25
  26 instance Show IPv4Address where
  27   show addr = concat [(show oct1) ++ ".",
  28                       (show oct2) ++ ".",
  29                       (show oct3) ++ ".",
  30                       (show oct4)]
  31       where
  32         oct1 = (octet1 addr)
  33         oct2 = (octet2 addr)
  34         oct3 = (octet3 addr)
  35         oct4 = (octet4 addr)
  36
  37
  38 instance Arbitrary IPv4Address where
  39   arbitrary = do
  40     oct1 <- arbitrary :: Gen Octet
  41     oct2 <- arbitrary :: Gen Octet
  42     oct3 <- arbitrary :: Gen Octet
  43     oct4 <- arbitrary :: Gen Octet
  44     return (IPv4Address oct1 oct2 oct3 oct4)
  45
  46
  47
  48 instance Maskable IPv4Address where
  49
  50   apply_mask addr mask bit =
  51    apply_mask' mask
  52    where
  53      oct1 = octet1 addr
  54      oct2 = octet2 addr
  55      oct3 = octet3 addr
  56      oct4 = octet4 addr
  57
  58      -- A copy of 'addr' with the fourth octet zeroed (or oned).
  59      new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
  60
  61      -- Likewise for new_addr1's third octet.
  62      new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
  63
  64      -- And new_addr2's second octet.
  65      new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
  66
  67      -- This helper function allows us to pattern-match cleanly.
  68      apply_mask' :: Maskbits -> IPv4Address
  69
  70      apply_mask' ThirtyTwo = addr
  71
  72      apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
  73
  74      apply_mask' Thirty =
  75        addr { octet4 = (apply_mask oct4 Six bit) }
  76
  77      apply_mask' TwentyNine =
  78        addr { octet4 = (apply_mask oct4 Five bit) }
  79
  80      apply_mask' TwentyEight =
  81        addr { octet4 = (apply_mask oct4 Four bit) }
  82
  83      apply_mask' TwentySeven =
  84        addr { octet4 = (apply_mask oct4 Three bit) }
  85
  86      apply_mask' TwentySix =
  87        addr { octet4 = (apply_mask oct4 Two bit) }
  88
  89      apply_mask' TwentyFive =
  90        addr { octet4 = (apply_mask oct4 One bit) }
  91
  92      apply_mask' TwentyFour = new_addr1
  93
  94      apply_mask' TwentyThree =
  95        new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
  96
  97      apply_mask' TwentyTwo =
  98        new_addr1 { octet3 = (apply_mask oct3 Six bit) }
  99
 100      apply_mask' TwentyOne =
 101        new_addr1 { octet3 = (apply_mask oct3 Five bit) }
 102
 103      apply_mask' Twenty =
 104        new_addr1 { octet3 = (apply_mask oct3 Four bit) }
 105
 106      apply_mask' Nineteen =
 107        new_addr1 { octet3 = (apply_mask oct3 Three bit) }
 108
 109      apply_mask' Eighteen =
 110        new_addr1 { octet3 = (apply_mask oct3 Two bit) }
 111
 112      apply_mask' Seventeen =
 113        new_addr1 { octet3 = (apply_mask oct3 One bit) }
 114
 115      apply_mask' Sixteen =
 116        new_addr2
 117
 118      apply_mask' Fifteen =
 119        new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
 120
 121      apply_mask' Fourteen =
 122        new_addr2 { octet2 = (apply_mask oct2 Six bit) }
 123
 124      apply_mask' Thirteen =
 125        new_addr2 { octet2 = (apply_mask oct2 Five bit) }
 126
 127      apply_mask' Twelve =
 128        new_addr2 { octet2 = (apply_mask oct2 Four bit) }
 129
 130      apply_mask' Eleven =
 131        new_addr2 { octet2 = (apply_mask oct2 Three bit) }
 132
 133      apply_mask' Ten =
 134        new_addr2 { octet2 = (apply_mask oct2 Two bit) }
 135
 136      apply_mask' Nine =
 137        new_addr2 { octet2 = (apply_mask oct2 One bit) }
 138
 139      apply_mask' Eight =
 140        new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
 141
 142      apply_mask' Seven =
 143        new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
 144
 145      apply_mask' Six =
 146        new_addr3 { octet1 = (apply_mask oct1 Six bit) }
 147
 148      apply_mask' Five =
 149        new_addr3 { octet1 = (apply_mask oct1 Five bit) }
 150
 151      apply_mask' Four =
 152        new_addr3 { octet1 = (apply_mask oct1 Four bit) }
 153
 154      apply_mask' Three =
 155        new_addr3 { octet1 = (apply_mask oct1 Three bit) }
 156
 157      apply_mask' Two =
 158        new_addr3 { octet1 = (apply_mask oct1 Two bit) }
 159
 160      apply_mask' One =
 161        new_addr3 { octet1 = (apply_mask oct1 One bit) }
 162
 163      apply_mask' Zero =
 164        new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
 165
 166
 167 instance Bounded IPv4Address where
 168   -- | The minimum possible IPv4 address, 0.0.0.0.
 169   minBound = IPv4Address minBound minBound minBound minBound
 170
 171   -- | The maximum possible IPv4 address, 255.255.255.255.
 172   maxBound = IPv4Address maxBound maxBound maxBound maxBound
 173
 174
 175
 176
 177 instance Enum IPv4Address where
 178   -- | Convert an 'Int' @x@ to an 'IPv4Address'. Each octet of @x@ is
 179   --   right-shifted by the appropriate number of bits, and the fractional
 180   --   part is dropped.
 181   toEnum x =
 182     IPv4Address oct1 oct2 oct3 oct4
 183     where
 184       -- Chop off the higher octets. x1 = x `mod` 2^32, would be
 185       -- redundant.
 186       x2 = x `mod` 2^(24 :: Integer)
 187       x3 = x `mod` 2^(16 :: Integer)
 188       x4 = x `mod` 2^(8  :: Integer)
 189       -- Perform right-shifts. x4 doesn't need a shift.
 190       shifted_x1 = x `quot` 2^(24 :: Integer)
 191       shifted_x2 = x2 `quot` 2^(16 :: Integer)
 192       shifted_x3 = x3 `quot` 2^(8 :: Integer)
 193       oct1 = toEnum shifted_x1
 194       oct2 = toEnum shifted_x2
 195       oct3 = toEnum shifted_x3
 196       oct4 = toEnum x4
 197
 198   -- | Convert @addr@ to an 'Int' by converting each octet to an 'Int'
 199   --   and shifting the result to the left by 0,8.16, or 24 bits.
 200   fromEnum addr =
 201     (shifted_oct1) + (shifted_oct2) + (shifted_oct3) + oct4
 202     where
 203       oct1 = fromEnum (octet1 addr)
 204       oct2 = fromEnum (octet2 addr)
 205       oct3 = fromEnum (octet3 addr)
 206       oct4 = fromEnum (octet4 addr)
 207       shifted_oct1 = oct1 * 2^(24 :: Integer)
 208       shifted_oct2 = oct2 * 2^(16 :: Integer)
 209       shifted_oct3 = oct3 * 2^(8 :: Integer)
 210
 211 -- | Given two addresses, find the number of the most significant bit
 212 --   where they differ. If the addresses are the same, return
 213 --   Maskbits.Zero.
 214 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
 215 most_sig_bit_different addr1 addr2
 216   | addr1 == addr2 = Maskbits.Zero
 217   | m1  /= n1  = Maskbits.One
 218   | m2  /= n2  = Two
 219   | m3  /= n3  = Three
 220   | m4  /= n4  = Four
 221   | m5  /= n5  = Five
 222   | m6  /= n6  = Six
 223   | m7  /= n7  = Seven
 224   | m8  /= n8  = Eight
 225   | m9  /= n9  = Nine
 226   | m10 /= n10 = Ten
 227   | m11 /= n11 = Eleven
 228   | m12 /= n12 = Twelve
 229   | m13 /= n13 = Thirteen
 230   | m14 /= n14 = Fourteen
 231   | m15 /= n15 = Fifteen
 232   | m16 /= n16 = Sixteen
 233   | m17 /= n17 = Seventeen
 234   | m18 /= n18 = Eighteen
 235   | m19 /= n19 = Nineteen
 236   | m20 /= n20 = Twenty
 237   | m21 /= n21 = TwentyOne
 238   | m22 /= n22 = TwentyTwo
 239   | m23 /= n23 = TwentyThree
 240   | m24 /= n24 = TwentyFour
 241   | m25 /= n25 = TwentyFive
 242   | m26 /= n26 = TwentySix
 243   | m27 /= n27 = TwentySeven
 244   | m28 /= n28 = TwentyEight
 245   | m29 /= n29 = TwentyNine
 246   | m30 /= n30 = Thirty
 247   | m31 /= n31 = ThirtyOne
 248   | m32 /= n32 = ThirtyTwo
 249   | otherwise  = Maskbits.Zero
 250   where
 251     m1  = (b1 oct1a)
 252     m2  = (b2 oct1a)
 253     m3  = (b3 oct1a)
 254     m4  = (b4 oct1a)
 255     m5  = (b5 oct1a)
 256     m6  = (b6 oct1a)
 257     m7  = (b7 oct1a)
 258     m8  = (b8 oct1a)
 259     m9  = (b1 oct2a)
 260     m10 = (b2 oct2a)
 261     m11 = (b3 oct2a)
 262     m12 = (b4 oct2a)
 263     m13 = (b5 oct2a)
 264     m14 = (b6 oct2a)
 265     m15 = (b7 oct2a)
 266     m16 = (b8 oct2a)
 267     m17 = (b1 oct3a)
 268     m18 = (b2 oct3a)
 269     m19 = (b3 oct3a)
 270     m20 = (b4 oct3a)
 271     m21 = (b5 oct3a)
 272     m22 = (b6 oct3a)
 273     m23 = (b7 oct3a)
 274     m24 = (b8 oct3a)
 275     m25 = (b1 oct4a)
 276     m26 = (b2 oct4a)
 277     m27 = (b3 oct4a)
 278     m28 = (b4 oct4a)
 279     m29 = (b5 oct4a)
 280     m30 = (b6 oct4a)
 281     m31 = (b7 oct4a)
 282     m32 = (b8 oct4a)
 283     oct1a = (octet1 addr1)
 284     oct2a = (octet2 addr1)
 285     oct3a = (octet3 addr1)
 286     oct4a = (octet4 addr1)
 287     n1  = (b1 oct1b)
 288     n2  = (b2 oct1b)
 289     n3  = (b3 oct1b)
 290     n4  = (b4 oct1b)
 291     n5  = (b5 oct1b)
 292     n6  = (b6 oct1b)
 293     n7  = (b7 oct1b)
 294     n8  = (b8 oct1b)
 295     n9  = (b1 oct2b)
 296     n10 = (b2 oct2b)
 297     n11 = (b3 oct2b)
 298     n12 = (b4 oct2b)
 299     n13 = (b5 oct2b)
 300     n14 = (b6 oct2b)
 301     n15 = (b7 oct2b)
 302     n16 = (b8 oct2b)
 303     n17 = (b1 oct3b)
 304     n18 = (b2 oct3b)
 305     n19 = (b3 oct3b)
 306     n20 = (b4 oct3b)
 307     n21 = (b5 oct3b)
 308     n22 = (b6 oct3b)
 309     n23 = (b7 oct3b)
 310     n24 = (b8 oct3b)
 311     n25 = (b1 oct4b)
 312     n26 = (b2 oct4b)
 313     n27 = (b3 oct4b)
 314     n28 = (b4 oct4b)
 315     n29 = (b5 oct4b)
 316     n30 = (b6 oct4b)
 317     n31 = (b7 oct4b)
 318     n32 = (b8 oct4b)
 319     oct1b = (octet1 addr2)
 320     oct2b = (octet2 addr2)
 321     oct3b = (octet3 addr2)
 322     oct4b = (octet4 addr2)
 323
 324
 325 -- Test lists.
 326 ipv4address_tests :: Test
 327 ipv4address_tests =
 328   testGroup "IPv4 Address Tests" [
 329     test_enum,
 330     test_maxBound,
 331     test_minBound,
 332     test_most_sig_bit_different1,
 333     test_most_sig_bit_different2,
 334     test_to_enum ]
 335
 336 ipv4address_properties :: Test
 337 ipv4address_properties =
 338   testGroup
 339     "IPv4 Address Properties "
 340     [ testProperty
 341         "fromEnum/toEnum are inverses"
 342         prop_from_enum_to_enum_inverses ]
 343
 344 -- QuickCheck properties
 345 prop_from_enum_to_enum_inverses :: Int -> Property
 346 prop_from_enum_to_enum_inverses x =
 347   (0 <= x) && (x <= 2^(32 :: Integer) - 1) ==>
 348     fromEnum (toEnum x :: IPv4Address) == x
 349
 350 -- HUnit Tests
 351 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
 352 mk_testaddr a b c d =
 353   IPv4Address oct1 oct2 oct3 oct4
 354   where
 355     oct1 = toEnum a
 356     oct2 = toEnum b
 357     oct3 = toEnum c
 358     oct4 = toEnum d
 359
 360 test_minBound :: Test
 361 test_minBound =
 362   testCase desc $ assertEqual desc expected actual
 363   where
 364     desc = "minBound should be 0.0.0.0"
 365     expected = mk_testaddr 0 0 0 0
 366     actual = minBound :: IPv4Address
 367
 368 test_maxBound :: Test
 369 test_maxBound =
 370   testCase desc $ assertEqual desc expected actual
 371   where
 372     desc = "maxBound should be 255.255.255.255"
 373     expected = mk_testaddr 255 255 255 255
 374     actual = maxBound :: IPv4Address
 375
 376 test_enum :: Test
 377 test_enum =
 378   testCase desc $ assertEqual desc expected actual
 379   where
 380     desc = "enumerating a /24 gives the correct addresses"
 381     expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ]
 382     lb = mk_testaddr 192 168 0 0
 383     ub = mk_testaddr 192 168 0 255
 384     actual = map show [lb..ub]
 385
 386 test_most_sig_bit_different1 :: Test
 387 test_most_sig_bit_different1 =
 388   testCase desc $ assertEqual desc
 389              TwentyFour
 390              bit
 391   where
 392     desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
 393     addr1 = mk_testaddr 10 1 1 0
 394     addr2 = (mk_testaddr 10 1 0 0)
 395     bit = most_sig_bit_different addr1 addr2
 396
 397
 398
 399 test_most_sig_bit_different2 :: Test
 400 test_most_sig_bit_different2 =
 401   testCase desc $ assertEqual desc
 402                TwentyThree
 403                bit
 404   where
 405     desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
 406     addr1 = mk_testaddr 10 1 2 0
 407     addr2 = mk_testaddr 10 1 1 0
 408     bit = most_sig_bit_different addr1 addr2
 409
 410
 411 test_to_enum :: Test
 412 test_to_enum =
 413   testCase desc $ assertEqual desc expected actual
 414   where
 415     desc     = "192.168.0.0 in base-10 is 3232235520"
 416     expected = mk_testaddr 192 168 0 0
 417     actual   = toEnum 3232235520