iproute 1.2.4 → 1.2.5
raw patch · 7 files changed
+368/−412 lines, 7 files
Files
- Data/IP/Addr.hs +28/−5
- Data/IP/Op.hs +28/−0
- Data/IP/Range.hs +17/−7
- Data/IP/RouteTable/Internal.hs +28/−2
- iproute.cabal +2/−2
- test/Test.hs +265/−0
- test/Tests.hs +0/−396
Data/IP/Addr.hs view
@@ -13,7 +13,12 @@ {-| A unified IP data for 'IPv4' and 'IPv6'.- To create this, use the data constructors. Or use 'read' @"192.0.2.1"@ :: 'IP', for example. Also, @"192.0.2.1"@ can be used as literal with OverloadedStrings.+ To create this, use the data constructors. Or use 'read' @\"192.0.2.1\"@ :: 'IP', for example. Also, @\"192.0.2.1\"@ can be used as literal with OverloadedStrings.++>>> (read "192.0.2.1" :: IP) == IPv4 (read "192.0.2.1" :: IPv4)+True+>>> (read "2001:db8:00:00:00:00:00:01" :: IP) == IPv6 (read "2001:db8:00:00:00:00:00:01" :: IPv6)+True -} data IP = IPv4 { ipv4 :: IPv4 }@@ -31,14 +36,22 @@ type IPv6Addr = (Word32,Word32,Word32,Word32) {-|- The abstract data structure to express an IPv4 address.+ The abstract data type to express an IPv4 address. To create this, use 'toIPv4'. Or use 'read' @\"192.0.2.1\"@ :: 'IPv4', for example. Also, @\"192.0.2.1\"@ can be used as literal with OverloadedStrings.++>>> read "192.0.2.1" :: IPv4+192.0.2.1 -} newtype IPv4 = IP4 IPv4Addr deriving (Eq, Ord) {-|- The abstract data structure to express an IPv6 address.+ The abstract data type to express an IPv6 address. To create this, use 'toIPv6'. Or use 'read' @\"2001:DB8::1\"@ :: 'IPv6', for example. Also, @\"2001:DB8::1\"@ can be used as literal with OverloadedStrings.++>>> read "2001:db8:00:00:00:00:00:01" :: IPv6+2001:db8:00:00:00:00:00:01+>>> read "2001:240:11e:c00::101" :: IPv6+2001:240:11e:c00:00:00:00:101 -} newtype IPv6 = IP6 IPv6Addr deriving (Eq, Ord) @@ -78,7 +91,9 @@ {-| The 'toIPv4' function takes a list of 'Int' and returns 'IPv4'.- For example, 'toIPv4' @[192,0,2,1]@.++>>> toIPv4 [192,0,2,1]+192.0.2.1 -} toIPv4 :: [Int] -> IPv4 toIPv4 = IP4 . toWord32@@ -88,7 +103,9 @@ {-| The 'toIPv6' function takes a list of 'Int' and returns 'IPv6'.- For example, 'toIPv6' @[0x2001,0xDB8,0,0,0,0,0,1]@.++>>> toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]+2001:db8:00:00:00:00:00:01 -} toIPv6 :: [Int] -> IPv6 toIPv6 ad = let [x1,x2,x3,x4] = map toWord32 $ split2 ad@@ -106,12 +123,18 @@ {-| The 'fromIPv4' function convert 'IPv4' to a list of 'Int'.++>>> fromIPv4 (toIPv4 [192,0,2,1])+[192,0,2,1] -} fromIPv4 :: IPv4 -> [Int] fromIPv4 (IP4 w) = map (\n -> fromEnum $ (w `shiftR` n) .&. 0xff) [0o30, 0o20, 0o10, 0o00] {-| The 'toIPv6' function convert 'IPv6' to a list of 'Int'.++>>> fromIPv6 (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1])+[8193,3512,0,0,0,0,0,1] -} fromIPv6 :: IPv6 -> [Int] fromIPv6 (IP6 (w1, w2, w3, w4)) = map fromEnum (concatMap split [w1,w2,w3,w4])
Data/IP/Op.hs view
@@ -7,6 +7,11 @@ ---------------------------------------------------------------- +{-|++>>> toIPv4 [127,0,2,1] `masked` intToMask 7+126.0.0.0+-} class Eq a => Addr a where {-| The 'masked' function takes an 'Addr' and a contiguous@@ -34,6 +39,15 @@ The >:> operator takes two 'AddrRange'. It returns 'True' if the first 'AddrRange' contains the second 'AddrRange'. Otherwise, it returns 'False'.++>>> makeAddrRange ("127.0.2.1" :: IPv4) 8 >:> makeAddrRange "127.0.2.1" 24+True+>>> makeAddrRange ("127.0.2.1" :: IPv4) 24 >:> makeAddrRange "127.0.2.1" 8+False+>>> makeAddrRange ("2001:DB8::1" :: IPv6) 16 >:> makeAddrRange "2001:DB8::1" 32+True+>>> makeAddrRange ("2001:DB8::1" :: IPv6) 32 >:> makeAddrRange "2001:DB8::1" 16+False -} (>:>) :: Addr a => AddrRange a -> AddrRange a -> Bool a >:> b = mlen a <= mlen b && (addr b `masked` mask a) == addr a@@ -41,6 +55,15 @@ {-| The 'toMatchedTo' function take an 'Addr' address and an 'AddrRange', and returns 'True' if the range contains the address.++>>> ("127.0.2.0" :: IPv4) `isMatchedTo` makeAddrRange "127.0.2.1" 24+True+>>> ("127.0.2.0" :: IPv4) `isMatchedTo` makeAddrRange "127.0.2.1" 32+False+>>> ("2001:DB8::1" :: IPv6) `isMatchedTo` makeAddrRange "2001:DB8::1" 32+True+>>> ("2001:DB8::" :: IPv6) `isMatchedTo` makeAddrRange "2001:DB8::1" 128+False -} isMatchedTo :: Addr a => a -> AddrRange a -> Bool@@ -50,6 +73,11 @@ The 'makeAddrRange' functions takes an 'Addr' address and a mask length. It creates a bit mask from the mask length and masks the 'Addr' address, then returns 'AddrRange' made of them.++>>> makeAddrRange (toIPv4 [127,0,2,1]) 8+127.0.0.0/8+>>> makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 8+2000:00:00:00:00:00:00:00/8 -} makeAddrRange :: Addr a => a -> Int -> AddrRange a makeAddrRange ad len = AddrRange adr msk len
Data/IP/Range.hs view
@@ -12,8 +12,13 @@ {-| A unified data for 'AddrRange' 'IPv4' and 'AddrRange' 'IPv6'.- To create this, use 'read' \"192.0.2.0/24\" :: 'IPRange'.- Also, \"192.0.2.0/24\" can be used as literal with OverloadedStrings.+ To create this, use 'read' @\"192.0.2.0/24\"@ :: 'IPRange'.+ Also, @\"192.0.2.0/24\"@ can be used as literal with OverloadedStrings.++>>> (read "192.0.2.1/24" :: IPRange) == IPv4Range (read "192.0.2.0/24" :: AddrRange IPv4)+True+>>> (read "2001:db8:00:00:00:00:00:01/48" :: IPRange) == IPv6Range (read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6)+True -} data IPRange = IPv4Range { ipv4range :: AddrRange IPv4 }@@ -31,16 +36,21 @@ are essentially same information but contained for pre calculation. - To create this, use 'makeAddrRange' or 'read' \"192.0.2.0/24\" :: 'AddrRange' 'IPv4'.- Also, \"192.0.2.0/24\" can be used as literal with OverloadedStrings.+ To create this, use 'makeAddrRange' or 'read' @\"192.0.2.0/24\"@ :: 'AddrRange' 'IPv4'.+ Also, @\"192.0.2.0/24\"@ can be used as literal with OverloadedStrings.++>>> read "192.0.2.1/24" :: AddrRange IPv4+192.0.2.0/24+>>> read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6+2001:db8:00:00:00:00:00:00/48 -} data AddrRange a = AddrRange { -- |The 'addr' function returns an address from 'AddrRange'.- addr :: a+ addr :: !a -- |The 'mask' function returns a contiguous 'IP' mask from 'AddrRange'.- , mask :: a+ , mask :: !a -- |The 'mlen' function returns a mask length from 'AddrRange'.- , mlen :: Int+ , mlen :: {-# UNPACK #-} !Int } deriving (Eq, Ord) ----------------------------------------------------------------
Data/IP/RouteTable/Internal.hs view
@@ -77,12 +77,12 @@ {-| The Tree structure for IP routing table based on TRIE with- one way branching removed. This is an abstracted data structure,+ one way branching removed. This is an abstract data type, so you cannot touch its inside. Please use 'insert' or 'lookup', instead. -} data IPRTable k a = Nil- | Node !(AddrRange k) !k !(Maybe a) (IPRTable k a) (IPRTable k a)+ | Node !(AddrRange k) !k !(Maybe a) !(IPRTable k a) !(IPRTable k a) deriving (Eq, Show) ----------------------------------------------------------------@@ -98,6 +98,9 @@ {-| The 'insert' function inserts a value with a key of 'AddrRange' to 'IPRTable' and returns a new 'IPRTable'.++>>> (insert ("127.0.0.1" :: AddrRange IPv4) () empty) == fromList [("127.0.0.1",())]+True -} insert :: (Routable k) => AddrRange k -> a -> IPRTable k a -> IPRTable k a insert k1 v1 Nil = Node k1 tb1 (Just v1) Nil Nil@@ -143,6 +146,9 @@ {-| The 'delete' function deletes a value by a key of 'AddrRange' from 'IPRTable' and returns a new 'IPRTable'.++>>> delete "127.0.0.1" (insert ("127.0.0.1" :: AddrRange IPv4) () empty) == empty+True -} delete :: (Routable k) => AddrRange k -> IPRTable k a -> IPRTable k a delete _ Nil = Nil@@ -164,6 +170,21 @@ The 'lookup' function looks up 'IPRTable' with a key of 'AddrRange'. If a routing information in 'IPRTable' matches the key, its value is returned.++>>> let v4 = ["133.4.0.0/16","133.5.0.0/16","133.5.16.0/24","133.5.23.0/24"] :: [AddrRange IPv4]+>>> let rt = fromList $ zip v4 v4+>>> lookup "127.0.0.1" rt+Nothing+>>> lookup "133.3.0.1" rt+Nothing+>>> lookup "133.4.0.0" rt+Just 133.4.0.0/16+>>> lookup "133.4.0.1" rt+Just 133.4.0.0/16+>>> lookup "133.5.16.0" rt+Just 133.5.16.0/24+>>> lookup "133.5.16.1" rt+Just 133.5.16.0/24 -} lookup :: Routable k => AddrRange k -> IPRTable k a -> Maybe a lookup k s = search k s Nothing@@ -189,6 +210,11 @@ The 'findMatch' function looks up 'IPRTable' with a key of 'AddrRange'. If the key matches routing informations in 'IPRTable', they are returned.++>>> let v4 = ["133.4.0.0/16","133.5.0.0/16","133.5.16.0/24","133.5.23.0/24"] :: [AddrRange IPv4]+>>> let rt = fromList $ zip v4 $ repeat ()+>>> findMatch "133.4.0.0/15" rt :: [(AddrRange IPv4,())]+[(133.4.0.0/16,()),(133.5.0.0/16,()),(133.5.16.0/24,()),(133.5.23.0/24,())] -} findMatch :: MonadPlus m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
iproute.cabal view
@@ -1,5 +1,5 @@ Name: iproute-Version: 1.2.4+Version: 1.2.5 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -14,7 +14,7 @@ Category: Algorithms, Network Cabal-Version: >= 1.6 Build-Type: Simple-Extra-Source-Files: test/Tests.hs test/IPv4Search.hs test/Makefile+Extra-Source-Files: test/Test.hs test/IPv4Search.hs test/Makefile library if impl(ghc >= 6.12) GHC-Options: -Wall -fno-warn-unused-do-bind
+ test/Test.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main where++----------------------------------------------------------------+--+-- Tests for IP.RouteTable+--+-- runghc -i.. Test.hs+--++import Control.Monad+import Data.IP+import Data.IP.RouteTable.Internal+import Data.List (sort, nub)+import Prelude hiding (lookup)+import Test.Framework.Providers.DocTest+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.Framework.TH.Prime+import Test.HUnit+import Test.QuickCheck++----------------------------------------------------------------++main :: IO ()+main = $(defaultMainGenerator)++----------------------------------------------------------------++doc_test :: DocTests+doc_test = docTest ["../Data/IP.hs", "../Data/IP/RouteTable.hs"] ["-i..", "-XOverloadedStrings"]++----------------------------------------------------------------+--+-- Arbitrary+--++instance Arbitrary (AddrRange IPv4) where+ arbitrary = arbitraryIP arbitrary 32++instance Arbitrary (AddrRange IPv6) where+ arbitrary = arbitraryIP arbitrary 128++instance Arbitrary IPv4 where+ arbitrary = arbitraryAdr toIPv4 255 4++instance Arbitrary IPv6 where+ arbitrary = arbitraryAdr toIPv6 65535 8++arbitraryAdr :: Routable a => ([Int] -> a) -> Int -> Int -> Gen a+arbitraryAdr func width adrlen = do+ a <- replicateM adrlen (choose (0, width))+ return $ func a++arbitraryIP :: Routable a => Gen a -> Int -> Gen (AddrRange a)+arbitraryIP adrGen msklen = do+ adr <- adrGen+ len <- choose (0,msklen)+ return $ makeAddrRange adr len++----------------------------------------------------------------+--+-- Properties+--++prop_sort_ipv4 :: [AddrRange IPv4] -> Bool+prop_sort_ipv4 = sort_ip++prop_sort_ipv6 :: [AddrRange IPv6] -> Bool+prop_sort_ipv6 = sort_ip++sort_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool+sort_ip xs = fromList (zip xs xs) == fromList (zip xs' xs')+ where+ xs' = sort xs++----------------------------------------------------------------++prop_fromto_ipv4 :: [AddrRange IPv4] -> Bool+prop_fromto_ipv4 = fromto_ip++prop_fromto_ipv6 :: [AddrRange IPv6] -> Bool+prop_fromto_ipv6 = fromto_ip++fromto_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool+fromto_ip xs = nub (sort xs) == nub (sort ys)+ where+ ys = map fst . toList . fromList $ zip xs xs++----------------------------------------------------------------++prop_ord_ipv4 :: [AddrRange IPv4] -> Bool+prop_ord_ipv4 = ord_ip++prop_ord_ipv6 :: [AddrRange IPv6] -> Bool+prop_ord_ipv6 = ord_ip++ord_ip :: Routable a => [AddrRange a] -> Bool+ord_ip xs = isOrdered . fromList $ zip xs xs++isOrdered :: Routable k => IPRTable k a -> Bool+isOrdered = foldt (\x v -> v && ordered x) True++ordered :: Routable k => IPRTable k a -> Bool+ordered Nil = True+ordered (Node k _ _ l r) = ordered' k l && ordered' k r+ where+ ordered' _ Nil = True+ ordered' k1 (Node k2 _ _ _ _) = k1 >:> k2++----------------------------------------------------------------++prop_insert_lookup_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Bool+prop_insert_lookup_ipv4 = insert_lookup_ip++prop_insert_lookup_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Bool+prop_insert_lookup_ipv6 = insert_lookup_ip++insert_lookup_ip :: Routable a => AddrRange a -> [AddrRange a] -> Bool+insert_lookup_ip k xs = lookup k (insert k k t) == Just k+ where+ rs = zip xs xs+ t = fromList rs++prop_search_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Bool+prop_search_ipv4 = search_ip++prop_search_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Bool+prop_search_ipv6 = search_ip++search_ip :: Routable a => AddrRange a -> [AddrRange a] -> Bool+search_ip k xs = lookup k (fromList (zip xs xs)) == linear k xs++linear :: Routable a => AddrRange a -> [AddrRange a] -> Maybe (AddrRange a)+linear = linear' Nothing+ where+ linear' a _ [] = a+ linear' Nothing k (x:xs)+ | x >:> k = linear' (Just x) k xs+ | otherwise = linear' Nothing k xs+ linear' (Just a) k (x:xs)+ | x >:> k = if mlen x > mlen a+ then linear' (Just x) k xs+ else linear' (Just a) k xs+ | otherwise = linear' (Just a) k xs++----------------------------------------------------------------++prop_delete_ipv4 :: [AddrRange IPv6] -> Property+prop_delete_ipv4 = delete_ip++prop_delete_ipv6 :: [AddrRange IPv6] -> Property+prop_delete_ipv6 = delete_ip++delete_ip :: Routable a => [AddrRange a] -> Property+delete_ip xs = xs /= [] ==> isOrdered (delete i t)+ where+ rs = zip xs xs+ t = fromList rs+ i = head xs++prop_insert_delete_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Property+prop_insert_delete_ipv4 = insert_delete_ip++prop_insert_delete_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Property+prop_insert_delete_ipv6 = insert_delete_ip++insert_delete_ip :: Routable a => AddrRange a -> [AddrRange a] -> Property+insert_delete_ip k xs = lookup k t == Nothing ==> delete k (insert k k t) == t+ where+ rs = zip xs xs+ t = fromList rs++prop_delete_insert_ipv4 :: [AddrRange IPv4] -> Property+prop_delete_insert_ipv4 = delete_insert_ip++prop_delete_insert_ipv6 :: [AddrRange IPv6] -> Property+prop_delete_insert_ipv6 = delete_insert_ip++delete_insert_ip :: Routable a => [AddrRange a] -> Property+delete_insert_ip xs = xs /= [] ==> insert k k (delete k t) == t+ where+ rs = zip xs xs+ t = fromList rs+ k = head xs++prop_delete_lookup_ipv4 :: [AddrRange IPv4] -> Property+prop_delete_lookup_ipv4 = delete_lookup_ip++prop_delete_lookup_ipv6 :: [AddrRange IPv6] -> Property+prop_delete_lookup_ipv6 = delete_lookup_ip++delete_lookup_ip :: Routable a => [AddrRange a] -> Property+delete_lookup_ip xs = xs /= [] ==> case lookup k (delete k t) of+ Nothing -> True+ Just r -> r /= k && r >:> k+ where+ rs = zip xs xs+ t = fromList rs+ k = head xs++prop_convert_ipv4 :: IPv4 -> Property+prop_convert_ipv4 ip = True ==> (toIPv4 . fromIPv4) ip == ip++prop_convert_ipv6 :: IPv6 -> Property+prop_convert_ipv6 ip = True ==> (toIPv6 . fromIPv6) ip == ip++----------------------------------------------------------------++ipv4_list :: [AddrRange IPv4]+ipv4_list = [+ "0.0.0.0/0"+ , "133.4.0.0/16"+ , "133.5.0.0/16"+ , "133.5.16.0/24"+ , "133.5.23.0/24"+ ]++case_fromto_ipv4 :: Assertion+case_fromto_ipv4 = (sort . toList . fromList $ pairs) @?= pairs+ where+ pairs = sort $ zip ipv4_list ipv4_list++case_lookup_ipv4 :: Assertion+case_lookup_ipv4 = do+ let rt = fromList pairs+ lookup "127.0.0.1" rt @?= Just "0.0.0.0/0"+ lookup "133.3.0.1" rt @?= Just "0.0.0.0/0"+ lookup "133.4.0.0" rt @?= Just "133.4.0.0/16"+ lookup "133.4.0.1" rt @?= Just "133.4.0.0/16"+ lookup "133.5.16.0" rt @?= Just "133.5.16.0/24"+ lookup "133.5.16.1" rt @?= Just "133.5.16.0/24"+ where+ pairs = zip ipv4_list ipv4_list++case_findMatch_ipv4 :: Assertion+case_findMatch_ipv4 = do+ let rt = fromList pairs+ findMatch "127.0.0.1" rt @?= []+ findMatch "133.5.23.0/23" rt @?= [("133.5.23.0/24","133.5.23.0/24")]+ findMatch "133.5.0.0/16" rt @?= [+ ("133.5.0.0/16","133.5.0.0/16")+ , ("133.5.16.0/24","133.5.16.0/24")+ , ("133.5.23.0/24","133.5.23.0/24")+ ]+ findMatch "133.4.0.0/16" rt @?= [("133.4.0.0/16", "133.4.0.0/16")]+ findMatch "133.4.0.0/15" rt @?= [+ ("133.4.0.0/16","133.4.0.0/16")+ , ("133.5.0.0/16","133.5.0.0/16")+ , ("133.5.16.0/24","133.5.16.0/24")+ , ("133.5.23.0/24","133.5.23.0/24")+ ]+ findMatch "0.0.0.0/0" rt @?= [+ ("0.0.0.0/0", "0.0.0.0/0")+ , ("133.4.0.0/16", "133.4.0.0/16")+ , ("133.5.0.0/16", "133.5.0.0/16")+ , ("133.5.16.0/24", "133.5.16.0/24")+ , ("133.5.23.0/24", "133.5.23.0/24")+ ]+ where+ pairs = zip ipv4_list ipv4_list++----------------------------------------------------------------
− test/Tests.hs
@@ -1,396 +0,0 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}--module Tests where------------------------------------------------------------------------ Tests for IP.RouteTable------ runghc -i.. Tests.hs-----import Control.Monad-import Data.IP-import Data.IP.RouteTable.Internal-import Data.List (sort, nub)-import Prelude hiding (lookup)-import Test.Framework (defaultMain, testGroup, Test)-import Test.Framework.Providers.HUnit-import Test.Framework.Providers.QuickCheck2-import Test.HUnit hiding (Test)-import Test.QuickCheck--tests :: [Test]-tests = [ testGroup "Property Test" [- testProperty "Sort IPv4" prop_sort_ipv4- , testProperty "Sort IPv6" prop_sort_ipv6- , testProperty "FromTo IPv4" prop_fromto_ipv4- , testProperty "FromTo IPv6" prop_fromto_ipv6- , testProperty "Insert lookup IPv4" prop_insert_lookup_ipv4- , testProperty "Insert lookup IPv6" prop_insert_lookup_ipv6- , testProperty "Search IPv4" prop_search_ipv4- , testProperty "Search IPv6" prop_search_ipv6- , testProperty "Ord IPv4" prop_ord_ipv4- , testProperty "Ord IPv6" prop_ord_ipv6- , testProperty "Delete IPv4" prop_delete_ipv4- , testProperty "Delete IPv6" prop_delete_ipv6- , testProperty "Insert delete IPv4" prop_insert_delete_ipv4- , testProperty "Insert delete IPv6" prop_insert_delete_ipv6- , testProperty "Delete insert IPv4" prop_delete_insert_ipv4- , testProperty "Delete insert IPv6" prop_delete_insert_ipv6- , testProperty "Delete lookup IPv4" prop_delete_lookup_ipv4- , testProperty "Delete lookup IPv6" prop_delete_lookup_ipv6- , testProperty "Convert fromto [Int] IPv4" prop_convert_ipv4- , testProperty "Convert fromto [Int] IPv6" prop_convert_ipv6- ]- , testGroup "Test case for routing table" [- testCase "fromto IPv4" test_fromto_ipv4- , testCase "lookup IPv4" test_lookup_ipv4- , testCase "lookup2 IPv4" test_lookup_ipv4_2- , testCase "findMatch IPv4" test_findMatch_ipv4- ]- , testGroup "Test case for IP" [- testCase "toIPv4" test_toIPv4- , testCase "toIPv6" test_toIPv6- , testCase "read IP" test_read_IP- , testCase "read IP 2" test_read_IP_2- , testCase "read IPv4" test_read_IPv4- , testCase "read IPv6" test_read_IPv6- , testCase "read IPv6 2" test_read_IPv6_2- , testCase "read IP range" test_read_IP_range- , testCase "read IP range 2" test_read_IP_range_2- , testCase "read IPv6 range" test_read_IPv6_range- , testCase "read IPv6 range" test_read_IPv6_range- , testCase "makeAddrRange IPv4" test_makeAddrRange_IPv4- , testCase "makeAddrRange IPv6" test_makeAddrRange_IPv6- , testCase "contains IPv4" test_contains_IPv4- , testCase "contains IPv4 2" test_contains_IPv4_2- , testCase "contains IPv6" test_contains_IPv6- , testCase "contains IPv6 2" test_contains_IPv6_2- , testCase "isMatchedTo IPv4" test_isMatchedTo_IPv4- , testCase "isMatchedTo IPv4 2" test_isMatchedTo_IPv4_2- , testCase "isMatchedTo IPv6" test_isMatchedTo_IPv6- , testCase "isMatchedTo IPv6 2" test_isMatchedTo_IPv6_2- ]- ]--main :: IO ()-main = defaultMain tests------------------------------------------------------------------------ Arbitrary-----instance Arbitrary (AddrRange IPv4) where- arbitrary = arbitraryIP arbitrary 32--instance Arbitrary (AddrRange IPv6) where- arbitrary = arbitraryIP arbitrary 128--instance Arbitrary IPv4 where- arbitrary = arbitraryAdr toIPv4 255 4--instance Arbitrary IPv6 where- arbitrary = arbitraryAdr toIPv6 65535 8--arbitraryAdr :: Routable a => ([Int] -> a) -> Int -> Int -> Gen a-arbitraryAdr func width adrlen = do- a <- replicateM adrlen (choose (0, width))- return $ func a--arbitraryIP :: Routable a => Gen a -> Int -> Gen (AddrRange a)-arbitraryIP adrGen msklen = do- adr <- adrGen- len <- choose (0,msklen)- return $ makeAddrRange adr len------------------------------------------------------------------------ Properties-----prop_sort_ipv4 :: [AddrRange IPv4] -> Bool-prop_sort_ipv4 = sort_ip--prop_sort_ipv6 :: [AddrRange IPv6] -> Bool-prop_sort_ipv6 = sort_ip--sort_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool-sort_ip xs = fromList (zip xs xs) == fromList (zip xs' xs')- where- xs' = sort xs--------------------------------------------------------------------prop_fromto_ipv4 :: [AddrRange IPv4] -> Bool-prop_fromto_ipv4 = fromto_ip--prop_fromto_ipv6 :: [AddrRange IPv6] -> Bool-prop_fromto_ipv6 = fromto_ip--fromto_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool-fromto_ip xs = nub (sort xs) == nub (sort ys)- where- ys = map fst . toList . fromList $ zip xs xs--------------------------------------------------------------------prop_ord_ipv4 :: [AddrRange IPv4] -> Bool-prop_ord_ipv4 = ord_ip--prop_ord_ipv6 :: [AddrRange IPv6] -> Bool-prop_ord_ipv6 = ord_ip--ord_ip :: Routable a => [AddrRange a] -> Bool-ord_ip xs = isOrdered . fromList $ zip xs xs--isOrdered :: Routable k => IPRTable k a -> Bool-isOrdered = foldt (\x v -> v && ordered x) True--ordered :: Routable k => IPRTable k a -> Bool-ordered Nil = True-ordered (Node k _ _ l r) = ordered' k l && ordered' k r- where- ordered' _ Nil = True- ordered' k1 (Node k2 _ _ _ _) = k1 >:> k2--------------------------------------------------------------------prop_insert_lookup_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Bool-prop_insert_lookup_ipv4 = insert_lookup_ip--prop_insert_lookup_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Bool-prop_insert_lookup_ipv6 = insert_lookup_ip--insert_lookup_ip :: Routable a => AddrRange a -> [AddrRange a] -> Bool-insert_lookup_ip k xs = lookup k (insert k k t) == Just k- where- rs = zip xs xs- t = fromList rs--prop_search_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Bool-prop_search_ipv4 = search_ip--prop_search_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Bool-prop_search_ipv6 = search_ip--search_ip :: Routable a => AddrRange a -> [AddrRange a] -> Bool-search_ip k xs = lookup k (fromList (zip xs xs)) == linear k xs--linear :: Routable a => AddrRange a -> [AddrRange a] -> Maybe (AddrRange a)-linear = linear' Nothing- where- linear' a _ [] = a- linear' Nothing k (x:xs)- | x >:> k = linear' (Just x) k xs- | otherwise = linear' Nothing k xs- linear' (Just a) k (x:xs)- | x >:> k = if mlen x > mlen a- then linear' (Just x) k xs- else linear' (Just a) k xs- | otherwise = linear' (Just a) k xs--------------------------------------------------------------------prop_delete_ipv4 :: [AddrRange IPv6] -> Property-prop_delete_ipv4 = delete_ip--prop_delete_ipv6 :: [AddrRange IPv6] -> Property-prop_delete_ipv6 = delete_ip--delete_ip :: Routable a => [AddrRange a] -> Property-delete_ip xs = xs /= [] ==> isOrdered (delete i t)- where- rs = zip xs xs- t = fromList rs- i = head xs--prop_insert_delete_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Property-prop_insert_delete_ipv4 = insert_delete_ip--prop_insert_delete_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Property-prop_insert_delete_ipv6 = insert_delete_ip--insert_delete_ip :: Routable a => AddrRange a -> [AddrRange a] -> Property-insert_delete_ip k xs = lookup k t == Nothing ==> delete k (insert k k t) == t- where- rs = zip xs xs- t = fromList rs--prop_delete_insert_ipv4 :: [AddrRange IPv4] -> Property-prop_delete_insert_ipv4 = delete_insert_ip--prop_delete_insert_ipv6 :: [AddrRange IPv6] -> Property-prop_delete_insert_ipv6 = delete_insert_ip--delete_insert_ip :: Routable a => [AddrRange a] -> Property-delete_insert_ip xs = xs /= [] ==> insert k k (delete k t) == t- where- rs = zip xs xs- t = fromList rs- k = head xs--prop_delete_lookup_ipv4 :: [AddrRange IPv4] -> Property-prop_delete_lookup_ipv4 = delete_lookup_ip--prop_delete_lookup_ipv6 :: [AddrRange IPv6] -> Property-prop_delete_lookup_ipv6 = delete_lookup_ip--delete_lookup_ip :: Routable a => [AddrRange a] -> Property-delete_lookup_ip xs = xs /= [] ==> case lookup k (delete k t) of- Nothing -> True- Just r -> r /= k && r >:> k- where- rs = zip xs xs- t = fromList rs- k = head xs--prop_convert_ipv4 :: IPv4 -> Property-prop_convert_ipv4 ip = True ==> (toIPv4 . fromIPv4) ip == ip--prop_convert_ipv6 :: IPv6 -> Property-prop_convert_ipv6 ip = True ==> (toIPv6 . fromIPv6) ip == ip--------------------------------------------------------------------test_toIPv4 :: Assertion-test_toIPv4 = show (toIPv4 [192,0,2,1]) @?= "192.0.2.1"--test_toIPv6 :: Assertion-test_toIPv6 = show (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) @?= "2001:db8:00:00:00:00:00:01"--test_read_IP :: Assertion-test_read_IP = (read "192.0.2.1" :: IP) @?= IPv4 (read "192.0.2.1" :: IPv4)--test_read_IP_2 :: Assertion-test_read_IP_2 = (read "2001:db8:00:00:00:00:00:01" :: IP) @?= IPv6 (read "2001:db8:00:00:00:00:00:01" :: IPv6)--test_read_IPv4 :: Assertion-test_read_IPv4 = show (read "192.0.2.1" :: IPv4) @?= "192.0.2.1"--test_read_IPv6 :: Assertion-test_read_IPv6 = show (read "2001:db8:00:00:00:00:00:01" :: IPv6) @?= "2001:db8:00:00:00:00:00:01"--test_read_IPv6_2 :: Assertion-test_read_IPv6_2 = show (read "2001:240:11e:c00::101" :: IPv6) @?= "2001:240:11e:c00:00:00:00:101"--test_read_IP_range :: Assertion-test_read_IP_range = (read "192.0.2.1/24" :: IPRange)- @?= IPv4Range (read "192.0.2.0/24" :: AddrRange IPv4)--test_read_IP_range_2 :: Assertion-test_read_IP_range_2 = (read "2001:db8:00:00:00:00:00:01/48" :: IPRange)- @?= IPv6Range (read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6)--test_read_IPv4_range :: Assertion-test_read_IPv4_range = show (read "192.0.2.1/24" :: AddrRange IPv4) @?= "192.0.2.0/24"--test_read_IPv6_range :: Assertion-test_read_IPv6_range = show (read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6) @?= "2001:db8:00:00:00:00:00:00/48"--------------------------------------------------------------------test_makeAddrRange_IPv4 :: Assertion-test_makeAddrRange_IPv4 = show (makeAddrRange (toIPv4 [127,0,2,1]) 8) @?= "127.0.0.0/8"--test_makeAddrRange_IPv6 :: Assertion-test_makeAddrRange_IPv6 = show (makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 8) @?= "2000:00:00:00:00:00:00:00/8"--------------------------------------------------------------------test_contains_IPv4 :: Assertion-test_contains_IPv4 = makeAddrRange (toIPv4 [127,0,2,1]) 8 >:> makeAddrRange (toIPv4 [127,0,2,1]) 24 @?= True--test_contains_IPv4_2 :: Assertion-test_contains_IPv4_2 = makeAddrRange (toIPv4 [127,0,2,1]) 24 >:> makeAddrRange (toIPv4 [127,0,2,1]) 8 @?= False--test_contains_IPv6 :: Assertion-test_contains_IPv6 = makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 16 >:> makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 32 @?= True--test_contains_IPv6_2 :: Assertion-test_contains_IPv6_2 = makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 32 >:> makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 16 @?= False--------------------------------------------------------------------test_isMatchedTo_IPv4 :: Assertion-test_isMatchedTo_IPv4 = toIPv4 [127,0,2,1] `isMatchedTo` makeAddrRange (toIPv4 [127,0,2,1]) 24 @?= True--test_isMatchedTo_IPv4_2 :: Assertion-test_isMatchedTo_IPv4_2 = toIPv4 [127,0,2,0] `isMatchedTo` makeAddrRange (toIPv4 [127,0,2,1]) 32 @?= False--test_isMatchedTo_IPv6 :: Assertion-test_isMatchedTo_IPv6 = toIPv6 [0x2001,0xDB8,0,0,0,0,0,1] `isMatchedTo` makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 32 @?= True--test_isMatchedTo_IPv6_2 :: Assertion-test_isMatchedTo_IPv6_2 = toIPv6 [0x2001,0xDB8,0,0,0,0,0,0] `isMatchedTo` makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 128 @?= False--------------------------------------------------------------------ipv4_list :: [AddrRange IPv4]-ipv4_list = [- "0.0.0.0/0"- , "133.4.0.0/16"- , "133.5.0.0/16"- , "133.5.16.0/24"- , "133.5.23.0/24"- ]--test_fromto_ipv4 :: Assertion-test_fromto_ipv4 = (sort . toList . fromList $ pairs) @?= pairs- where- pairs = sort $ zip ipv4_list ipv4_list--test_lookup_ipv4 :: Assertion-test_lookup_ipv4 = do- let rt = fromList pairs- lookup "127.0.0.1" rt @?= Just "0.0.0.0/0"- lookup "133.3.0.1" rt @?= Just "0.0.0.0/0"- lookup "133.4.0.0" rt @?= Just "133.4.0.0/16"- lookup "133.4.0.1" rt @?= Just "133.4.0.0/16"- lookup "133.5.16.0" rt @?= Just "133.5.16.0/24"- lookup "133.5.16.1" rt @?= Just "133.5.16.0/24"- where- pairs = zip ipv4_list ipv4_list--test_lookup_ipv4_2 :: Assertion-test_lookup_ipv4_2 = do- let rt = fromList pairs- lookup "127.0.0.1" rt @?= Nothing- lookup "133.3.0.1" rt @?= Nothing- lookup "133.4.0.0" rt @?= Just "133.4.0.0/16"- lookup "133.4.0.1" rt @?= Just "133.4.0.0/16"- lookup "133.5.16.0" rt @?= Just "133.5.16.0/24"- lookup "133.5.16.1" rt @?= Just "133.5.16.0/24"- where- ipv4_list' = tail ipv4_list- pairs = zip ipv4_list' ipv4_list'--test_findMatch_ipv4 :: Assertion-test_findMatch_ipv4 = do- let rt = fromList pairs- findMatch "127.0.0.1" rt @?= []- findMatch "133.5.23.0/23" rt @?= [("133.5.23.0/24","133.5.23.0/24")]- findMatch "133.5.0.0/16" rt @?= [- ("133.5.0.0/16","133.5.0.0/16")- , ("133.5.16.0/24","133.5.16.0/24")- , ("133.5.23.0/24","133.5.23.0/24")- ]- findMatch "133.4.0.0/16" rt @?= [("133.4.0.0/16", "133.4.0.0/16")]- findMatch "133.4.0.0/15" rt @?= [- ("133.4.0.0/16","133.4.0.0/16")- , ("133.5.0.0/16","133.5.0.0/16")- , ("133.5.16.0/24","133.5.16.0/24")- , ("133.5.23.0/24","133.5.23.0/24")- ]- findMatch "0.0.0.0/0" rt @?= [- ("0.0.0.0/0", "0.0.0.0/0")- , ("133.4.0.0/16", "133.4.0.0/16")- , ("133.5.0.0/16", "133.5.0.0/16")- , ("133.5.16.0/24", "133.5.16.0/24")- , ("133.5.23.0/24", "133.5.23.0/24")- ]- where- pairs = zip ipv4_list ipv4_list------------------------------------------------------------------