src/IPv4Address.hs

   1 module IPv4Address
   2 ( ipv4address_tests,
   3   IPv4Address(..),
   4   max_address,
   5   min_address,
   6   most_sig_bit_different,
   7 ) where
   8
   9 import Data.Maybe (fromJust)
  10 import Test.HUnit (assertEqual)
  11 import Test.Framework (Test, testGroup)
  12 import Test.Framework.Providers.HUnit (testCase)
  13 import Test.QuickCheck (Arbitrary(..), Gen)
  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
 169 -- | The minimum possible IPv4 address, 0.0.0.0.
 170 min_address :: IPv4Address
 171 min_address =
 172   IPv4Address min_octet min_octet min_octet min_octet
 173
 174
 175 -- | The maximum possible IPv4 address, 255.255.255.255.
 176 max_address :: IPv4Address
 177 max_address =
 178   IPv4Address max_octet max_octet max_octet max_octet
 179
 180
 181 -- | Given two addresses, find the number of the most significant bit
 182 --   where they differ. If the addresses are the same, return
 183 --   Maskbits.Zero.
 184 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
 185 most_sig_bit_different addr1 addr2
 186   | addr1 == addr2 = Maskbits.Zero
 187   | m1  /= n1  = Maskbits.One
 188   | m2  /= n2  = Two
 189   | m3  /= n3  = Three
 190   | m4  /= n4  = Four
 191   | m5  /= n5  = Five
 192   | m6  /= n6  = Six
 193   | m7  /= n7  = Seven
 194   | m8  /= n8  = Eight
 195   | m9  /= n9  = Nine
 196   | m10 /= n10 = Ten
 197   | m11 /= n11 = Eleven
 198   | m12 /= n12 = Twelve
 199   | m13 /= n13 = Thirteen
 200   | m14 /= n14 = Fourteen
 201   | m15 /= n15 = Fifteen
 202   | m16 /= n16 = Sixteen
 203   | m17 /= n17 = Seventeen
 204   | m18 /= n18 = Eighteen
 205   | m19 /= n19 = Nineteen
 206   | m20 /= n20 = Twenty
 207   | m21 /= n21 = TwentyOne
 208   | m22 /= n22 = TwentyTwo
 209   | m23 /= n23 = TwentyThree
 210   | m24 /= n24 = TwentyFour
 211   | m25 /= n25 = TwentyFive
 212   | m26 /= n26 = TwentySix
 213   | m27 /= n27 = TwentySeven
 214   | m28 /= n28 = TwentyEight
 215   | m29 /= n29 = TwentyNine
 216   | m30 /= n30 = Thirty
 217   | m31 /= n31 = ThirtyOne
 218   | m32 /= n32 = ThirtyTwo
 219   | otherwise  = Maskbits.Zero
 220   where
 221     m1  = (b1 oct1a)
 222     m2  = (b2 oct1a)
 223     m3  = (b3 oct1a)
 224     m4  = (b4 oct1a)
 225     m5  = (b5 oct1a)
 226     m6  = (b6 oct1a)
 227     m7  = (b7 oct1a)
 228     m8  = (b8 oct1a)
 229     m9  = (b1 oct2a)
 230     m10 = (b2 oct2a)
 231     m11 = (b3 oct2a)
 232     m12 = (b4 oct2a)
 233     m13 = (b5 oct2a)
 234     m14 = (b6 oct2a)
 235     m15 = (b7 oct2a)
 236     m16 = (b8 oct2a)
 237     m17 = (b1 oct3a)
 238     m18 = (b2 oct3a)
 239     m19 = (b3 oct3a)
 240     m20 = (b4 oct3a)
 241     m21 = (b5 oct3a)
 242     m22 = (b6 oct3a)
 243     m23 = (b7 oct3a)
 244     m24 = (b8 oct3a)
 245     m25 = (b1 oct4a)
 246     m26 = (b2 oct4a)
 247     m27 = (b3 oct4a)
 248     m28 = (b4 oct4a)
 249     m29 = (b5 oct4a)
 250     m30 = (b6 oct4a)
 251     m31 = (b7 oct4a)
 252     m32 = (b8 oct4a)
 253     oct1a = (octet1 addr1)
 254     oct2a = (octet2 addr1)
 255     oct3a = (octet3 addr1)
 256     oct4a = (octet4 addr1)
 257     n1  = (b1 oct1b)
 258     n2  = (b2 oct1b)
 259     n3  = (b3 oct1b)
 260     n4  = (b4 oct1b)
 261     n5  = (b5 oct1b)
 262     n6  = (b6 oct1b)
 263     n7  = (b7 oct1b)
 264     n8  = (b8 oct1b)
 265     n9  = (b1 oct2b)
 266     n10 = (b2 oct2b)
 267     n11 = (b3 oct2b)
 268     n12 = (b4 oct2b)
 269     n13 = (b5 oct2b)
 270     n14 = (b6 oct2b)
 271     n15 = (b7 oct2b)
 272     n16 = (b8 oct2b)
 273     n17 = (b1 oct3b)
 274     n18 = (b2 oct3b)
 275     n19 = (b3 oct3b)
 276     n20 = (b4 oct3b)
 277     n21 = (b5 oct3b)
 278     n22 = (b6 oct3b)
 279     n23 = (b7 oct3b)
 280     n24 = (b8 oct3b)
 281     n25 = (b1 oct4b)
 282     n26 = (b2 oct4b)
 283     n27 = (b3 oct4b)
 284     n28 = (b4 oct4b)
 285     n29 = (b5 oct4b)
 286     n30 = (b6 oct4b)
 287     n31 = (b7 oct4b)
 288     n32 = (b8 oct4b)
 289     oct1b = (octet1 addr2)
 290     oct2b = (octet2 addr2)
 291     oct3b = (octet3 addr2)
 292     oct4b = (octet4 addr2)
 293
 294
 295
 296 -- HUnit Tests
 297 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
 298 mk_testaddr a b c d =
 299   IPv4Address oct1 oct2 oct3 oct4
 300   where
 301     oct1 = fromJust $ octet_from_int a
 302     oct2 = fromJust $ octet_from_int b
 303     oct3 = fromJust $ octet_from_int c
 304     oct4 = fromJust $ octet_from_int d
 305
 306
 307 test_most_sig_bit_different1 :: Test
 308 test_most_sig_bit_different1 =
 309   testCase desc $ assertEqual desc
 310              TwentyFour
 311              bit
 312   where
 313     desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
 314     addr1 = mk_testaddr 10 1 1 0
 315     addr2 = (mk_testaddr 10 1 0 0)
 316     bit = most_sig_bit_different addr1 addr2
 317
 318
 319
 320 test_most_sig_bit_different2 :: Test
 321 test_most_sig_bit_different2 =
 322   testCase desc $ assertEqual desc
 323                TwentyThree
 324                bit
 325   where
 326     desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
 327     addr1 = mk_testaddr 10 1 2 0
 328     addr2 = mk_testaddr 10 1 1 0
 329     bit = most_sig_bit_different addr1 addr2
 330
 331
 332 ipv4address_tests :: Test
 333 ipv4address_tests =
 334   testGroup "IPv4 Address Tests" [
 335     test_most_sig_bit_different1,
 336     test_most_sig_bit_different2 ]