Convert comments to Haddock-style docs in many places.
Whitespace cleanup.
-module Bit where
+-- | The Bit module contains the Bit data type, which is essentially a
+-- renamed Boolean, and some convenience functions.
+module Bit
+where
-import Test.QuickCheck
+import Test.QuickCheck (
+ Arbitrary,
+ arbitrary,
+ elements
+ )
-data Bit = None | Zero | One
- deriving (Eq)
+data Bit = Zero | One
+ deriving (Eq)
instance Show Bit where
- show None = "None"
- show Zero = "0"
- show One = "1"
+ show Zero = "0"
+ show One = "1"
instance Arbitrary Bit where
- arbitrary = elements [ Zero, One ]
+ arbitrary = elements [ Zero, One ]
+-- | Convert a Bit to an Int.
bit_to_int :: Bit -> Int
-bit_to_int None = -1
bit_to_int Zero = 0
bit_to_int One = 1
--- If we are passed a '0' or '1', convert it appropriately. Otherwise,
--- default to None.
-bit_from_char :: Char -> Bit
-bit_from_char '0' = Zero
-bit_from_char '1' = One
-bit_from_char _ = None
+-- | If we are passed a '0' or '1', convert it
+-- appropriately. Otherwise, default to Nothing.
+bit_from_char :: Char -> Maybe Bit
+bit_from_char '0' = Just Zero
+bit_from_char '1' = Just One
+bit_from_char _ = Nothing
) where
import Data.List (nubBy)
+import Data.Maybe (catMaybes, fromJust)
import Test.HUnit
import Test.QuickCheck
import Octet
-data Cidr = None | Cidr { ipv4address :: IPv4Address,
- maskbits :: Maskbits }
+data Cidr = Cidr { ipv4address :: IPv4Address,
+ maskbits :: Maskbits }
instance Show Cidr where
- show Cidr.None = "None"
show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
-- Two CIDR ranges are equivalent if they have the same network bits
-- and the masks are the same.
equivalent :: Cidr -> Cidr -> Bool
-equivalent Cidr.None Cidr.None = True
-equivalent Cidr.None _ = False
-equivalent _ Cidr.None = False
equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
(mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
-- Returns the mask portion of a CIDR address. That is, everything
-- after the trailing slash.
-maskbits_from_cidr_string :: String -> Maskbits
+maskbits_from_cidr_string :: String -> Maybe Maskbits
maskbits_from_cidr_string s
- | length partlist == 2 = maskbits_from_string (partlist !! 1)
- | otherwise = Maskbits.None
- where
- partlist = (splitWith (`elem` "/") s)
+ | length partlist == 2 = maskbits_from_string (partlist !! 1)
+ | otherwise = Nothing
+ where
+ partlist = (splitWith (`elem` "/") s)
--- Takes an IP address String in CIDR notation, and returns a list of
--- its octets (as Ints).
+-- | Takes an IP address String in CIDR notation, and returns a list
+-- of its octets (as Ints).
octets_from_cidr_string :: String -> [Octet]
octets_from_cidr_string s =
- map octet_from_string (take 4 (splitWith (`elem` "./") s))
+ catMaybes $ map octet_from_string (take 4 (splitWith (`elem` "./") s))
-cidr_from_string :: String -> Cidr
-cidr_from_string s
- | addr == IPv4Address.None = Cidr.None
- | mbits == Maskbits.None = Cidr.None
- | otherwise = Cidr addr mbits
- where
- addr = ipv4address_from_octets (oct1) (oct2) (oct3) (oct4)
- oct1 = (octs !! 0)
- oct2 = (octs !! 1)
- oct3 = (octs !! 2)
- oct4 = (octs !! 3)
- octs = octets_from_cidr_string s
- mbits = maskbits_from_cidr_string s
+-- | Return Nothing if we can't parse both maskbits and octets from
+-- the string.
+cidr_from_string :: String -> Maybe Cidr
+cidr_from_string s =
+ case (octets_from_cidr_string s) of
+ [oct1, oct2, oct3, oct4] ->
+ case (maskbits_from_cidr_string s) of
+ Just mbits ->
+ Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
+ _ -> Nothing
+ _ -> Nothing
min_host :: Cidr -> IPv4Address
-min_host Cidr.None = IPv4Address.None
-min_host (Cidr IPv4Address.None _) = IPv4Address.None
-min_host (Cidr _ Maskbits.None) = IPv4Address.None
min_host (Cidr addr mask) = apply_mask addr mask B.Zero
max_host :: Cidr -> IPv4Address
-max_host Cidr.None = IPv4Address.None
-max_host (Cidr IPv4Address.None _) = IPv4Address.None
-max_host (Cidr _ Maskbits.None) = IPv4Address.None
max_host (Cidr addr mask) = apply_mask addr mask B.One
--- Return true if the first argument (a CIDR range) contains the
--- second (another CIDR range). There are a lot of ways we can be fed
--- junk here. For lack of a better alternative, just return False when
--- we are given nonsense.
-contains :: Cidr -> Cidr -> Bool
-contains Cidr.None _ = False
-contains _ Cidr.None = False
-contains (Cidr _ Maskbits.None) _ = False
-contains (Cidr IPv4Address.None _) _ = False
-contains _ (Cidr _ Maskbits.None) = False
-contains _ (Cidr IPv4Address.None _) = False
-
--- If the number of bits in the network part of the first address is
--- larger than the number of bits in the second, there is no way that
--- the first range can contain the second. For, if the number of
--- network bits is larger, then the number of host bits must be
--- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
--- certainly does not contain cidr2.
+-- | Return true if the first argument (a CIDR range) contains the
+-- second (another CIDR range). There are a lot of ways we can be
+-- fed junk here. For lack of a better alternative, just return
+-- False when we are given nonsense.
+--
+-- If the number of bits in the network part of the first address is
+-- larger than the number of bits in the second, there is no way
+-- that the first range can contain the second. For, if the number
+-- of network bits is larger, then the number of host bits must be
+-- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
+-- certainly does not contain cidr2.
--
--- On the other hand, if the first argument (cidr1) has fewer (or the
--- same number of) network bits as the second, it can contain the
--- second. In this case, we need to check that every host in cidr2 is
--- contained in cidr1. If a host in cidr2 is contained in cidr1, then
--- at least mbits1 of an address in cidr2 will match cidr1. For
--- example,
+-- On the other hand, if the first argument (cidr1) has fewer (or
+-- the same number of) network bits as the second, it can contain
+-- the second. In this case, we need to check that every host in
+-- cidr2 is contained in cidr1. If a host in cidr2 is contained in
+-- cidr1, then at least mbits1 of an address in cidr2 will match
+-- cidr1. For example,
--
--- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
+-- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
--
--- Here, cidr2 contains all of 192.168.1.0 through
--- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
--- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
--- what we want to check is that cidr2 "begins with" something that
--- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
--- cidr2 DOES, cidr1 contains cidr2..
+-- Here, cidr2 contains all of 192.168.1.0 through
+-- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
+-- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
+-- what we want to check is that cidr2 "begins with" something that
+-- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
+-- cidr2 DOES, cidr1 contains cidr2..
--
--- The way that we check this is to apply cidr1's mask to cidr2's
--- address and see if the result is the same as cidr1's mask applied
--- to cidr1's address.
+-- The way that we check this is to apply cidr1's mask to cidr2's
+-- address and see if the result is the same as cidr1's mask applied
+-- to cidr1's address.
--
+contains :: Cidr -> Cidr -> Bool
contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
- | mbits1 > mbits2 = False
- | otherwise = addr1masked == addr2masked
- where
- addr1masked = apply_mask addr1 mbits1 B.Zero
- addr2masked = apply_mask addr2 mbits1 B.Zero
+ | mbits1 > mbits2 = False
+ | otherwise = addr1masked == addr2masked
+ where
+ addr1masked = apply_mask addr1 mbits1 B.Zero
+ addr2masked = apply_mask addr2 mbits1 B.Zero
contains_proper :: Cidr -> Cidr -> Bool
(cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
--- A CIDR range is redundant (with respect to the given list) if
--- another CIDR range in that list properly contains it.
+-- | A CIDR range is redundant (with respect to the given list) if
+-- another CIDR range in that list properly contains it.
redundant :: [Cidr] -> Cidr -> Bool
redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
--- First, we look at all possible pairs of cidrs, and combine the
--- adjacent ones in to a new list. Then, we concatenate that list with
--- the original one, and filter out all of the redundancies. If two
--- adjacent Cidrs are combined into a larger one, they will be removed
--- in the second step since the larger Cidr must contain the smaller
--- two.
+-- | First, we look at all possible pairs of cidrs, and combine the
+-- adjacent ones in to a new list. Then, we concatenate that list
+-- with the original one, and filter out all of the redundancies. If
+-- two adjacent Cidrs are combined into a larger one, they will be
+-- removed in the second step since the larger Cidr must contain the
+-- smaller two.
--
--- Once this is done, we see whether or not the result is different
--- than the argument that was passed in. If nothing changed, we're
--- done and return the list that was passed to us. However, if
--- something changed, we recurse and try to combine the list again.
+-- Once this is done, we see whether or not the result is different
+-- than the argument that was passed in. If nothing changed, we're
+-- done and return the list that was passed to us. However, if
+-- something changed, we recurse and try to combine the list again.
combine_all :: [Cidr] -> [Cidr]
combine_all cidrs
| cidrs == (combine_contained unique_cidrs) = cidrs
| otherwise = combine_all (combine_contained unique_cidrs)
where
- unique_cidrs = nubBy equivalent valid_cidr_combinations
- valid_cidr_combinations = filter (/= Cidr.None) cidr_combinations
+ unique_cidrs = nubBy equivalent cidr_combinations
cidr_combinations =
- cidrs ++ [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ]
+ cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
--- Take a list of CIDR ranges and filter out all of the ones that are
--- contained entirelt within some other range in the list.
+-- | Take a list of CIDR ranges and filter out all of the ones that
+-- are contained entirelt within some other range in the list.
combine_contained :: [Cidr] -> [Cidr]
combine_contained cidrs =
- filter (not . (redundant cidrs)) cidrs
+ filter (not . (redundant cidrs)) cidrs
--- If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
--- decrement the maskbits of cidr1 and return that; it will contain
--- both cidr1 and cidr2.
-combine_adjacent :: Cidr -> Cidr -> Cidr
+-- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
+-- decrement the maskbits of cidr1 and return that; it will contain
+-- both cidr1 and cidr2.
+combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
combine_adjacent cidr1 cidr2
- | not (adjacent cidr1 cidr2) = Cidr.None
- | (maskbits cidr1 == Zero) = Cidr.None
- | otherwise = cidr1 { maskbits = decrement (maskbits cidr1) }
+ | not (adjacent cidr1 cidr2) = Nothing
+ | (maskbits cidr1 == Zero) = Nothing
+ | otherwise = Just $ cidr1 { maskbits = decrement (maskbits cidr1) }
--- Determine whether or not two CIDR ranges are adjacent. If two
--- ranges lie consecutively within the IP space, they can be
--- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
--- and can be combined in to 10.1.0.0/23.
+-- | Determine whether or not two CIDR ranges are adjacent. If two
+-- ranges lie consecutively within the IP space, they can be
+-- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
+-- and can be combined in to 10.1.0.0/23.
adjacent :: Cidr -> Cidr -> Bool
-adjacent Cidr.None _ = False
-adjacent _ Cidr.None = False
adjacent cidr1 cidr2
| mbits1 /= mbits2 = False
| mbits1 == Maskbits.Zero = False -- They're equal.
test_min_host1 :: Test
test_min_host1 =
- TestCase $ assertEqual "The minimum host in 10.0.0.0/24 is 10.0.0.0" expected actual
- where
- actual = show $ min_host (cidr_from_string "10.0.0.0/24")
- expected = "10.0.0.0"
+ TestCase $ assertEqual "The minimum host in 10.0.0.0/24 is 10.0.0.0"
+ expected
+ actual
+ where
+ actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
+ expected = "10.0.0.0"
test_max_host1 :: Test
test_max_host1 =
- TestCase $ assertEqual "The maximum host in 10.0.0.0/24 is 10.0.0.255" expected actual
- where
- actual = show $ max_host (cidr_from_string "10.0.0.0/24")
- expected = "10.0.0.255"
+ TestCase $ assertEqual "The maximum host in 10.0.0.0/24 is 10.0.0.255"
+ expected
+ actual
+ where
+ actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
+ expected = "10.0.0.255"
test_equality1 :: Test
test_equality1 =
- TestCase $ assertEqual "10.1.1.0/23 equals itself" True (cidr1 == cidr1)
- where
- cidr1 = cidr_from_string "10.1.1.0/23"
+ TestCase $
+ assertEqual
+ "10.1.1.0/23 equals itself"
+ True
+ (cidr1 == cidr1)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
test_contains1 :: Test
test_contains1 =
- TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24" True (cidr1 `contains` cidr2)
- where
- cidr1 = cidr_from_string "10.1.1.0/23"
- cidr2 = cidr_from_string "10.1.1.0/24"
+ TestCase $
+ assertEqual
+ "10.1.1.0/23 contains 10.1.1.0/24"
+ True
+ (cidr1 `contains` cidr2)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
+ cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
test_contains2 :: Test
test_contains2 =
- TestCase $ assertEqual "10.1.1.0/23 contains itself" True (cidr1 `contains` cidr1)
- where
- cidr1 = cidr_from_string "10.1.1.0/23"
+ TestCase $
+ assertEqual
+ "10.1.1.0/23 contains itself"
+ True
+ (cidr1 `contains` cidr1)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
test_contains_proper1 :: Test
test_contains_proper1 =
- TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24 properly" True (cidr1 `contains_proper` cidr2)
- where
- cidr1 = cidr_from_string "10.1.1.0/23"
- cidr2 = cidr_from_string "10.1.1.0/24"
+ TestCase $
+ assertEqual
+ "10.1.1.0/23 contains 10.1.1.0/24 properly"
+ True
+ (cidr1 `contains_proper` cidr2)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
+ cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
test_contains_proper2 :: Test
test_contains_proper2 =
- TestCase $ assertEqual "10.1.1.0/23 does not contain itself properly" False (cidr1 `contains_proper` cidr1)
- where
- cidr1 = cidr_from_string "10.1.1.0/23"
+ TestCase $
+ assertEqual
+ "10.1.1.0/23 does not contain itself properly"
+ False
+ (cidr1 `contains_proper` cidr1)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
test_adjacent1 :: Test
test_adjacent1 =
- TestCase $ assertEqual "10.1.0.0/24 is adjacent to 10.1.1.0/24" True (cidr1 `adjacent` cidr2)
- where
- cidr1 = cidr_from_string "10.1.0.0/24"
- cidr2 = cidr_from_string "10.1.1.0/24"
+ TestCase $
+ assertEqual
+ "10.1.0.0/24 is adjacent to 10.1.1.0/24"
+ True
+ (cidr1 `adjacent` cidr2)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
+ cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
test_adjacent2 :: Test
test_adjacent2 =
- TestCase $ assertEqual "10.1.0.0/23 is not adjacent to 10.1.0.0/24" False (cidr1 `adjacent` cidr2)
- where
- cidr1 = cidr_from_string "10.1.0.0/23"
- cidr2 = cidr_from_string "10.1.0.0/24"
+ TestCase $
+ assertEqual
+ "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
+ False
+ (cidr1 `adjacent` cidr2)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
+ cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
test_adjacent3 :: Test
test_adjacent3 =
- TestCase $ assertEqual "10.1.0.0/24 is not adjacent to 10.2.5.0/24" False (cidr1 `adjacent` cidr2)
- where
- cidr1 = cidr_from_string "10.1.0.0/24"
- cidr2 = cidr_from_string "10.2.5.0/24"
+ TestCase $
+ assertEqual
+ "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
+ False
+ (cidr1 `adjacent` cidr2)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
+ cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
test_adjacent4 :: Test
test_adjacent4 =
- TestCase $ assertEqual "10.1.1.0/24 is not adjacent to 10.1.2.0/24" False (cidr1 `adjacent` cidr2)
- where
- cidr1 = cidr_from_string "10.1.1.0/24"
- cidr2 = cidr_from_string "10.1.2.0/24"
+ TestCase $
+ assertEqual
+ "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
+ False
+ (cidr1 `adjacent` cidr2)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
+ cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
test_combine_contained1 :: Test
test_combine_contained1 =
- TestCase $ assertEqual "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" expected_cidrs (combine_contained test_cidrs)
- where
- cidr1 = cidr_from_string "10.0.0.0/8"
- cidr2 = cidr_from_string "10.1.0.0/16"
- cidr3 = cidr_from_string "10.1.1.0/24"
- expected_cidrs = [cidr1]
- test_cidrs = [cidr1, cidr2, cidr3]
+ TestCase $
+ assertEqual
+ "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
+ expected_cidrs
+ (combine_contained test_cidrs)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
+ cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
+ cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
+ expected_cidrs = [cidr1]
+ test_cidrs = [cidr1, cidr2, cidr3]
test_combine_contained2 :: Test
test_combine_contained2 =
- TestCase $ assertEqual "192.168.3.0/23 does not contain 192.168.1.0/24" [cidr1, cidr2] (combine_contained [cidr1, cidr2])
- where
- cidr1 = cidr_from_string "192.168.3.0/23"
- cidr2 = cidr_from_string "192.168.1.0/24"
+ TestCase $
+ assertEqual
+ "192.168.3.0/23 does not contain 192.168.1.0/24"
+ [cidr1, cidr2]
+ (combine_contained [cidr1, cidr2])
+ where
+ cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
+ cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
test_combine_all1 :: Test
test_combine_all1 =
- TestCase $ assertEqual "10.0.0.0/24 is adjacent to 10.0.1.0/24 and 10.0.3.0/23 contains 10.0.2.0/24" expected_cidrs (combine_all test_cidrs)
- where
- cidr1 = cidr_from_string "10.0.0.0/24"
- cidr2 = cidr_from_string "10.0.1.0/24"
- cidr3 = cidr_from_string "10.0.2.0/24"
- cidr4 = cidr_from_string "10.0.3.0/23"
- cidr5 = cidr_from_string "10.0.0.0/23"
- expected_cidrs = [cidr_from_string "10.0.0.0/22"]
- test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
+ TestCase $
+ assertEqual
+ "10.0.0.0/24 is adjacent to 10.0.1.0/24 and 10.0.3.0/23 contains 10.0.2.0/24"
+ expected_cidrs
+ (combine_all test_cidrs)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
+ cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
+ cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
+ cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
+ cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
+ expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
+ test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
test_combine_all2 :: Test
test_combine_all2 =
- TestCase $ assertEqual "127.0.0.1/32 combines with itself recursively" expected_cidrs (combine_all test_cidrs)
+ TestCase $
+ assertEqual
+ "127.0.0.1/32 combines with itself recursively"
+ expected_cidrs
+ (combine_all test_cidrs)
where
- cidr1 = cidr_from_string "127.0.0.1/32"
+ cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
expected_cidrs = [cidr1]
test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
test_combine_all3 :: Test
test_combine_all3 =
- TestCase $ assertEqual "10.0.0.16, 10.0.0.17, 10.0.0.18, and 10.0.0.19 get combined into 10.0.0.16/30" expected_cidrs (combine_all test_cidrs)
- where
- cidr1 = cidr_from_string "10.0.0.16/32"
- cidr2 = cidr_from_string "10.0.0.17/32"
- cidr3 = cidr_from_string "10.0.0.18/32"
- cidr4 = cidr_from_string "10.0.0.19/32"
- expected_cidrs = [cidr_from_string "10.0.0.16/30"]
- test_cidrs = [cidr1, cidr2, cidr3, cidr4]
+ TestCase $
+ assertEqual
+ "10.0.0.16, 10.0.0.17, 10.0.0.18, and 10.0.0.19 get combined into 10.0.0.16/30"
+ expected_cidrs
+ (combine_all test_cidrs)
+ where
+ cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
+ cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
+
+ cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
+ cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
+ expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
+ test_cidrs = [cidr1, cidr2, cidr3, cidr4]
cidr_tests :: [Test]
module IPv4Address
-( ipv4address_from_octets,
- ipv4address_tests,
- IPv4Address(None),
+( ipv4address_tests,
+ IPv4Address(..),
max_address,
min_address,
most_sig_bit_different,
- octet1,
- octet2,
- octet3,
- octet4
) where
+import Data.Maybe (fromJust)
import Test.HUnit
import Test.QuickCheck
import Maskbits
import Octet
-data IPv4Address = None | IPv4Address { octet1 :: Octet,
- octet2 :: Octet,
- octet3 :: Octet,
- octet4 :: Octet }
- deriving (Eq)
+data IPv4Address =
+ IPv4Address { octet1 :: Octet,
+ octet2 :: Octet,
+ octet3 :: Octet,
+ octet4 :: Octet }
+ deriving (Eq)
instance Show IPv4Address where
- show IPv4Address.None = "None"
- show addr = concat [(show oct1) ++ ".",
- (show oct2) ++ ".",
- (show oct3) ++ ".",
- (show oct4)]
- where
- oct1 = (octet1 addr)
- oct2 = (octet2 addr)
- oct3 = (octet3 addr)
- oct4 = (octet4 addr)
+ show addr = concat [(show oct1) ++ ".",
+ (show oct2) ++ ".",
+ (show oct3) ++ ".",
+ (show oct4)]
+ where
+ oct1 = (octet1 addr)
+ oct2 = (octet2 addr)
+ oct3 = (octet3 addr)
+ oct4 = (octet4 addr)
instance Arbitrary IPv4Address where
- arbitrary = do
- oct1 <- arbitrary :: Gen Octet
- oct2 <- arbitrary :: Gen Octet
- oct3 <- arbitrary :: Gen Octet
- oct4 <- arbitrary :: Gen Octet
- return (IPv4Address oct1 oct2 oct3 oct4)
+ arbitrary = do
+ oct1 <- arbitrary :: Gen Octet
+ oct2 <- arbitrary :: Gen Octet
+ oct3 <- arbitrary :: Gen Octet
+ oct4 <- arbitrary :: Gen Octet
+ return (IPv4Address oct1 oct2 oct3 oct4)
instance Maskable IPv4Address where
- apply_mask _ Maskbits.None _ = IPv4Address.None
- apply_mask addr mask bit
- | mask == ThirtyTwo = addr
- | mask == ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
- | mask == Thirty = addr { octet4 = (apply_mask oct4 Six bit) }
- | mask == TwentyNine = addr { octet4 = (apply_mask oct4 Five bit) }
- | mask == TwentyEight = addr { octet4 = (apply_mask oct4 Four bit) }
- | mask == TwentySeven = addr { octet4 = (apply_mask oct4 Three bit) }
- | mask == TwentySix = addr { octet4 = (apply_mask oct4 Two bit) }
- | mask == TwentyFive = addr { octet4 = (apply_mask oct4 One bit) }
- | mask == TwentyFour = addr { octet4 = (apply_mask oct4 Zero bit) }
- | mask == TwentyThree = addr { octet3 = (apply_mask oct3 Seven bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == TwentyTwo = addr { octet3 = (apply_mask oct3 Six bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == TwentyOne = addr { octet3 = (apply_mask oct3 Five bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == Twenty = addr { octet3 = (apply_mask oct3 Four bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == Nineteen = addr { octet3 = (apply_mask oct3 Three bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == Eighteen = addr { octet3 = (apply_mask oct3 Two bit),
+
+ apply_mask addr mask bit
+ | mask == ThirtyTwo = addr
+ | mask == ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
+ | mask == Thirty = addr { octet4 = (apply_mask oct4 Six bit) }
+ | mask == TwentyNine = addr { octet4 = (apply_mask oct4 Five bit) }
+ | mask == TwentyEight = addr { octet4 = (apply_mask oct4 Four bit) }
+ | mask == TwentySeven = addr { octet4 = (apply_mask oct4 Three bit) }
+ | mask == TwentySix = addr { octet4 = (apply_mask oct4 Two bit) }
+ | mask == TwentyFive = addr { octet4 = (apply_mask oct4 One bit) }
+ | mask == TwentyFour = addr { octet4 = (apply_mask oct4 Zero bit) }
+ | mask == TwentyThree = addr { octet3 = (apply_mask oct3 Seven bit),
octet4 = (apply_mask oct4 Zero bit) }
- | mask == Seventeen = addr { octet3 = (apply_mask oct3 One bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == Sixteen = addr { octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == Fifteen = addr { octet2 = (apply_mask oct2 Seven bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit) }
- | mask == Fourteen = addr { octet2 = (apply_mask oct2 Six bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Thirteen = addr { octet2 = (apply_mask oct2 Five bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Twelve = addr { octet2 = (apply_mask oct2 Four bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Eleven = addr { octet2 = (apply_mask oct2 Three bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Ten = addr { octet2 = (apply_mask oct2 Two bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Nine = addr { octet2 = (apply_mask oct2 One bit),
+ | mask == TwentyTwo = addr { octet3 = (apply_mask oct3 Six bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == TwentyOne = addr { octet3 = (apply_mask oct3 Five bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Twenty = addr { octet3 = (apply_mask oct3 Four bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Nineteen = addr { octet3 = (apply_mask oct3 Three bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Eighteen = addr { octet3 = (apply_mask oct3 Two bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Seventeen = addr { octet3 = (apply_mask oct3 One bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Sixteen = addr { octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Fifteen = addr { octet2 = (apply_mask oct2 Seven bit),
octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Eight = addr { octet2 = (apply_mask oct2 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit) }
+ | mask == Fourteen = addr { octet2 = (apply_mask oct2 Six bit),
octet3 = (apply_mask oct3 Zero bit),
octet4 = (apply_mask oct4 Zero bit)}
- | mask == Seven = addr { octet1 = (apply_mask oct1 Seven bit),
- octet2 = (apply_mask oct2 Zero bit),
+ | mask == Thirteen = addr { octet2 = (apply_mask oct2 Five bit),
octet3 = (apply_mask oct3 Zero bit),
octet4 = (apply_mask oct4 Zero bit)}
- | mask == Six = addr { octet1 = (apply_mask oct1 Six bit),
- octet2 = (apply_mask oct2 Zero bit),
+ | mask == Twelve = addr { octet2 = (apply_mask oct2 Four bit),
octet3 = (apply_mask oct3 Zero bit),
octet4 = (apply_mask oct4 Zero bit)}
- | mask == Five = addr { octet1 = (apply_mask oct1 Five bit),
- octet2 = (apply_mask oct2 Zero bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Four = addr { octet1 = (apply_mask oct1 Four bit),
- octet2 = (apply_mask oct2 Zero bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Three = addr { octet1 = (apply_mask oct1 Three bit),
- octet2 = (apply_mask oct2 Zero bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == Two = addr { octet1 = (apply_mask oct1 Two bit),
- octet2 = (apply_mask oct2 Zero bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | mask == One = addr { octet1 = (apply_mask oct1 One bit),
- octet2 = (apply_mask oct2 Zero bit),
+ | mask == Eleven = addr { octet2 = (apply_mask oct2 Three bit),
octet3 = (apply_mask oct3 Zero bit),
octet4 = (apply_mask oct4 Zero bit)}
- | mask == Zero = addr { octet1 = (apply_mask oct1 Zero bit),
- octet2 = (apply_mask oct2 Zero bit),
- octet3 = (apply_mask oct3 Zero bit),
- octet4 = (apply_mask oct4 Zero bit)}
- | otherwise = IPv4Address.None
- where
- oct1 = (octet1 addr)
- oct2 = (octet2 addr)
- oct3 = (octet3 addr)
- oct4 = (octet4 addr)
-
+ | mask == Ten = addr { octet2 = (apply_mask oct2 Two bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Nine = addr { octet2 = (apply_mask oct2 One bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Eight = addr { octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Seven = addr { octet1 = (apply_mask oct1 Seven bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Six = addr { octet1 = (apply_mask oct1 Six bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Five = addr { octet1 = (apply_mask oct1 Five bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Four = addr { octet1 = (apply_mask oct1 Four bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Three = addr { octet1 = (apply_mask oct1 Three bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Two = addr { octet1 = (apply_mask oct1 Two bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == One = addr { octet1 = (apply_mask oct1 One bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ | mask == Zero = addr { octet1 = (apply_mask oct1 Zero bit),
+ octet2 = (apply_mask oct2 Zero bit),
+ octet3 = (apply_mask oct3 Zero bit),
+ octet4 = (apply_mask oct4 Zero bit)}
+ where
+ oct1 = (octet1 addr)
+ oct2 = (octet2 addr)
+ oct3 = (octet3 addr)
+ oct4 = (octet4 addr)
--- We don't export our constructor so this function is the only
--- way to construct an address from octets. As a result, we can
--- return IPv4Address.None in response to being passed one of more
--- Octet.None octets.
-ipv4address_from_octets :: Octet -> Octet -> Octet -> Octet -> IPv4Address
-ipv4address_from_octets oct1 oct2 oct3 oct4
- | or [oct1 == Octet.None,
- oct2 == Octet.None,
- oct3 == Octet.None,
- oct4 == Octet.None] = IPv4Address.None
- | otherwise = IPv4Address oct1 oct2 oct3 oct4
-
--- The minimum possible IPv4 address, 0.0.0.0.
+-- | The minimum possible IPv4 address, 0.0.0.0.
min_address :: IPv4Address
-min_address = IPv4Address min_octet min_octet min_octet min_octet
+min_address =
+ IPv4Address min_octet min_octet min_octet min_octet
--- The maximum possible IPv4 address, 255.255.255.255.
+-- | The maximum possible IPv4 address, 255.255.255.255.
max_address :: IPv4Address
-max_address = IPv4Address max_octet max_octet max_octet max_octet
+max_address =
+ IPv4Address max_octet max_octet max_octet max_octet
--- Given two addresses, find the number of the most significant bit
--- where they differ. If the addresses are the same, return
--- Maskbits.Zero.
+-- | Given two addresses, find the number of the most significant bit
+-- where they differ. If the addresses are the same, return
+-- Maskbits.Zero.
most_sig_bit_different :: IPv4Address -> IPv4Address -> Maskbits
most_sig_bit_different addr1 addr2
| addr1 == addr2 = Maskbits.Zero
-- HUnit Tests
mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address
mk_testaddr a b c d =
- IPv4Address oct1 oct2 oct3 oct4
- where
- oct1 = octet_from_int a
- oct2 = octet_from_int b
- oct3 = octet_from_int c
- oct4 = octet_from_int d
+ IPv4Address oct1 oct2 oct3 oct4
+ where
+ oct1 = fromJust $ octet_from_int a
+ oct2 = fromJust $ octet_from_int b
+ oct3 = fromJust $ octet_from_int c
+ oct4 = fromJust $ octet_from_int d
test_most_sig_bit_different1 :: Test
test_most_sig_bit_different1 =
- 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))
+ TestCase $ assertEqual "10.1.1.0 and 10.1.0.0 differ in bit 24"
+ TwentyFour
+ bit
+ where
+ addr1 = mk_testaddr 10 1 1 0
+ addr2 = (mk_testaddr 10 1 0 0)
+ bit = most_sig_bit_different addr1 addr2
+
test_most_sig_bit_different2 :: Test
test_most_sig_bit_different2 =
- 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))
+ TestCase $ assertEqual "10.1.2.0 and 10.1.1.0 differ in bit 23"
+ TwentyThree
+ bit
+ where
+ addr1 = mk_testaddr 10 1 2 0
+ addr2 = mk_testaddr 10 1 1 0
+ bit = most_sig_bit_different addr1 addr2
ipv4address_tests :: [Test]
-ipv4address_tests = [ test_most_sig_bit_different1,
- test_most_sig_bit_different2 ]
+ipv4address_tests =
+ [ test_most_sig_bit_different1,
+ test_most_sig_bit_different2 ]
import Data.List ((\\), intercalate, intersperse)
+import Data.Maybe (catMaybes, isNothing)
import System.Exit (ExitCode(..), exitWith)
import System.IO (stderr, hPutStrLn)
input <- inputfunc
let cidr_strings = lines input
- let cidrs = map Cidr.cidr_from_string cidr_strings
+ let cidrs = map cidr_from_string cidr_strings
- if (any (== Cidr.None) cidrs)
+ if (any isNothing cidrs)
then do
putStrLn "Error: not valid CIDR notation."
exitWith (ExitFailure exit_invalid_cidr)
else do -- Nothing
+ -- Filter out only the valid ones.
+ let valid_cidrs = catMaybes cidrs
+
-- Get the mode of operation.
mode <- CommandLine.parse_mode
case mode of
Regex -> do
- let regexes = map cidr_to_regex cidrs
- putStrLn $ alternate regexes
+ let regexes = map cidr_to_regex valid_cidrs
+ putStrLn $ alternate regexes
Reduce -> do
- _ <- mapM (putStrLn . show) (combine_all cidrs)
- return ()
+ _ <- mapM (putStrLn . show) (combine_all valid_cidrs)
+ return ()
Dupe -> do
- _ <- mapM (putStrLn . show) dupes
- return ()
- where
- dupes = cidrs \\ (combine_all cidrs)
+ _ <- mapM (putStrLn . show) dupes
+ return ()
+ where
+ dupes = valid_cidrs \\ (combine_all valid_cidrs)
Diff -> do
- _ <- mapM putStrLn deletions
- _ <- mapM putStrLn additions
- return ()
- where
- dupes = cidrs \\ (combine_all cidrs)
- deletions = map (\s -> "-" ++ (show s)) dupes
- newcidrs = (combine_all cidrs) \\ cidrs
- additions = map (\s -> "+" ++ (show s)) newcidrs
+ _ <- mapM putStrLn deletions
+ _ <- mapM putStrLn additions
+ return ()
+ where
+ dupes = valid_cidrs \\ (combine_all valid_cidrs)
+ deletions = map (\s -> "-" ++ (show s)) dupes
+ newcidrs = (combine_all valid_cidrs) \\ valid_cidrs
+ additions = map (\s -> "+" ++ (show s)) newcidrs
import Bit
import Maskbits
--- Any string of bits should be maskable by some number of netmask
--- bits. The convention of the Maskable typeclass follows CIDR
--- notation, where the number of mask bits (the number after the
--- slash) denotes how many bits are reserved for the network.
+-- | Any string of bits should be maskable by some number of netmask
+-- bits. The convention of the Maskable typeclass follows CIDR
+-- notation, where the number of mask bits (the number after the
+-- slash) denotes how many bits are reserved for the network.
--
--- So, a mask of 32 applied to an address of 127.0.0.1 will again
--- return 127.0.0.1. Likewise, 31 mask bits applied to 127.0.0.1
--- should return 127.0.0.0, since 127.0.0.1/31 matches both 127.0.0.0
--- and 127.0.0.1. In this case, the final '0' or '1' is the host
--- part of the address. The '127.0.0' is thus the network part.
+-- So, a mask of 32 applied to an address of 127.0.0.1 will again
+-- return 127.0.0.1. Likewise, 31 mask bits applied to 127.0.0.1
+-- should return 127.0.0.0, since 127.0.0.1/31 matches both
+-- 127.0.0.0 and 127.0.0.1. In this case, the final '0' or '1' is
+-- the host part of the address. The '127.0.0' is thus the network
+-- part.
+--
+-- The Bit argument allows us to specify whether the host bits
+-- should be replaced with either Zero or One.
--
--- The Bit argument allows us to specify whether the host bits
--- should be replaced with either Zero or One.
class Maskable a where
apply_mask :: a -> Maskbits -> Bit -> a
-
import Test.QuickCheck
-- A type representing the number of bits in a CIDR netmask.
-data Maskbits = None
- | Zero
- | One
- | Two
- | Three
- | Four
- | Five
- | Six
- | Seven
- | Eight
- | Nine
- | Ten
- | Eleven
- | Twelve
- | Thirteen
- | Fourteen
- | Fifteen
- | Sixteen
- | Seventeen
- | Eighteen
- | Nineteen
- | Twenty
- | TwentyOne
- | TwentyTwo
- | TwentyThree
- | TwentyFour
- | TwentyFive
- | TwentySix
- | TwentySeven
- | TwentyEight
- | TwentyNine
- | Thirty
- | ThirtyOne
- | ThirtyTwo
- deriving (Eq, Ord)
+data Maskbits =
+ Zero
+ | One
+ | Two
+ | Three
+ | Four
+ | Five
+ | Six
+ | Seven
+ | Eight
+ | Nine
+ | Ten
+ | Eleven
+ | Twelve
+ | Thirteen
+ | Fourteen
+ | Fifteen
+ | Sixteen
+ | Seventeen
+ | Eighteen
+ | Nineteen
+ | Twenty
+ | TwentyOne
+ | TwentyTwo
+ | TwentyThree
+ | TwentyFour
+ | TwentyFive
+ | TwentySix
+ | TwentySeven
+ | TwentyEight
+ | TwentyNine
+ | Thirty
+ | ThirtyOne
+ | ThirtyTwo
+ deriving (Eq, Ord)
instance Show Maskbits where
- show None = "None"
- show Zero = "0"
- show One = "1"
- show Two = "2"
- show Three = "3"
- show Four = "4"
- show Five = "5"
- show Six = "6"
- show Seven = "7"
- show Eight = "8"
- show Nine = "9"
- show Ten = "10"
- show Eleven = "11"
- show Twelve = "12"
- show Thirteen = "13"
- show Fourteen = "14"
- show Fifteen = "15"
- show Sixteen = "16"
- show Seventeen = "17"
- show Eighteen = "18"
- show Nineteen = "19"
- show Twenty = "20"
- show TwentyOne = "21"
- show TwentyTwo = "22"
- show TwentyThree = "23"
- show TwentyFour = "24"
- show TwentyFive = "25"
- show TwentySix = "26"
- show TwentySeven = "27"
- show TwentyEight = "28"
- show TwentyNine = "29"
- show Thirty = "30"
- show ThirtyOne = "31"
- show ThirtyTwo = "32"
+ show Zero = "0"
+ show One = "1"
+ show Two = "2"
+ show Three = "3"
+ show Four = "4"
+ show Five = "5"
+ show Six = "6"
+ show Seven = "7"
+ show Eight = "8"
+ show Nine = "9"
+ show Ten = "10"
+ show Eleven = "11"
+ show Twelve = "12"
+ show Thirteen = "13"
+ show Fourteen = "14"
+ show Fifteen = "15"
+ show Sixteen = "16"
+ show Seventeen = "17"
+ show Eighteen = "18"
+ show Nineteen = "19"
+ show Twenty = "20"
+ show TwentyOne = "21"
+ show TwentyTwo = "22"
+ show TwentyThree = "23"
+ show TwentyFour = "24"
+ show TwentyFive = "25"
+ show TwentySix = "26"
+ show TwentySeven = "27"
+ show TwentyEight = "28"
+ show TwentyNine = "29"
+ show Thirty = "30"
+ show ThirtyOne = "31"
+ show ThirtyTwo = "32"
instance Arbitrary Maskbits where
- arbitrary = elements [ Zero,
- One,
- Two,
- Three,
- Four,
- Five,
- Six,
- Seven,
- Eight,
- Nine,
- Ten,
- Eleven,
- Twelve,
- Thirteen,
- Fourteen,
- Fifteen,
- Sixteen,
- Seventeen,
- Eighteen,
- Nineteen,
- Twenty,
- TwentyOne,
- TwentyTwo,
- TwentyThree,
- TwentyFour,
- TwentyFive,
- TwentySix,
- TwentySeven,
- TwentyEight,
- TwentyNine,
- Thirty,
- ThirtyOne,
- ThirtyTwo ]
+ arbitrary =
+ elements [ Zero,
+ One,
+ Two,
+ Three,
+ Four,
+ Five,
+ Six,
+ Seven,
+ Eight,
+ Nine,
+ Ten,
+ Eleven,
+ Twelve,
+ Thirteen,
+ Fourteen,
+ Fifteen,
+ Sixteen,
+ Seventeen,
+ Eighteen,
+ Nineteen,
+ Twenty,
+ TwentyOne,
+ TwentyTwo,
+ TwentyThree,
+ TwentyFour,
+ TwentyFive,
+ TwentySix,
+ TwentySeven,
+ TwentyEight,
+ TwentyNine,
+ Thirty,
+ ThirtyOne,
+ ThirtyTwo ]
--- There are only 32 bits in an IPv4 address, so there
--- can't be more bits than that in the mask.
-maskbits_from_int :: Int -> Maskbits
-maskbits_from_int 0 = Zero
-maskbits_from_int 1 = One
-maskbits_from_int 2 = Two
-maskbits_from_int 3 = Three
-maskbits_from_int 4 = Four
-maskbits_from_int 5 = Five
-maskbits_from_int 6 = Six
-maskbits_from_int 7 = Seven
-maskbits_from_int 8 = Eight
-maskbits_from_int 9 = Nine
-maskbits_from_int 10 = Ten
-maskbits_from_int 11 = Eleven
-maskbits_from_int 12 = Twelve
-maskbits_from_int 13 = Thirteen
-maskbits_from_int 14 = Fourteen
-maskbits_from_int 15 = Fifteen
-maskbits_from_int 16 = Sixteen
-maskbits_from_int 17 = Seventeen
-maskbits_from_int 18 = Eighteen
-maskbits_from_int 19 = Nineteen
-maskbits_from_int 20 = Twenty
-maskbits_from_int 21 = TwentyOne
-maskbits_from_int 22 = TwentyTwo
-maskbits_from_int 23 = TwentyThree
-maskbits_from_int 24 = TwentyFour
-maskbits_from_int 25 = TwentyFive
-maskbits_from_int 26 = TwentySix
-maskbits_from_int 27 = TwentySeven
-maskbits_from_int 28 = TwentyEight
-maskbits_from_int 29 = TwentyNine
-maskbits_from_int 30 = Thirty
-maskbits_from_int 31 = ThirtyOne
-maskbits_from_int 32 = ThirtyTwo
-maskbits_from_int _ = None
+-- | There are only 32 bits in an IPv4 address, so there
+-- can't be more bits than that in the mask.
+maskbits_from_int :: Int -> Maybe Maskbits
+maskbits_from_int 0 = Just Zero
+maskbits_from_int 1 = Just One
+maskbits_from_int 2 = Just Two
+maskbits_from_int 3 = Just Three
+maskbits_from_int 4 = Just Four
+maskbits_from_int 5 = Just Five
+maskbits_from_int 6 = Just Six
+maskbits_from_int 7 = Just Seven
+maskbits_from_int 8 = Just Eight
+maskbits_from_int 9 = Just Nine
+maskbits_from_int 10 = Just Ten
+maskbits_from_int 11 = Just Eleven
+maskbits_from_int 12 = Just Twelve
+maskbits_from_int 13 = Just Thirteen
+maskbits_from_int 14 = Just Fourteen
+maskbits_from_int 15 = Just Fifteen
+maskbits_from_int 16 = Just Sixteen
+maskbits_from_int 17 = Just Seventeen
+maskbits_from_int 18 = Just Eighteen
+maskbits_from_int 19 = Just Nineteen
+maskbits_from_int 20 = Just Twenty
+maskbits_from_int 21 = Just TwentyOne
+maskbits_from_int 22 = Just TwentyTwo
+maskbits_from_int 23 = Just TwentyThree
+maskbits_from_int 24 = Just TwentyFour
+maskbits_from_int 25 = Just TwentyFive
+maskbits_from_int 26 = Just TwentySix
+maskbits_from_int 27 = Just TwentySeven
+maskbits_from_int 28 = Just TwentyEight
+maskbits_from_int 29 = Just TwentyNine
+maskbits_from_int 30 = Just Thirty
+maskbits_from_int 31 = Just ThirtyOne
+maskbits_from_int 32 = Just ThirtyTwo
+maskbits_from_int _ = Nothing
-
-maskbits_from_string :: String -> Maskbits
+maskbits_from_string :: String -> Maybe Maskbits
maskbits_from_string s =
- case (reads s :: [(Int, String)]) of
- [] -> None
- x:_ -> maskbits_from_int (fst x)
+ case (reads s :: [(Int, String)]) of
+ [] -> Nothing
+ x:_ -> maskbits_from_int (fst x)
decrement :: Maskbits -> Maskbits
-decrement None = None
-decrement Zero = None
+decrement Zero = Zero
decrement One = Zero
decrement Two = One
decrement Three = Two
-module Octet where
+module Octet
+where
+import Data.Maybe (fromJust)
import Test.HUnit
import Test.QuickCheck
import Maskable
import Maskbits
--- An Octet consists of eight bits. For our purposes, the most
--- significant bit will come "first." That is, b1 is in the 2^7
--- place while b8 is in the 2^0 place.
-data Octet = None | Octet { b1 :: Bit,
- b2 :: Bit,
- b3 :: Bit,
- b4 :: Bit,
- b5 :: Bit,
- b6 :: Bit,
- b7 :: Bit,
- b8 :: Bit }
- deriving (Eq)
+-- | An Octet consists of eight bits. For our purposes, the most
+-- significant bit will come "first." That is, b1 is in the 2^7
+-- place while b8 is in the 2^0 place.
+data Octet =
+ Octet { b1 :: Bit,
+ b2 :: Bit,
+ b3 :: Bit,
+ b4 :: Bit,
+ b5 :: Bit,
+ b6 :: Bit,
+ b7 :: Bit,
+ b8 :: Bit }
+ deriving (Eq)
instance Show Octet where
- show Octet.None = "None"
- show oct = show (octet_to_int oct)
+ show oct = show (octet_to_int oct)
instance Arbitrary Octet where
- arbitrary = do
- a1 <- arbitrary :: Gen Bit
- a2 <- arbitrary :: Gen Bit
- a3 <- arbitrary :: Gen Bit
- a4 <- arbitrary :: Gen Bit
- a5 <- arbitrary :: Gen Bit
- a6 <- arbitrary :: Gen Bit
- a7 <- arbitrary :: Gen Bit
- a8 <- arbitrary :: Gen Bit
- return (Octet a1 a2 a3 a4 a5 a6 a7 a8)
+ arbitrary = do
+ a1 <- arbitrary :: Gen Bit
+ a2 <- arbitrary :: Gen Bit
+ a3 <- arbitrary :: Gen Bit
+ a4 <- arbitrary :: Gen Bit
+ a5 <- arbitrary :: Gen Bit
+ a6 <- arbitrary :: Gen Bit
+ a7 <- arbitrary :: Gen Bit
+ a8 <- arbitrary :: Gen Bit
+ return (Octet a1 a2 a3 a4 a5 a6 a7 a8)
instance Maskable Octet where
- apply_mask _ Maskbits.None _ = Octet.None
- apply_mask Octet.None _ _ = Octet.None
- apply_mask oct mask bit
- | mask == Eight = oct
- | mask == Seven = oct { b8 = bit }
- | mask == Six = oct { b8 = bit, b7 = bit }
- | mask == Five = oct { b8 = bit, b7 = bit, b6 = bit }
- | mask == Four = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit }
- | mask == Three = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit }
- | mask == Two = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit }
- | mask == Maskbits.One = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit, b2 = bit }
- | mask == Maskbits.Zero = oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit, b2 = bit, b1 = bit }
- | otherwise = Octet.None
-
-
--- Convert each bit to its integer value, and multiply by the
--- appropriate power of two. Sum them up, and we should get an integer
--- between 0 and 255.
+ apply_mask oct Eight _ = oct
+
+ apply_mask oct Seven bit =
+ oct { b8 = bit }
+
+ apply_mask oct Six bit =
+ oct { b8 = bit, b7 = bit }
+
+ apply_mask oct Five bit =
+ oct { b8 = bit, b7 = bit, b6 = bit }
+
+ apply_mask oct Four bit =
+ oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit }
+
+ apply_mask oct Three bit =
+ oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit }
+
+ apply_mask oct Two bit =
+ oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit }
+
+ apply_mask oct Maskbits.One bit =
+ oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
+ b4 = bit, b3 = bit, b2 = bit }
+
+ apply_mask oct Maskbits.Zero bit =
+ oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
+ b4 = bit, b3 = bit, b2 = bit, b1 = bit }
+
+ -- The Maskbits must be in [Eight..ThirtyTwo].
+ apply_mask oct _ _ = oct
+
+
+-- | Convert each bit to its integer value, and multiply by the
+-- appropriate power of two. Sum them up, and we should get an integer
+-- between 0 and 255.
octet_to_int :: Octet -> Int
octet_to_int x =
- 128 * (bit_to_int (b1 x)) +
- 64 * (bit_to_int (b2 x)) +
- 32 * (bit_to_int (b3 x)) +
- 16 * (bit_to_int (b4 x)) +
- 8 * (bit_to_int (b5 x)) +
- 4 * (bit_to_int (b6 x)) +
- 2 * (bit_to_int (b7 x)) +
- 1 * (bit_to_int (b8 x))
+ 128 * (bit_to_int (b1 x)) +
+ 64 * (bit_to_int (b2 x)) +
+ 32 * (bit_to_int (b3 x)) +
+ 16 * (bit_to_int (b4 x)) +
+ 8 * (bit_to_int (b5 x)) +
+ 4 * (bit_to_int (b6 x)) +
+ 2 * (bit_to_int (b7 x)) +
+ 1 * (bit_to_int (b8 x))
-octet_from_int :: Int -> Octet
+octet_from_int :: Int -> Maybe Octet
octet_from_int x
- | (x < 0) || (x > 255) = Octet.None
- | otherwise = (Octet a1 a2 a3 a4 a5 a6 a7 a8)
- where
- a1 = if (x >= 128) then B.One else B.Zero
- a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
- a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero
- a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero
- a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero
- a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero
- a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero
- a8 = if ((x `mod` 2) == 1) then B.One else B.Zero
-
-
-octet_from_string :: String -> Octet
+ | (x < 0) || (x > 255) = Nothing
+ | otherwise = Just (Octet a1 a2 a3 a4 a5 a6 a7 a8)
+ where
+ a1 = if (x >= 128) then B.One else B.Zero
+ a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
+ a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero
+ a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero
+ a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero
+ a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero
+ a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero
+ a8 = if ((x `mod` 2) == 1) then B.One else B.Zero
+
+
+octet_from_string :: String -> Maybe Octet
octet_from_string s =
- case (reads s :: [(Int, String)]) of
- [] -> Octet.None
- x:_ -> octet_from_int (fst x)
+ case (reads s :: [(Int, String)]) of
+ [] -> Nothing
+ x:_ -> octet_from_int (fst x)
--- The octet with the least possible value.
+-- | The octet with the least possible value.
min_octet :: Octet
-min_octet = Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
+min_octet =
+ Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
--- The octet with the greatest possible value.
+-- | The octet with the greatest possible value.
max_octet :: Octet
-max_octet = Octet B.One B.One B.One B.One B.One B.One B.One B.One
+max_octet =
+ Octet B.One B.One B.One B.One B.One B.One B.One B.One
-- HUnit Tests
test_octet_from_int1 :: Test
test_octet_from_int1 =
- TestCase $ assertEqual "octet_from_int 128 should parse as 10000000" oct1 (octet_from_int 128)
- where
- oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
-
+ TestCase $ assertEqual "octet_from_int 128 should parse as 10000000" oct1 oct2
+ where
+ oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
+ oct2 = fromJust $ octet_from_int 128
test_octet_mask1 :: Test
test_octet_mask1 =
- TestCase $ assertEqual "The network bits of 255/4 should equal 240" oct2 (apply_mask oct1 Four B.Zero)
- where
- oct1 = octet_from_int 255
- oct2 = octet_from_int 240
+ TestCase $
+ assertEqual
+ "The network bits of 255/4 should equal 240"
+ oct2
+ (apply_mask oct1 Four B.Zero)
+ where
+ oct1 = fromJust $ octet_from_int 255
+ oct2 = fromJust $ octet_from_int 240
test_octet_mask2 :: Test
test_octet_mask2 =
- TestCase $ assertEqual "The network bits of 255/1 should equal 128" oct2 (apply_mask oct1 Maskbits.One B.Zero)
- where
- oct1 = octet_from_int 255
- oct2 = octet_from_int 128
+ TestCase $
+ assertEqual
+ "The network bits of 255/1 should equal 128"
+ oct2
+ (apply_mask oct1 Maskbits.One B.Zero)
+ where
+ oct1 = fromJust $ octet_from_int 255
+ oct2 = fromJust $ octet_from_int 128
octet_tests :: [Test]
-octet_tests = [ test_octet_from_int1,
- test_octet_mask1,
- test_octet_mask2 ]
+octet_tests =
+ [ test_octet_from_int1,
+ test_octet_mask1,
+ test_octet_mask2 ]
projects / hath.git / commitdiff