src/IPv4Address.hs

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