iproute (empty) → 0.1
raw patch · 9 files changed
+747/−0 lines, 9 filesdep +basedep +containersdep +parsecsetup-changed
Dependencies added: base, containers, parsec
Files
- Data/IP.hs +385/−0
- Data/IP/RouteTable.hs +11/−0
- Data/IP/RouteTable/Internal.hs +124/−0
- LICENSE +29/−0
- Setup.hs +2/−0
- iproute.cabal +26/−0
- test/IPv4Search.hs +39/−0
- test/Makefile +7/−0
- test/Tests.hs +124/−0
+ Data/IP.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE FlexibleInstances #-}+{-|+ Data structures to express IPv4, IPv6 and IP range.+-}+module Data.IP (IP(..), IPv4, IPv6, toIPv4, toIPv6, IPRange, addr, mask, mlen, (>:>), makeIPRange) where++import Control.Monad+import Data.Bits+import Data.Char+import Data.Char+import Data.IntMap hiding (map)+import Data.List (foldl')+import Data.Word+import Text.ParserCombinators.Parsec+import Text.Printf++----------------------------------------------------------------+--+-- Data definitions+--++-- This is host byte order+type IPv4Addr = Word32+type IPv6Addr = (Word32,Word32,Word32,Word32)++{-|+ The abstract data structure to express an IPv4 address.+ To create this, use 'toIPv4'. Or use 'read' @\"192.0.2.1\"@ :: 'IPv4', for example.+-}+newtype IPv4 = IPv4 IPv4Addr deriving (Eq, Ord)+{-|+ The abstract data structure to express an IPv6 address.+ To create this, use 'toIPv6'. Or use 'read' @\"2001:DB8::1\"@ :: 'IPv6', for example.+-}+newtype IPv6 = IPv6 IPv6Addr deriving (Eq, Ord)++{-|+ The IP range consists of an 'IP' address, a contiguous 'IP' mask,+ and mask length. The contiguous 'IP' mask and the mask length+ are essentially same information but contained for pre+ calculation.++ To create this, use 'makeIPRange' or 'read' \"192.0.2.0/24\" :: 'IPRange' 'IPv4', for example.+-}+data (IP a) => IPRange a =+ IPRange {+ -- |The 'addr' function returns an 'IP' address from 'IPRange'.+ addr :: a+ -- |The 'mask' function returns a contiguous 'IP' mask from 'IPRange'.+ , mask :: a+ -- |The 'mlen' function returns a mask length from 'IPRange'.+ , mlen :: Int+ } deriving (Eq, Ord)++----------------------------------------------------------------+--+-- Exported functions+--++{-|+ The >:> operator takes two 'IPRange'. It returns 'True' if+ the first 'IPRange' contains the second 'IPRange'. Otherwise,+ it returns 'False'.+-}+(>:>) :: IP a => IPRange a -> IPRange a -> Bool+a >:> b = mlen a <= mlen b && (addr b `masked` mask a) == addr a++{-|+ The 'makeIPRange' functions takes an 'IP' address and a mask+ length. It creates a bit mask from the mask length and masks+ the 'IP' address, then returns 'IPRange' made of them.+-}+makeIPRange :: IP a => a -> Int -> IPRange a+makeIPRange ad len = let msk = intToMask len+ adr = ad `masked` msk+ in IPRange adr msk len++----------------------------------------------------------------+--+-- IP Class+--++{-|+ A class to contain IPv4 and IPv6.+-}+class Eq a => IP a where+ {-|+ The 'masked' function takes an 'IP' address and a contiguous+ 'IP' mask and returned a masked 'IP' address.+ -}+ masked :: a -> a -> a+ {-|+ The 'intToMask' function takes 'Int' and returns a contiguous+ 'IP' mask.+ -}+ intToMask :: Int -> a+ {-|+ The 'intToTBit' function takes 'Int' and returns an 'IP' address+ whose only n-th bit is set.+ -}+ intToTBit :: Int -> a+ {-|+ The 'isZero' function takes an 'IP' address and an test bit 'IP'+ address and returns 'True' is the bit is unset, otherwise+ returns 'False'.+ -}+ isZero :: a -> a -> Bool++instance IP IPv4 where+ IPv4 a `masked` IPv4 m = IPv4 (a .&. m)+ intToMask = maskIPv4+ intToTBit = intToTBitIPv4+ isZero a b = a `masked` b == IPv4 0++instance IP IPv6 where+ IPv6 (a1,a2,a3,a4) `masked` IPv6 (m1,m2,m3,m4) =+ IPv6 (a1.&.m1,a2.&.m2,a3.&.m3,a4.&.m4)+ intToMask = maskIPv6+ intToTBit = intToTBitIPv6+ isZero a b = a `masked` b == IPv6 (0,0,0,0)++----------------------------------------------------------------+--+-- Show for IP+--++instance Show IPv4 where+ show = showIPv4++instance Show IPv6 where+ show = showIPv6++showIPv4 :: IPv4 -> String+showIPv4 (IPv4 a) = show4 a+ where+ remQuo x = (x `mod` 256, x `div` 256)+ show4 q = let (a4,q4) = remQuo q+ (a3,q3) = remQuo q4+ (a2,q2) = remQuo q3+ (a1, _) = remQuo q2+ in printf "%d.%d.%d.%d" a1 a2 a3 a4++showIPv6 :: IPv6 -> String+showIPv6 (IPv6 (a1,a2,a3,a4)) = show6 a1 ++ ":" ++ show6 a2 ++ ":" ++ show6 a3 ++ ":" ++ show6 a4+ where+ remQuo x = (x `mod` 65536, x `div` 65536)+ show6 q = let (r2,q2) = remQuo q+ (r1, _) = remQuo q2+ in printf "%02x:%02x" r1 r2++----------------------------------------------------------------+--+-- Show for IPRange+--++instance (IP a, Show a) => Show (IPRange a) where+ show x = show (addr x) ++ "/" ++ show (mlen x)++----------------------------------------------------------------+--+-- Mask+--++maskIPv4 :: Int -> IPv4+maskIPv4 len = IPv4 (masksIPv4 ! len)++maskIPv6 :: Int -> IPv6+maskIPv6 len = IPv6 (masksIPv6 ! len)++masksWord32 :: [Word32]+masksWord32 = take 33 $ iterate (flip shift 1) 0xffffffff++masksIPv4 :: IntMap IPv4Addr+masksIPv4 = fromList $ zip [32,31..0] masksWord32++masksIPv6 :: IntMap IPv6Addr+masksIPv6 = fromList $ zip [128,127..0] ms+ where+ ms = m0 ++ m1 ++ m2 ++ m3 ++ m4+ m0 = [(all1,all1,all1,all1)]+ m1 = map (\vmsk -> (all1,all1,all1,vmsk)) masks+ m2 = map (\vmsk -> (all1,all1,vmsk,all0)) masks+ m3 = map (\vmsk -> (all1,vmsk,all0,all0)) masks+ m4 = map (\vmsk -> (vmsk,all0,all0,all0)) masks+ masks = tail masksWord32+ all1 = 0xffffffff+ all0 = 0x00000000++----------------------------------------------------------------+--+-- Test Bit+--++intToTBitIPv4 :: Int -> IPv4+intToTBitIPv4 len = IPv4 (intToTBitsIPv4 ! len)++intToTBitIPv6 :: Int -> IPv6+intToTBitIPv6 len = IPv6 (intToTBitsIPv6 ! len)++intToTBitsWord32 :: [Word32]+intToTBitsWord32 = iterate (flip shift (-1)) 0x80000000++intToTBitsIPv4 :: IntMap IPv4Addr+intToTBitsIPv4 = fromList $ zip [0..32] intToTBitsWord32++intToTBitsIPv6 :: IntMap IPv6Addr+intToTBitsIPv6 = fromList $ zip [0..128] bs+ where+ bs = b1 ++ b2 ++ b3 ++ b4 ++ b5+ b1 = map (\vbit -> (vbit,all0,all0,all0)) intToTBits+ b2 = map (\vbit -> (all0,vbit,all0,all0)) intToTBits+ b3 = map (\vbit -> (all0,all0,vbit,all0)) intToTBits+ b4 = map (\vbit -> (all0,all0,all0,vbit)) intToTBits+ b5 = [(all0,all0,all0,all0)]+ intToTBits = take 32 $ intToTBitsWord32+ all0 = 0x00000000++----------------------------------------------------------------+--+-- Read for IP+--++instance Read IPv4 where+ readsPrec _ = parseIPv4++instance Read IPv6 where+ readsPrec _ = parseIPv6++parseIPv4 :: String -> [(IPv4,String)]+parseIPv4 cs = case parse (adopt ipv4) "parseIPv4" cs of+ Right a4 -> a4+ Left _ -> error "parseIPv4"++parseIPv6 :: String -> [(IPv6,String)]+parseIPv6 cs = case parse (adopt ipv6) "parseIPv6" cs of+ Right a6 -> a6+ Left _ -> error "parseIPv6"++----------------------------------------------------------------+--+-- Read for IPRange+--++instance Read (IPRange IPv4) where+ readsPrec _ = parseIPv4Range++instance Read (IPRange IPv6) where+ readsPrec _ = parseIPv6Range++parseIPv4Range :: String -> [(IPRange IPv4,String)]+parseIPv4Range cs = case parse (adopt ipv4range) "parseIPv4" cs of+ Right r4 -> r4+ Left _ -> error "parseIPv4"++parseIPv6Range :: String -> [(IPRange IPv6,String)]+parseIPv6Range cs = case parse (adopt ipv6range) "parseIPv6" cs of+ Right r6 -> r6+ Left _ -> error "parseIPv6"++----------------------------------------------------------------+--+-- Adopter for Read+--++adopt :: Parser a -> Parser [(a,String)]+adopt p = do x <- p+ rest <- getInput+ return [(x, rest)]++----------------------------------------------------------------+--+-- IPv4 Parser+--++dig :: Parser Int+dig = do { char '0'; return 0 } <|>+ do n <- oneOf ['1'..'9']+ ns <- many digit+ let ms = map digitToInt (n:ns)+ ret = foldl' (\x y -> x * 10 + y) 0 ms+ return ret++ipv4 :: Parser IPv4+ipv4 = do+ as <- dig `sepBy1` (char '.')+ check as+ return $ toIPv4 as+ where+ test errmsg adr = when (adr < 0 || 255 < adr) (unexpected errmsg)+ check as = do let errmsg = "IPv4 adddress"+ when (length as /= 4) (unexpected errmsg)+ mapM_ (test errmsg) as++ipv4range :: Parser (IPRange IPv4)+ipv4range = do+ ip <- ipv4+ len <- option 32 $ do { char '/'; dig }+ check len+ return $ IPRange ip (maskIPv4 len) len+ where+ check len = when (len < 0 || 32 < len) (unexpected "IPv4 mask length")++----------------------------------------------------------------+--+-- IPv6 Parser (RFC 4291)+--++hex :: Parser Int+hex = do ns <- many1 hexDigit+ check ns+ let ms = map digitToInt ns+ val = foldl' (\x y -> x * 16 + y) 0 ms+ return val+ where+ check ns = when (length ns > 4) (unexpected "IPv6 address -- more than 4 hex")++ipv6 :: Parser IPv6+ipv6 = do+ as <- ipv6'+ return $ toIPv6 as++ipv6range :: Parser (IPRange IPv6)+ipv6range = do+ ip <- ipv6+ len <- option 128 $ do { char '/'; dig }+ check len+ return $ IPRange ip (maskIPv6 len) len+ where+ check len = when (len < 0 || 128 < len) (unexpected ("IPv6 mask length: " ++ show len))++ipv6' :: Parser [Int]+ipv6' = do colon2+ bs <- option [] hexcolon+ rs <- format [] bs+ return rs+ <|> try (do rs <- hexcolon+ check rs+ return rs)+ <|> do bs1 <- hexcolon2+ bs2 <- option [] hexcolon+ rs <- format bs1 bs2+ return rs+ where+ colon2 = string "::"+ hexcolon = do bs <- hex `sepBy1` (char ':')+ return bs+ hexcolon2 = do bs <- manyTill (do{ b <- hex; char ':'; return b }) (char ':')+ return bs+ format bs1 bs2 = do let len1 = length bs1+ len2 = length bs2+ when (len1 > 7) (unexpected "IPv6 address")+ when (len2 > 7) (unexpected "IPv6 address")+ let len = 8 - len1 - len2+ when (len <= 0) (unexpected "IPv6 address")+ let spring = take len $ repeat 0+ return $ bs1 ++ spring ++ bs2+ check bs = when (length bs /= 8) (unexpected "IPv6 address")++----------------------------------------------------------------+--+-- IntToIP+--++{-|+ The 'toIPv4' function takes a list of 'Int' and returns 'IPv4'.+ For example, 'toIPv4' @[192,0,2,1]@.+-}+toIPv4 :: [Int] -> IPv4+toIPv4 = IPv4 . toWord32+ where+ toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4+ toWord32 _ = error "toWord32"++{-|+ The 'toIPv6' function takes a list of 'Int' and returns 'IPv6'.+ For example, 'toIPv6' @[0x2001,0xDB8,0,0,0,0,0,1]@.+-}+toIPv6 :: [Int] -> IPv6+toIPv6 ad = let [x1,x2,x3,x4] = map toWord32 $ split2 ad+ in IPv6 (x1,x2,x3,x4)+ where+ split2 [] = []+ split2 x = take 2 x : split2 (drop 2 x)+ toWord32 [a1,a2] = fromIntegral $ shift a1 16 + a2+ toWord32 _ = error "toWord32"
+ Data/IP/RouteTable.hs view
@@ -0,0 +1,11 @@+{-|+ IP routing table is a tree of 'IPRange'+ to search one of them on the longest+ match base. It is a kind of TRIE with one+ way branching removed. Both IPv4 and IPv6+ are supported.+-}+module Data.IP.RouteTable (IPRTable, empty, insert, lookup, fromList, toList) where++import Prelude hiding (lookup)+import Data.IP.RouteTable.Internal
+ Data/IP/RouteTable/Internal.hs view
@@ -0,0 +1,124 @@+{-|+ IP routing table is a tree of 'IPRange'+ to search one of them on the longest+ match base. It is a kind of TRIE with one+ way branching removed. Both IPv4 and IPv6+ are supported.+-}+module Data.IP.RouteTable.Internal where++import Data.IP+import Data.List (foldl')+import Prelude hiding (lookup)++{-|+ The Tree structure for IP routing table based on TRIE with+ one way branching removed. This is an abstracted data structure,+ so you cannot touch its inside. Please use 'insert' or 'lookup', instead.+-}+data IPRTable k a = Nil | Node (Entry k a) (IPRTable k a) (IPRTable k a) deriving (Eq, Show)++data (IP k) => Entry k a = Entry (IPRange k) k (Maybe a) deriving (Eq, Show)++----------------------------------------------------------------++{-|+ The 'empty' function returns an empty IP routing table.+-}+empty :: IP k => IPRTable k a+empty = Nil++----------------------------------------------------------------++newEntry :: (IP k) => IPRange k -> Maybe a -> Entry k a+newEntry k v = Entry k (intToTBit (mlen k)) v++{-|+ The 'insert' function inserts a value with a key of 'IPRange' to 'IPRTable'+ and returns a new 'IPRTable'.+-}+insert :: (IP k) => IPRange k -> a -> IPRTable k a -> IPRTable k a+insert k v s = inject (newEntry k (Just v)) s++inject :: (IP k) => Entry k a -> IPRTable k a -> IPRTable k a+inject e Nil = Node e Nil Nil+inject e1@(Entry k1 _ _) s@(Node e2@(Entry k2 _ _) l r)+ | k1 == k2 = Node e1 l r+ | k2 >:> k1 = if isLeft k1 e2+ then Node e2 (inject e1 l) r+ else Node e2 l (inject e1 r)+ | k1 >:> k2 = if isLeft k2 e1+ then Node e1 s Nil+ else Node e1 Nil s+ | otherwise = let n = Node e1 Nil Nil+ in glue n s++glue :: IP k => IPRTable k a -> IPRTable k a -> IPRTable k a+glue s1@(Node (Entry k1 _ _) _ _) s2@(Node (Entry k2 _ _) _ _) =+ let kg = makeGlueRange 0 k1 k2+ eg = newEntry kg Nothing+ in if isLeft k1 eg+ then Node eg s1 s2+ else Node eg s2 s1+glue _ _ = error "glue"++makeGlueRange :: (IP k) => Int -> IPRange k -> IPRange k -> IPRange k+makeGlueRange n k1 k2+ | addr k1 `masked` mk == addr k2 `masked` mk = makeGlueRange (n + 1) k1 k2++ | otherwise = makeIPRange (addr k1) (n - 1)+ where+ mk = intToMask n++isLeft :: IP k => IPRange k -> Entry k a -> Bool+isLeft adr (Entry _ tb _) = isZero (addr adr) tb++----------------------------------------------------------------++{-|+ The 'lookup' function looks up 'IPRTable' with a key of 'IPRange'+ and returns its value if exists.+-}+lookup :: IP k => IPRange k -> IPRTable k a -> Maybe a+lookup k s = search k s Nothing++search :: IP k => IPRange k -> IPRTable k a -> Maybe a -> Maybe a+search _ Nil res = res+search k1 (Node e2@(Entry k2 _ Nothing) l r) res+ | k1 == k2 = res+ | k2 >:> k1 = if isLeft k1 e2+ then search k1 l res+ else search k1 r res+ | otherwise = res+search k1 (Node e2@(Entry k2 _ vl) l r) res+ | k1 == k2 = vl+ | k2 >:> k1 = if isLeft k1 e2+ then search k1 l vl+ else search k1 r vl+ | otherwise = res++----------------------------------------------------------------++{-|+ The 'fromList' function creates a new IP routing table from+ a list of a pair of 'IPrange' and value.+-}+fromList :: IP k => [(IPRange k, a)] -> IPRTable k a+fromList = foldl' (\s (k,v) -> insert k v s) empty++{-|+ The 'toList' function creates a list of a pair of 'IPrange' and+ value from an IP routing table.+-}+toList :: IP k => IPRTable k a -> [(IPRange k, a)]+toList = foldt toL []+ where+ toL Nil xs = xs+ toL (Node (Entry _ _ Nothing) _ _) xs = xs+ toL (Node (Entry k _ (Just a)) _ _) xs = (k,a) : xs++----------------------------------------------------------------++foldt :: (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b+foldt _ v Nil = v+foldt func v rt@(Node _ l r) = foldt func (foldt func (func rt v) l) r
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution.+ * Neither the name of the copyright holders nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ iproute.cabal view
@@ -0,0 +1,26 @@+Name: iproute+Version: 0.1+Author: Kazu Yamamoto <kazu@Mew.org>+Maintainer: Kazu Yamamoto <kazu@Mew.org>+License: BSD3+License-File: LICENSE+Homepage: http://www.mew.org/~kazu/proj/iproute/+Synopsis: IP Routing Table+Description: IP Routing Table is a tree of IP ranges+ to search one of them on the longest+ match base. It is a kind of TRIE with one+ way branching removed. Both IPv4 and IPv6+ are supported.+Category: Algorithms+Cabal-Version: >= 1.2+Build-Type: Simple +Extra-Source-Files: test/Tests.hs test/IPv4Search.hs test/Makefile+library+ GHC-Options: -Wall+ Exposed-Modules: Data.IP+ Data.IP.RouteTable+ Other-Modules: Data.IP.RouteTable.Internal+ Build-Depends: base >= 2.0 && < 4,+ parsec >= 2.0,+ containers >= 0.2+
+ test/IPv4Search.hs view
@@ -0,0 +1,39 @@+module Main where++import Control.Exception+import Data.IP+import Data.IP.RouteTable+import Prelude hiding (lookup, catch)+import System.Environment++main :: IO ()+main = flip catch handler $ do+ as <- getArgs+ let file = as !! 0+ ip = as !! 1+ range = ip ++ "/32"+ target = readIPv4Range range+ rt <- loadRoutes file+ let res = lookup target rt+ putStrLn $ show res+ where+ handler :: ErrorCall -> IO ()+ handler _ = help++loadRoutes :: FilePath -> IO (IPRTable IPv4 (IPRange IPv4))+loadRoutes file = do+ cs <- readFile file+ let ls = lines cs+ rs = map readIPv4Range ls+ kvs = zip rs rs -- value is IPRange itself in this test+ radish = fromList kvs+ return radish++readIPv4Range :: String -> IPRange IPv4+readIPv4Range = read++help :: IO ()+help = do+ putStrLn "Usage:"+ putStrLn " ipv4_search file IPv4"+
+ test/Makefile view
@@ -0,0 +1,7 @@+PROG = ipv4_search++all:+ ghc -Wall -i.. --make -o $(PROG) IPv4Search.hs++clean:+ rm -f *.hi *.o $(PROG)
+ test/Tests.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleInstances #-}+----------------------------------------------------------------+-- +-- Tests for IP.RouteTable+-- +-- runghc -i.. Tests.hs+--++import Data.IP+import Data.IP.RouteTable.Internal+import Test.QuickCheck hiding (check, test)+import Test.QuickCheck.Batch+import Prelude hiding (lookup)+import Data.List (sort, nub)++options :: TestOptions+options = TestOptions { no_of_tests = 300+ , length_of_tests = 0+ , debug_tests = False+ }++main :: IO ()+main = do+ runTests "base" options [ run prop_sort_ipv4+ , run prop_sort_ipv6+ , run prop_fromto_ipv4+ , run prop_fromto_ipv6+ , run prop_search_ipv4+ , run prop_search_ipv6+ , run prop_ord_ipv4+ , run prop_ord_ipv6+ ]++----------------------------------------------------------------+--+-- Arbitrary+--++instance Arbitrary (IPRange IPv4) where+ arbitrary = arbitraryIP toIPv4 255 4 32+ coarbitrary = undefined++instance Arbitrary (IPRange IPv6) where+ arbitrary = arbitraryIP toIPv6 65535 8 128+ coarbitrary = error "coarbitrary"++arbitraryIP :: IP a => ([Int] -> a) -> Int -> Int -> Int -> Gen (IPRange a)+arbitraryIP func width adrlen msklen = do+ a <- sequence $ take adrlen $ repeat (choose (0,width))+ let adr = func a+ len <- choose (0,msklen)+ return $ makeIPRange adr len++----------------------------------------------------------------+--+-- Properties+--++prop_sort_ipv4 :: [IPRange IPv4] -> Bool+prop_sort_ipv4 = sort_ip++prop_sort_ipv6 :: [IPRange IPv6] -> Bool+prop_sort_ipv6 = sort_ip++sort_ip :: (IP a, Ord a) => [IPRange a] -> Bool+sort_ip xs = fromList (zip xs xs) == let xs' = sort xs+ in fromList (zip xs' xs')++----------------------------------------------------------------++prop_fromto_ipv4 :: [IPRange IPv4] -> Bool+prop_fromto_ipv4 = fromto_ip++prop_fromto_ipv6 :: [IPRange IPv6] -> Bool+prop_fromto_ipv6 = fromto_ip++fromto_ip :: (IP a, Ord a) => [IPRange a] -> Bool+fromto_ip xs = let ys = map fst $ toList $ fromList (zip xs xs)+ in nub (sort xs) == nub (sort ys)++----------------------------------------------------------------++prop_ord_ipv4 :: [IPRange IPv4] -> Bool+prop_ord_ipv4 = ord_ip++prop_ord_ipv6 :: [IPRange IPv6] -> Bool+prop_ord_ipv6 = ord_ip++ord_ip :: IP a => [IPRange a] -> Bool+ord_ip xs = isOrdered (fromList (zip xs xs))++isOrdered :: IP k => IPRTable k a -> Bool+isOrdered = foldt (\x v -> v && ordered x) True++ordered :: IP k => IPRTable k a -> Bool+ordered Nil = True+ordered (Node n l r) = ordered' n l && ordered' n r+ where+ ordered' _ Nil = True+ ordered' (Entry k1 _ _) (Node (Entry k2 _ _) _ _) = k1 >:> k2++----------------------------------------------------------------++prop_search_ipv4 :: IPRange IPv4 -> [IPRange IPv4] -> Bool+prop_search_ipv4 = search_ip++prop_search_ipv6 :: IPRange IPv6 -> [IPRange IPv6] -> Bool+prop_search_ipv6 = search_ip++search_ip :: IP a => IPRange a -> [IPRange a] -> Bool+search_ip k xs = lookup k (fromList (zip xs xs)) == linear k xs++linear :: IP a => IPRange a -> [IPRange a] -> Maybe (IPRange 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