src/IPv4Address.hs

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