]> gitweb.michael.orlitzky.com - hath.git/blob - src/IPv4Address.hs
cf2eb063f9e9fe900ad17ba1ab6b8dfcf754208b
[hath.git] / src / IPv4Address.hs
1 module IPv4Address
2 ( ipv4address_from_octets,
3 ipv4address_tests,
4 IPv4Address(None),
5 max_octet1,
6 max_octet2,
7 max_octet3,
8 max_octet4,
9 min_octet1,
10 min_octet2,
11 min_octet3,
12 min_octet4,
13 most_sig_bit_different,
14 octet1,
15 octet2,
16 octet3,
17 octet4
18 ) where
19
20 import Test.HUnit
21 import Test.QuickCheck
22
23 import qualified Bit as B
24 import Maskable
25 import Maskbits
26 import Octet
27
28 data IPv4Address = None | IPv4Address { octet1 :: Octet,
29 octet2 :: Octet,
30 octet3 :: Octet,
31 octet4 :: Octet }
32 deriving (Eq)
33
34
35 instance Show IPv4Address where
36 show IPv4Address.None = "None"
37 show addr = concat [(show oct1) ++ ".",
38 (show oct2) ++ ".",
39 (show oct3) ++ ".",
40 (show oct4)]
41 where
42 oct1 = (octet1 addr)
43 oct2 = (octet2 addr)
44 oct3 = (octet3 addr)
45 oct4 = (octet4 addr)
46
47
48 instance Arbitrary IPv4Address where
49 arbitrary = do
50 oct1 <- arbitrary :: Gen Octet
51 oct2 <- arbitrary :: Gen Octet
52 oct3 <- arbitrary :: Gen Octet
53 oct4 <- arbitrary :: Gen Octet
54 return (IPv4Address oct1 oct2 oct3 oct4)
55
56 coarbitrary _ = variant 0
57
58
59
60 instance Maskable IPv4Address where
61 apply_mask _ Maskbits.None = IPv4Address.None
62 apply_mask addr mask
63 | mask == ThirtyTwo = ipv4address_from_octets oct1 oct2 oct3 oct4
64 | mask == ThirtyOne = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 Seven)
65 | mask == Thirty = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 Six)
66 | mask == TwentyNine = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 Five)
67 | mask == TwentyEight = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 Four)
68 | mask == TwentySeven = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 Three)
69 | mask == TwentySix = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 Two)
70 | mask == TwentyFive = ipv4address_from_octets oct1 oct2 oct3 (apply_mask oct4 One)
71 | mask == TwentyFour = ipv4address_from_octets oct1 oct2 oct3 (min_octet)
72 | mask == TwentyThree = ipv4address_from_octets oct1 oct2 (apply_mask oct3 Seven) (min_octet)
73 | mask == TwentyTwo = ipv4address_from_octets oct1 oct2 (apply_mask oct3 Six) (min_octet)
74 | mask == TwentyOne = ipv4address_from_octets oct1 oct2 (apply_mask oct3 Five) (min_octet)
75 | mask == Twenty = ipv4address_from_octets oct1 oct2 (apply_mask oct3 Four) (min_octet)
76 | mask == Nineteen = ipv4address_from_octets oct1 oct2 (apply_mask oct3 Three) (min_octet)
77 | mask == Eighteen = ipv4address_from_octets oct1 oct2 (apply_mask oct3 Two) (min_octet)
78 | mask == Seventeen = ipv4address_from_octets oct1 oct2 (apply_mask oct3 One) (min_octet)
79 | mask == Sixteen = ipv4address_from_octets oct1 oct2 (min_octet) (min_octet)
80 | mask == Fifteen = ipv4address_from_octets oct1 (apply_mask oct2 Seven) (min_octet) (min_octet)
81 | mask == Fourteen = ipv4address_from_octets oct1 (apply_mask oct2 Six) (min_octet) (min_octet)
82 | mask == Thirteen = ipv4address_from_octets oct1 (apply_mask oct2 Five) (min_octet) (min_octet)
83 | mask == Twelve = ipv4address_from_octets oct1 (apply_mask oct2 Four) (min_octet) (min_octet)
84 | mask == Eleven = ipv4address_from_octets oct1 (apply_mask oct2 Three) (min_octet) (min_octet)
85 | mask == Ten = ipv4address_from_octets oct1 (apply_mask oct2 Two) (min_octet) (min_octet)
86 | mask == Nine = ipv4address_from_octets oct1 (apply_mask oct2 One) (min_octet) (min_octet)
87 | mask == Eight = ipv4address_from_octets oct1 (min_octet) (min_octet) (min_octet)
88 | mask == Seven = ipv4address_from_octets (apply_mask oct1 Seven) (min_octet) (min_octet) (min_octet)
89 | mask == Six = ipv4address_from_octets (apply_mask oct1 Six) (min_octet) (min_octet) (min_octet)
90 | mask == Five = ipv4address_from_octets (apply_mask oct1 Five) (min_octet) (min_octet) (min_octet)
91 | mask == Four = ipv4address_from_octets (apply_mask oct1 Four) (min_octet) (min_octet) (min_octet)
92 | mask == Three = ipv4address_from_octets (apply_mask oct1 Three) (min_octet) (min_octet) (min_octet)
93 | mask == Two = ipv4address_from_octets (apply_mask oct1 Two) (min_octet) (min_octet) (min_octet)
94 | mask == One = ipv4address_from_octets (apply_mask oct1 One) (min_octet) (min_octet) (min_octet)
95 | mask == Zero = ipv4address_from_octets (min_octet) (min_octet) (min_octet) (min_octet)
96 | otherwise = IPv4Address.None
97 where
98 oct1 = (octet1 addr)
99 oct2 = (octet2 addr)
100 oct3 = (octet3 addr)
101 oct4 = (octet4 addr)
102
103
104 -- We don't export our constructor so this function is the only
105 -- way to construct an address from octets. As a result, we can
106 -- return IPv4Address.None in response to being passed one of more
107 -- Octet.None octets.
108 ipv4address_from_octets :: Octet -> Octet -> Octet -> Octet -> IPv4Address
109 ipv4address_from_octets oct1 oct2 oct3 oct4
110 | or [oct1 == Octet.None,
111 oct2 == Octet.None,
112 oct3 == Octet.None,
113 oct4 == Octet.None] = IPv4Address.None
114 | otherwise = IPv4Address oct1 oct2 oct3 oct4
115
116
117 min_address :: IPv4Address -> Maskbits -> IPv4Address
118 min_address IPv4Address.None _ = IPv4Address.None
119 min_address _ Maskbits.None = IPv4Address.None
120 min_address addr mask
121 | mask == ThirtyTwo = addr
122 | mask == ThirtyOne = addr { octet4 = apply_mask oct4 Seven }
123 | mask == Thirty = addr { octet4 = apply_mask oct4 Six }
124 | mask == TwentyNine = addr { octet4 = apply_mask oct4 Five }
125 | mask == TwentyEight = addr { octet4 = apply_mask oct4 Four }
126 | mask == TwentySeven = addr { octet4 = apply_mask oct4 Three }
127 | mask == TwentySix = addr { octet4 = apply_mask oct4 Two }
128 | mask == TwentyFive = addr { octet4 = apply_mask oct4 One }
129 | mask == TwentyFour = addr { octet4 = min_octet }
130 | mask == TwentyThree = addr { octet3 = apply_mask oct3 Seven,
131 octet4 = min_octet }
132 | mask == TwentyTwo = addr { octet3 = apply_mask oct3 Six,
133 octet4 = min_octet }
134 | mask == TwentyOne = addr { octet3 = apply_mask oct3 Five,
135 octet4 = min_octet }
136 | mask == Twenty = addr { octet3 = apply_mask oct3 Four,
137 octet4 = min_octet }
138 | mask == Nineteen = addr { octet3 = apply_mask oct3 Three,
139 octet4 = min_octet }
140 | mask == Eighteen = addr { octet3 = apply_mask oct3 Two,
141 octet4 = min_octet }
142 | mask == Seventeen = addr { octet3 = apply_mask oct3 One,
143 octet4 = min_octet }
144 | mask == Sixteen = addr { octet3 = min_octet,
145 octet4 = min_octet }
146 | mask == Fifteen = addr { octet2 = apply_mask oct2 Seven,
147 octet3 = min_octet,
148 octet4 = min_octet }
149 | mask == Fourteen = addr { octet2 = apply_mask oct2 Six,
150 octet3 = min_octet,
151 octet4 = min_octet }
152 | mask == Thirteen = addr { octet2 = apply_mask oct2 Five,
153 octet3 = min_octet,
154 octet4 = min_octet }
155 | mask == Twelve = addr { octet2 = apply_mask oct2 Four,
156 octet3 = min_octet,
157 octet4 = min_octet }
158 | mask == Eleven = addr { octet2 = apply_mask oct2 Three,
159 octet3 = min_octet,
160 octet4 = min_octet }
161 | mask == Ten = addr { octet2 = apply_mask oct2 Two,
162 octet3 = min_octet,
163 octet4 = min_octet }
164 | mask == Nine = addr { octet2 = apply_mask oct2 One,
165 octet3 = min_octet,
166 octet4 = min_octet }
167 | mask == Eight = addr { octet2 = min_octet,
168 octet3 = min_octet,
169 octet4 = min_octet }
170 | mask == Seven = addr { octet1 = apply_mask oct1 Seven,
171 octet2 = min_octet,
172 octet3 = min_octet,
173 octet4 = min_octet }
174 | mask == Six = addr { octet1 = apply_mask oct1 Six,
175 octet2 = min_octet,
176 octet3 = min_octet,
177 octet4 = min_octet }
178 | mask == Five = addr { octet1 = apply_mask oct1 Five,
179 octet2 = min_octet,
180 octet3 = min_octet,
181 octet4 = min_octet }
182 | mask == Four = addr { octet1 = apply_mask oct1 Four,
183 octet2 = min_octet,
184 octet3 = min_octet,
185 octet4 = min_octet }
186 | mask == Three = addr { octet1 = apply_mask oct1 Three,
187 octet2 = min_octet,
188 octet3 = min_octet,
189 octet4 = min_octet }
190 | mask == Two = addr { octet1 = apply_mask oct1 Two,
191 octet2 = min_octet,
192 octet3 = min_octet,
193 octet4 = min_octet }
194 | mask == One = addr { octet1 = apply_mask oct1 One,
195 octet2 = min_octet,
196 octet3 = min_octet,
197 octet4 = min_octet }
198 | mask == Zero = addr { octet1 = min_octet,
199 octet2 = min_octet,
200 octet3 = min_octet,
201 octet4 = min_octet }
202 | otherwise = addr
203 where
204 oct1 = (octet1 addr)
205 oct2 = (octet2 addr)
206 oct3 = (octet3 addr)
207 oct4 = (octet4 addr)
208
209
210
211 max_address :: IPv4Address -> Maskbits -> IPv4Address
212 max_address IPv4Address.None _ = IPv4Address.None
213 max_address _ Maskbits.None = IPv4Address.None
214 max_address addr mask
215 | mask == ThirtyTwo = IPv4Address oct1 oct2 oct3 oct4
216 | mask == ThirtyOne = IPv4Address oct1 oct2 oct3 (Octet a25 a26 a27 a28 a29 a30 a31 B.One)
217 | mask == Thirty = IPv4Address oct1 oct2 oct3 (Octet a25 a26 a27 a28 a29 a30 B.One B.One)
218 | mask == TwentyNine = IPv4Address oct1 oct2 oct3 (Octet a25 a26 a27 a28 a29 B.One B.One B.One)
219 | mask == TwentyEight = IPv4Address oct1 oct2 oct3 (Octet a25 a26 a27 a28 B.One B.One B.One B.One)
220 | mask == TwentySeven = IPv4Address oct1 oct2 oct3 (Octet a25 a26 a27 B.One B.One B.One B.One B.One)
221 | mask == TwentySix = IPv4Address oct1 oct2 oct3 (Octet a25 a26 B.One B.One B.One B.One B.One B.One)
222 | mask == TwentyFive = IPv4Address oct1 oct2 oct3 (Octet a25 B.One B.One B.One B.One B.One B.One B.One)
223 | mask == TwentyFour = IPv4Address oct1 oct2 oct3 (max_octet)
224 | mask == TwentyThree = IPv4Address oct1 oct2 (Octet a17 a18 a19 a20 a21 a22 a23 B.One) (max_octet)
225 | mask == TwentyTwo = IPv4Address oct1 oct2 (Octet a17 a18 a19 a20 a21 a22 B.One B.One) (max_octet)
226 | mask == TwentyOne = IPv4Address oct1 oct2 (Octet a17 a18 a19 a20 a21 B.One B.One B.One) (max_octet)
227 | mask == Twenty = IPv4Address oct1 oct2 (Octet a17 a18 a19 a20 B.One B.One B.One B.One) (max_octet)
228 | mask == Nineteen = IPv4Address oct1 oct2 (Octet a17 a18 a19 B.One B.One B.One B.One B.One) (max_octet)
229 | mask == Eighteen = IPv4Address oct1 oct2 (Octet a17 a18 B.One B.One B.One B.One B.One B.One) (max_octet)
230 | mask == Seventeen = IPv4Address oct1 oct2 (Octet a17 B.One B.One B.One B.One B.One B.One B.One) (max_octet)
231 | mask == Sixteen = IPv4Address oct1 oct2 (max_octet) (max_octet)
232 | mask == Fifteen = IPv4Address oct1 (Octet a9 a10 a11 a12 a13 a14 a15 B.One) (max_octet) (max_octet)
233 | mask == Fourteen = IPv4Address oct1 (Octet a9 a10 a11 a12 a13 a14 B.One B.One) (max_octet) (max_octet)
234 | mask == Thirteen = IPv4Address oct1 (Octet a9 a10 a11 a12 a13 B.One B.One B.One) (max_octet) (max_octet)
235 | mask == Twelve = IPv4Address oct1 (Octet a9 a10 a11 a12 B.One B.One B.One B.One) (max_octet) (max_octet)
236 | mask == Eleven = IPv4Address oct1 (Octet a9 a10 a11 B.One B.One B.One B.One B.One) (max_octet) (max_octet)
237 | mask == Ten = IPv4Address oct1 (Octet a9 a10 B.One B.One B.One B.One B.One B.One) (max_octet) (max_octet)
238 | mask == Nine = IPv4Address oct1 (Octet a9 B.One B.One B.One B.One B.One B.One B.One) (max_octet) (max_octet)
239 | mask == Eight = IPv4Address oct1 (max_octet) (max_octet) (max_octet)
240 | mask == Seven = IPv4Address (Octet a1 a2 a3 a4 a5 a6 a7 B.One) (max_octet) (max_octet) (max_octet)
241 | mask == Six = IPv4Address (Octet a1 a2 a3 a4 a5 a6 B.One B.One) (max_octet) (max_octet) (max_octet)
242 | mask == Five = IPv4Address (Octet a1 a2 a3 a4 a5 B.One B.One B.One) (max_octet) (max_octet) (max_octet)
243 | mask == Four = IPv4Address (Octet a1 a2 a3 a4 B.One B.One B.One B.One) (max_octet) (max_octet) (max_octet)
244 | mask == Three = IPv4Address (Octet a1 a2 a3 B.One B.One B.One B.One B.One) (max_octet) (max_octet) (max_octet)
245 | mask == Two = IPv4Address (Octet a1 a2 B.One B.One B.One B.One B.One B.One) (max_octet) (max_octet) (max_octet)
246 | mask == One = IPv4Address (Octet a1 B.One B.One B.One B.One B.One B.One B.One) (max_octet) (max_octet) (max_octet)
247 | mask == Zero = IPv4Address (max_octet) (max_octet) (max_octet) (max_octet)
248 | otherwise = addr
249 where
250 a1 = (b1 oct1)
251 a2 = (b2 oct1)
252 a3 = (b3 oct1)
253 a4 = (b4 oct1)
254 a5 = (b5 oct1)
255 a6 = (b6 oct1)
256 a7 = (b7 oct1)
257 a9 = (b1 oct2)
258 a10 = (b2 oct2)
259 a11 = (b3 oct2)
260 a12 = (b4 oct2)
261 a13 = (b5 oct2)
262 a14 = (b6 oct2)
263 a15 = (b7 oct2)
264 a17 = (b1 oct3)
265 a18 = (b2 oct3)
266 a19 = (b3 oct3)
267 a20 = (b4 oct3)
268 a21 = (b5 oct3)
269 a22 = (b6 oct3)
270 a23 = (b7 oct3)
271 a25 = (b1 oct4)
272 a26 = (b2 oct4)
273 a27 = (b3 oct4)
274 a28 = (b4 oct4)
275 a29 = (b5 oct4)
276 a30 = (b6 oct4)
277 a31 = (b7 oct4)
278 oct1 = (octet1 addr)
279 oct2 = (octet2 addr)
280 oct3 = (octet3 addr)
281 oct4 = (octet4 addr)
282
283
284
285 min_octet1 :: IPv4Address -> Maskbits -> Octet
286 min_octet1 addr mask = octet1 (min_address addr mask)
287
288 min_octet2 :: IPv4Address -> Maskbits -> Octet
289 min_octet2 addr mask = octet2 (min_address addr mask)
290
291 min_octet3 :: IPv4Address -> Maskbits -> Octet
292 min_octet3 addr mask = octet3 (min_address addr mask)
293
294 min_octet4 :: IPv4Address -> Maskbits -> Octet
295 min_octet4 addr mask = octet4 (min_address addr mask)
296
297 max_octet1 :: IPv4Address -> Maskbits -> Octet
298 max_octet1 addr mask = octet1 (max_address addr mask)
299
300 max_octet2 :: IPv4Address -> Maskbits -> Octet
301 max_octet2 addr mask = octet2 (max_address addr mask)
302
303 max_octet3 :: IPv4Address -> Maskbits -> Octet
304 max_octet3 addr mask = octet3 (max_address addr mask)
305
306 max_octet4 :: IPv4Address -> Maskbits -> Octet
307 max_octet4 addr mask = octet4 (max_address addr mask)
308
309
310 -- Given two addresses, find the number of the most significant bit
311 -- where they differ. If the addresses are the same, return
312 -- Maskbits.Zero.
313 most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
314 most_sig_bit_different addr1 addr2
315 | addr1 == addr2 = Maskbits.Zero
316 | m1 /= n1 = Maskbits.One
317 | m2 /= n2 = Two
318 | m3 /= n3 = Three
319 | m4 /= n4 = Four
320 | m5 /= n5 = Five
321 | m6 /= n6 = Six
322 | m7 /= n7 = Seven
323 | m8 /= n8 = Eight
324 | m9 /= n9 = Nine
325 | m10 /= n10 = Ten
326 | m11 /= n11 = Eleven
327 | m12 /= n12 = Twelve
328 | m13 /= n13 = Thirteen
329 | m14 /= n14 = Fourteen
330 | m15 /= n15 = Fifteen
331 | m16 /= n16 = Sixteen
332 | m17 /= n17 = Seventeen
333 | m18 /= n18 = Eighteen
334 | m19 /= n19 = Nineteen
335 | m20 /= n20 = Twenty
336 | m21 /= n21 = TwentyOne
337 | m22 /= n22 = TwentyTwo
338 | m23 /= n23 = TwentyThree
339 | m24 /= n24 = TwentyFour
340 | m25 /= n25 = TwentyFive
341 | m26 /= n26 = TwentySix
342 | m27 /= n27 = TwentySeven
343 | m28 /= n28 = TwentyEight
344 | m29 /= n29 = TwentyNine
345 | m30 /= n30 = Thirty
346 | m31 /= n31 = ThirtyOne
347 | m32 /= n32 = ThirtyTwo
348 | otherwise = Maskbits.Zero
349 where
350 m1 = (b1 oct1a)
351 m2 = (b2 oct1a)
352 m3 = (b3 oct1a)
353 m4 = (b4 oct1a)
354 m5 = (b5 oct1a)
355 m6 = (b6 oct1a)
356 m7 = (b7 oct1a)
357 m8 = (b8 oct1a)
358 m9 = (b1 oct2a)
359 m10 = (b2 oct2a)
360 m11 = (b3 oct2a)
361 m12 = (b4 oct2a)
362 m13 = (b5 oct2a)
363 m14 = (b6 oct2a)
364 m15 = (b7 oct2a)
365 m16 = (b8 oct2a)
366 m17 = (b1 oct3a)
367 m18 = (b2 oct3a)
368 m19 = (b3 oct3a)
369 m20 = (b4 oct3a)
370 m21 = (b5 oct3a)
371 m22 = (b6 oct3a)
372 m23 = (b7 oct3a)
373 m24 = (b8 oct3a)
374 m25 = (b1 oct4a)
375 m26 = (b2 oct4a)
376 m27 = (b3 oct4a)
377 m28 = (b4 oct4a)
378 m29 = (b5 oct4a)
379 m30 = (b6 oct4a)
380 m31 = (b7 oct4a)
381 m32 = (b8 oct4a)
382 oct1a = (octet1 addr1)
383 oct2a = (octet2 addr1)
384 oct3a = (octet3 addr1)
385 oct4a = (octet4 addr1)
386 n1 = (b1 oct1b)
387 n2 = (b2 oct1b)
388 n3 = (b3 oct1b)
389 n4 = (b4 oct1b)
390 n5 = (b5 oct1b)
391 n6 = (b6 oct1b)
392 n7 = (b7 oct1b)
393 n8 = (b8 oct1b)
394 n9 = (b1 oct2b)
395 n10 = (b2 oct2b)
396 n11 = (b3 oct2b)
397 n12 = (b4 oct2b)
398 n13 = (b5 oct2b)
399 n14 = (b6 oct2b)
400 n15 = (b7 oct2b)
401 n16 = (b8 oct2b)
402 n17 = (b1 oct3b)
403 n18 = (b2 oct3b)
404 n19 = (b3 oct3b)
405 n20 = (b4 oct3b)
406 n21 = (b5 oct3b)
407 n22 = (b6 oct3b)
408 n23 = (b7 oct3b)
409 n24 = (b8 oct3b)
410 n25 = (b1 oct4b)
411 n26 = (b2 oct4b)
412 n27 = (b3 oct4b)
413 n28 = (b4 oct4b)
414 n29 = (b5 oct4b)
415 n30 = (b6 oct4b)
416 n31 = (b7 oct4b)
417 n32 = (b8 oct4b)
418 oct1b = (octet1 addr2)
419 oct2b = (octet2 addr2)
420 oct3b = (octet3 addr2)
421 oct4b = (octet4 addr2)
422
423
424
425 -- HUnit Tests
426 mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
427 mk_testaddr a b c d =
428 IPv4Address oct1 oct2 oct3 oct4
429 where
430 oct1 = octet_from_int a
431 oct2 = octet_from_int b
432 oct3 = octet_from_int c
433 oct4 = octet_from_int d
434
435
436 test_most_sig_bit_different1 :: Test
437 test_most_sig_bit_different1 =
438 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))
439
440
441 test_most_sig_bit_different2 :: Test
442 test_most_sig_bit_different2 =
443 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))
444
445
446 ipv4address_tests :: [Test]
447 ipv4address_tests = [ test_most_sig_bit_different1,
448 test_most_sig_bit_different2 ]