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