src/IPv4Address.hs

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