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
  11 import Test.QuickCheck
  12
  13 import Maskable
  14 import Maskbits
  15 import Octet
  16
  17 data IPv4Address =
  18   IPv4Address { octet1 :: Octet,
  19                 octet2 :: Octet,
  20                 octet3 :: Octet,
  21                 octet4 :: Octet }
  22     deriving (Eq)
  23
  24
  25 instance Show IPv4Address where
  26   show addr = concat [(show oct1) ++ ".",
  27                       (show oct2) ++ ".",
  28                       (show oct3) ++ ".",
  29                       (show oct4)]
  30       where
  31         oct1 = (octet1 addr)
  32         oct2 = (octet2 addr)
  33         oct3 = (octet3 addr)
  34         oct4 = (octet4 addr)
  35
  36
  37 instance Arbitrary IPv4Address where
  38   arbitrary = do
  39     oct1 <- arbitrary :: Gen Octet
  40     oct2 <- arbitrary :: Gen Octet
  41     oct3 <- arbitrary :: Gen Octet
  42     oct4 <- arbitrary :: Gen Octet
  43     return (IPv4Address oct1 oct2 oct3 oct4)
  44
  45
  46
  47 instance Maskable IPv4Address where
  48
  49   apply_mask addr mask bit =
  50    apply_mask' mask
  51    where
  52      oct1 = octet1 addr
  53      oct2 = octet2 addr
  54      oct3 = octet3 addr
  55      oct4 = octet4 addr
  56
  57      -- A copy of 'addr' with the fourth octet zeroed (or oned).
  58      new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
  59
  60      -- Likewise for new_addr1's third octet.
  61      new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
  62
  63      -- And new_addr2's second octet.
  64      new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
  65
  66      -- This helper function allows us to pattern-match cleanly.
  67      apply_mask' :: Maskbits -> IPv4Address
  68
  69      apply_mask' ThirtyTwo = addr
  70
  71      apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
  72
  73      apply_mask' Thirty =
  74        addr { octet4 = (apply_mask oct4 Six bit) }
  75
  76      apply_mask' TwentyNine =
  77        addr { octet4 = (apply_mask oct4 Five bit) }
  78
  79      apply_mask' TwentyEight =
  80        addr { octet4 = (apply_mask oct4 Four bit) }
  81
  82      apply_mask' TwentySeven =
  83        addr { octet4 = (apply_mask oct4 Three bit) }
  84
  85      apply_mask' TwentySix =
  86        addr { octet4 = (apply_mask oct4 Two bit) }
  87
  88      apply_mask' TwentyFive =
  89        addr { octet4 = (apply_mask oct4 One bit) }
  90
  91      apply_mask' TwentyFour = new_addr1
  92
  93      apply_mask' TwentyThree =
  94        new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
  95
  96      apply_mask' TwentyTwo =
  97        new_addr1 { octet3 = (apply_mask oct3 Six bit) }
  98
  99      apply_mask' TwentyOne =
 100        new_addr1 { octet3 = (apply_mask oct3 Five bit) }
 101
 102      apply_mask' Twenty =
 103        new_addr1 { octet3 = (apply_mask oct3 Four bit) }
 104
 105      apply_mask' Nineteen =
 106        new_addr1 { octet3 = (apply_mask oct3 Three bit) }
 107
 108      apply_mask' Eighteen =
 109        new_addr1 { octet3 = (apply_mask oct3 Two bit) }
 110
 111      apply_mask' Seventeen =
 112        new_addr1 { octet3 = (apply_mask oct3 One bit) }
 113
 114      apply_mask' Sixteen =
 115        new_addr2
 116
 117      apply_mask' Fifteen =
 118        new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
 119
 120      apply_mask' Fourteen =
 121        new_addr2 { octet2 = (apply_mask oct2 Six bit) }
 122
 123      apply_mask' Thirteen =
 124        new_addr2 { octet2 = (apply_mask oct2 Five bit) }
 125
 126      apply_mask' Twelve =
 127        new_addr2 { octet2 = (apply_mask oct2 Four bit) }
 128
 129      apply_mask' Eleven =
 130        new_addr2 { octet2 = (apply_mask oct2 Three bit) }
 131
 132      apply_mask' Ten =
 133        new_addr2 { octet2 = (apply_mask oct2 Two bit) }
 134
 135      apply_mask' Nine =
 136        new_addr2 { octet2 = (apply_mask oct2 One bit) }
 137
 138      apply_mask' Eight =
 139        new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
 140
 141      apply_mask' Seven =
 142        new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
 143
 144      apply_mask' Six =
 145        new_addr3 { octet1 = (apply_mask oct1 Six bit) }
 146
 147      apply_mask' Five =
 148        new_addr3 { octet1 = (apply_mask oct1 Five bit) }
 149
 150      apply_mask' Four =
 151        new_addr3 { octet1 = (apply_mask oct1 Four bit) }
 152
 153      apply_mask' Three =
 154        new_addr3 { octet1 = (apply_mask oct1 Three bit) }
 155
 156      apply_mask' Two =
 157        new_addr3 { octet1 = (apply_mask oct1 Two bit) }
 158
 159      apply_mask' One =
 160        new_addr3 { octet1 = (apply_mask oct1 One bit) }
 161
 162      apply_mask' Zero =
 163        new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
 164
 165
 166
 167 -- | The minimum possible IPv4 address, 0.0.0.0.
 168 min_address :: IPv4Address
 169 min_address =
 170   IPv4Address min_octet min_octet min_octet min_octet
 171
 172
 173 -- | The maximum possible IPv4 address, 255.255.255.255.
 174 max_address :: IPv4Address
 175 max_address =
 176   IPv4Address max_octet max_octet max_octet max_octet
 177
 178
 179 -- | Given two addresses, find the number of the most significant bit
 180 --   where they differ. If the addresses are the same, return
 181 --   Maskbits.Zero.
 182 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
 183 most_sig_bit_different addr1 addr2
 184   | addr1 == addr2 = Maskbits.Zero
 185   | m1  /= n1  = Maskbits.One
 186   | m2  /= n2  = Two
 187   | m3  /= n3  = Three
 188   | m4  /= n4  = Four
 189   | m5  /= n5  = Five
 190   | m6  /= n6  = Six
 191   | m7  /= n7  = Seven
 192   | m8  /= n8  = Eight
 193   | m9  /= n9  = Nine
 194   | m10 /= n10 = Ten
 195   | m11 /= n11 = Eleven
 196   | m12 /= n12 = Twelve
 197   | m13 /= n13 = Thirteen
 198   | m14 /= n14 = Fourteen
 199   | m15 /= n15 = Fifteen
 200   | m16 /= n16 = Sixteen
 201   | m17 /= n17 = Seventeen
 202   | m18 /= n18 = Eighteen
 203   | m19 /= n19 = Nineteen
 204   | m20 /= n20 = Twenty
 205   | m21 /= n21 = TwentyOne
 206   | m22 /= n22 = TwentyTwo
 207   | m23 /= n23 = TwentyThree
 208   | m24 /= n24 = TwentyFour
 209   | m25 /= n25 = TwentyFive
 210   | m26 /= n26 = TwentySix
 211   | m27 /= n27 = TwentySeven
 212   | m28 /= n28 = TwentyEight
 213   | m29 /= n29 = TwentyNine
 214   | m30 /= n30 = Thirty
 215   | m31 /= n31 = ThirtyOne
 216   | m32 /= n32 = ThirtyTwo
 217   | otherwise  = Maskbits.Zero
 218   where
 219     m1  = (b1 oct1a)
 220     m2  = (b2 oct1a)
 221     m3  = (b3 oct1a)
 222     m4  = (b4 oct1a)
 223     m5  = (b5 oct1a)
 224     m6  = (b6 oct1a)
 225     m7  = (b7 oct1a)
 226     m8  = (b8 oct1a)
 227     m9  = (b1 oct2a)
 228     m10 = (b2 oct2a)
 229     m11 = (b3 oct2a)
 230     m12 = (b4 oct2a)
 231     m13 = (b5 oct2a)
 232     m14 = (b6 oct2a)
 233     m15 = (b7 oct2a)
 234     m16 = (b8 oct2a)
 235     m17 = (b1 oct3a)
 236     m18 = (b2 oct3a)
 237     m19 = (b3 oct3a)
 238     m20 = (b4 oct3a)
 239     m21 = (b5 oct3a)
 240     m22 = (b6 oct3a)
 241     m23 = (b7 oct3a)
 242     m24 = (b8 oct3a)
 243     m25 = (b1 oct4a)
 244     m26 = (b2 oct4a)
 245     m27 = (b3 oct4a)
 246     m28 = (b4 oct4a)
 247     m29 = (b5 oct4a)
 248     m30 = (b6 oct4a)
 249     m31 = (b7 oct4a)
 250     m32 = (b8 oct4a)
 251     oct1a = (octet1 addr1)
 252     oct2a = (octet2 addr1)
 253     oct3a = (octet3 addr1)
 254     oct4a = (octet4 addr1)
 255     n1  = (b1 oct1b)
 256     n2  = (b2 oct1b)
 257     n3  = (b3 oct1b)
 258     n4  = (b4 oct1b)
 259     n5  = (b5 oct1b)
 260     n6  = (b6 oct1b)
 261     n7  = (b7 oct1b)
 262     n8  = (b8 oct1b)
 263     n9  = (b1 oct2b)
 264     n10 = (b2 oct2b)
 265     n11 = (b3 oct2b)
 266     n12 = (b4 oct2b)
 267     n13 = (b5 oct2b)
 268     n14 = (b6 oct2b)
 269     n15 = (b7 oct2b)
 270     n16 = (b8 oct2b)
 271     n17 = (b1 oct3b)
 272     n18 = (b2 oct3b)
 273     n19 = (b3 oct3b)
 274     n20 = (b4 oct3b)
 275     n21 = (b5 oct3b)
 276     n22 = (b6 oct3b)
 277     n23 = (b7 oct3b)
 278     n24 = (b8 oct3b)
 279     n25 = (b1 oct4b)
 280     n26 = (b2 oct4b)
 281     n27 = (b3 oct4b)
 282     n28 = (b4 oct4b)
 283     n29 = (b5 oct4b)
 284     n30 = (b6 oct4b)
 285     n31 = (b7 oct4b)
 286     n32 = (b8 oct4b)
 287     oct1b = (octet1 addr2)
 288     oct2b = (octet2 addr2)
 289     oct3b = (octet3 addr2)
 290     oct4b = (octet4 addr2)
 291
 292
 293
 294 -- HUnit Tests
 295 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
 296 mk_testaddr a b c d =
 297   IPv4Address oct1 oct2 oct3 oct4
 298   where
 299     oct1 = fromJust $ octet_from_int a
 300     oct2 = fromJust $ octet_from_int b
 301     oct3 = fromJust $ octet_from_int c
 302     oct4 = fromJust $ octet_from_int d
 303
 304
 305 test_most_sig_bit_different1 :: Test
 306 test_most_sig_bit_different1 =
 307   TestCase $ assertEqual "10.1.1.0 and 10.1.0.0 differ in bit 24"
 308              TwentyFour
 309              bit
 310   where
 311     addr1 = mk_testaddr 10 1 1 0
 312     addr2 = (mk_testaddr 10 1 0 0)
 313     bit = most_sig_bit_different addr1 addr2
 314
 315
 316
 317 test_most_sig_bit_different2 :: Test
 318 test_most_sig_bit_different2 =
 319   TestCase $ assertEqual "10.1.2.0 and 10.1.1.0 differ in bit 23"
 320                TwentyThree
 321                bit
 322   where
 323     addr1 = mk_testaddr 10 1 2 0
 324     addr2 = mk_testaddr 10 1 1 0
 325     bit = most_sig_bit_different addr1 addr2
 326
 327
 328 ipv4address_tests :: [Test]
 329 ipv4address_tests =
 330   [ test_most_sig_bit_different1,
 331     test_most_sig_bit_different2 ]