iproute 0.1 → 1.0.0

raw patch · 12 files changed

+716/−499 lines, 12 filesdep +appardep −parsecdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: appar

Dependencies removed: parsec

Dependency ranges changed: base, containers

API changes (from Hackage documentation)

Files

• Data/IP.hs +16/−381
• Data/IP/Addr.hs +183/−0
• Data/IP/Mask.hs +33/−0
• Data/IP/Op.hs +58/−0
• Data/IP/Range.hs +97/−0
• Data/IP/RouteTable.hs +14/−2
• Data/IP/RouteTable/Internal.hs +117/−53
• LICENSE +2/−2
• iproute.cabal +19/−11
• test/IPv4Search.hs +4/−4
• test/Makefile +1/−1
• test/Tests.hs +172/−45

@@ -1,385 +1,20 @@-{-# 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"+module Data.IP (+  -- * Documentation+  -- ** IP data+    IP (..)+  , IPv4, toIPv4+  , IPv6, toIPv6+  -- ** IP range data+  , IPRange (..)+  , AddrRange (addr, mask, mlen)+  -- ** Address class+  , Addr (..)+  , makeAddrRange, (>:>), isMatchedTo+  ) where -{-|-  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"+import Data.IP.Addr+import Data.IP.Op+import Data.IP.Range

@@ -0,0 +1,183 @@+module Data.IP.Addr where++import Control.Monad+import Control.Applicative+import Data.Bits+import Data.Char+import Data.List (foldl')+import Data.Word+import Text.Appar.String+import Text.Printf++----------------------------------------------------------------++{-|+  A unified IP data for 'IPv4' and 'IPv6'.+-}++data IP = IPv4 { ipv4 :: IPv4 }+        | IPv6 { ipv6 :: IPv6 }+        deriving (Eq)++instance Show IP where+    show (IPv4 ip) = show ip+    show (IPv6 ip) = show ip++----------------------------------------------------------------++-- 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 = IP4 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 = IP6 IPv6Addr deriving (Eq, Ord)++----------------------------------------------------------------+--+-- Show+--++instance Show IPv4 where+    show = showIPv4++instance Show IPv6 where+    show = showIPv6++showIPv4 :: IPv4 -> String+showIPv4 (IP4 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 (IP6 (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++----------------------------------------------------------------+--+-- IntToIP+--++{-|+  The 'toIPv4' function takes a list of 'Int' and returns 'IPv4'.+  For example, 'toIPv4' @[192,0,2,1]@.+-}+toIPv4 :: [Int] -> IPv4+toIPv4 = IP4 . 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 IP6 (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"++----------------------------------------------------------------+--+-- Read+--++instance Read IPv4 where+    readsPrec _ = parseIPv4++instance Read IPv6 where+    readsPrec _ = parseIPv6++parseIPv4 :: String -> [(IPv4,String)]+parseIPv4 cs = case runParser ip4 cs of+    (Nothing,_)    -> error $ "parseIPv4 " ++ cs+    (Just a4,rest) -> [(a4,rest)]++parseIPv6 :: String -> [(IPv6,String)]+parseIPv6 cs = case runParser ip6 cs of+    (Nothing,_)    -> error $ "parseIPv6 " ++ cs+    (Just a6,rest) -> [(a6,rest)]++----------------------------------------------------------------+--+-- IPv4 Parser+--++dig :: Parser Int+dig = 0 <$ char '0'+  <|> toInt <$> oneOf ['1'..'9'] <*> many digit+  where+    toInt n ns = foldl' (\x y -> x * 10 + y) 0 . map digitToInt $ n : ns++ip4 :: Parser IPv4+ip4 = do+    as <- dig `sepBy1` char '.'+    check as+    return $ toIPv4 as+  where+    test errmsg adr = when (adr < 0 || 255 < adr) (fail errmsg)+    check as = do let errmsg = "IPv4 adddress"+                  when (length as /= 4) (fail errmsg)+                  mapM_ (test errmsg) as++----------------------------------------------------------------+--+-- IPv6 Parser (RFC 4291)+--++hex :: Parser Int+hex = do ns <- some 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) (fail "IPv6 address -- more than 4 hex")++ip6 :: Parser IPv6+ip6 = toIPv6 <$> ip6'++ip6' :: Parser [Int]+ip6' =      do colon2+               bs <- option [] hexcolon+               format [] bs+        <|> try (do rs <- hexcolon+                    check rs+                    return rs)+        <|> do bs1 <- hexcolon2+               bs2 <- option [] hexcolon+               format bs1 bs2+    where+      colon2 = string "::"+      hexcolon = hex `sepBy1` char ':'+      hexcolon2 = manyTill (hex <* char ':') (char ':')+      format bs1 bs2 = do let len1 = length bs1+                              len2 = length bs2+                          when (len1 > 7) (fail "IPv6 address1")+                          when (len2 > 7) (fail "IPv6 address2")+                          let len = 8 - len1 - len2+                          when (len <= 0) (fail "IPv6 address3")+                          let spring = replicate len 0+                          return $ bs1 ++ spring ++ bs2+      check bs = when (length bs /= 8) (fail "IPv6 address4")

@@ -0,0 +1,33 @@+module Data.IP.Mask where++import Data.Bits+import Data.IP.Addr+import Data.Word+import Data.IntMap hiding (map)++----------------------------------------------------------------++maskIPv4 :: Int -> IPv4+maskIPv4 len = IP4 (masksIPv4 ! len)++maskIPv6 :: Int -> IPv6+maskIPv6 len = IP6 (masksIPv6 ! len)++masksWord32 :: [Word32]+masksWord32 = take 33 $ iterate (`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

@@ -0,0 +1,58 @@+module Data.IP.Op where++import Data.Bits+import Data.IP.Addr+import Data.IP.Mask+import Data.IP.Range++----------------------------------------------------------------++class Eq a => Addr a where+    {-|+      The 'masked' function takes an 'Addr' and a contiguous+      mask and returned a masked 'Addr'.+    -}+    masked :: a -> a -> a+    {-|+      The 'intToMask' function takes 'Int' and returns a contiguous+      mask.+    -}+    intToMask :: Int -> a++instance Addr IPv4 where+    masked    = maskedIPv4+    intToMask = maskIPv4++instance Addr IPv6 where+    IP6 (a1,a2,a3,a4) `masked` IP6 (m1,m2,m3,m4) =+        IP6 (a1.&.m1,a2.&.m2,a3.&.m3,a4.&.m4)+    intToMask = maskIPv6++----------------------------------------------------------------++{-|+  The >:> operator takes two 'AddrRange'. It returns 'True' if+  the first 'AddrRange' contains the second 'AddrRange'. Otherwise,+  it returns 'False'.+-}+(>:>) :: Addr a => AddrRange a -> AddrRange a -> Bool+a >:> b = mlen a <= mlen b && (addr b `masked` mask a) == addr a++{-|+  The 'toMatchedTo' function take an 'Addr' address and an 'AddrRange',+  and returns 'True' if the range contains the address.+-}++isMatchedTo :: Addr a => a -> AddrRange a -> Bool+isMatchedTo a r = a `masked` mask r == addr r++{-|+  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 :: Addr a => a -> Int -> AddrRange a+makeAddrRange ad len = AddrRange adr msk len+   where+     msk = intToMask len+     adr = ad `masked` msk

@@ -0,0 +1,97 @@+{-# LANGUAGE FlexibleInstances #-}+module Data.IP.Range where++import Data.Bits+import Control.Monad+import Data.IP.Addr+import Data.IP.Mask+import Text.Appar.String++----------------------------------------------------------------++{-|+  A unified data for 'AddrRange' 'IPv4' and 'AddrRange' 'IPv6'.+-}++data IPRange = IPv4Range { ipv4range :: AddrRange IPv4 }+             | IPv6Range { ipv6range :: AddrRange IPv6 }+             deriving (Eq,Show)++----------------------------------------------------------------+--+-- Range+--++{-|+  The Addr range consists of an address, a contiguous mask,+  and mask length. The contiguous mask and the mask length+  are essentially same information but contained for pre+  calculation.++  To create this, use 'makeAddrRange' or 'read' \"192.0.2.0/24\" :: 'AddrRange' 'IPv4'+-}+data AddrRange a = AddrRange {+        -- |The 'addr' function returns an address from 'AddrRange'.+        addr :: a+        -- |The 'mask' function returns a contiguous 'IP' mask from 'AddrRange'.+      , mask :: a+        -- |The 'mlen' function returns a mask length from 'AddrRange'.+      , mlen :: Int+    } deriving (Eq, Ord)++----------------------------------------------------------------+--+-- Show+--++instance Show a => Show (AddrRange a) where+    show x = show (addr x) ++ "/" ++ show (mlen x)++----------------------------------------------------------------+--+-- Read+--++instance Read (AddrRange IPv4) where+    readsPrec _ = parseIPv4Range++instance Read (AddrRange IPv6) where+    readsPrec _ = parseIPv6Range++parseIPv4Range :: String -> [(AddrRange IPv4,String)]+parseIPv4Range cs = case runParser ip4range cs of+    (Nothing,_)    -> error $ "parseIPv4Range " ++ cs+    (Just a4,rest) -> [(a4,rest)]++parseIPv6Range :: String -> [(AddrRange IPv6,String)]+parseIPv6Range cs = case runParser ip6range cs of+    (Nothing,_)    -> error $ "parseIPv6Range " ++ cs+    (Just a6,rest) -> [(a6,rest)]++ip4range :: Parser (AddrRange IPv4)+ip4range = do+    ip <- ip4+    len <- option 32 $ do { char '/'; dig }+    check len+    let msk = maskIPv4 len+        adr = ip `maskedIPv4` msk+    return $ AddrRange adr msk len+  where+    check len = when (len < 0 || 32 < len) (fail "IPv4 mask length")++maskedIPv4 :: IPv4 -> IPv4 -> IPv4+IP4 a `maskedIPv4` IP4 m = IP4 (a .&. m)++ip6range :: Parser (AddrRange IPv6)+ip6range = do+    ip <- ip6+    len <- option 128 $ do { char '/'; dig }+    check len+    let msk = maskIPv6 len+        adr = ip `maskedIPv6` msk+    return $ AddrRange adr msk len+  where+    check len = when (len < 0 || 128 < len) (fail ("IPv6 mask length: " ++ show len))++maskedIPv6 :: IPv6 -> IPv6 -> IPv6+IP6 (a1,a2,a3,a4) `maskedIPv6` IP6 (m1,m2,m3,m4) = IP6 (a1.&.m1,a2.&.m2,a3.&.m3,a4.&.m4)

@@ -4,8 +4,20 @@   match base. It is a kind of TRIE with one   way branching removed. Both IPv4 and IPv6   are supported.++  For more information, see:+      <http://www.mew.org/~kazu/proj/iproute/> -}-module Data.IP.RouteTable (IPRTable, empty, insert, lookup, fromList, toList) where+module Data.IP.RouteTable (+  -- * Documentation+  -- ** Routable class+    Routable (..)+  -- ** Type for IP routing table+  , IPRTable+  -- ** Functions to manipulate an IP routing table+  , empty, insert+  , Data.IP.RouteTable.Internal.lookup+  , fromList, toList+  ) where -import Prelude hiding (lookup) import Data.IP.RouteTable.Internal

@@ -1,5 +1,5 @@ {-|-  IP routing table is a tree of 'IPRange'+  IP routing table is a tree of 'AddrRange'   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@@ -7,92 +7,156 @@ -} module Data.IP.RouteTable.Internal where -import Data.IP+import Data.Bits+import Data.IP.Addr+import Data.IP.Op+import Data.IP.Range+import Data.IntMap (IntMap, (!))+import qualified Data.IntMap as IM (fromList) import Data.List (foldl')+import Data.Word import Prelude hiding (lookup) +----------------------------------------------------------------+ {-|+  A class to contain IPv4 and IPv6.+-}+class Addr a => Routable a where+    {-|+      The 'intToTBit' function takes 'Int' and returns an 'Routable' address+      whose only n-th bit is set.+    -}+    intToTBit   :: Int -> a+    {-|+      The 'isZero' function takes an 'Routable' address and an test bit+      'Routable' address and returns 'True' is the bit is unset,+      otherwise returns 'False'.+    -}+    isZero :: a -> a -> Bool++instance Routable IPv4 where+    intToTBit = intToTBitIPv4+    isZero a b = a `masked` b == IP4 0++instance Routable IPv6 where+    intToTBit = intToTBitIPv6+    isZero a b = a `masked` b == IP6 (0,0,0,0)++----------------------------------------------------------------+--+-- Test Bit+--++intToTBitIPv4 :: Int -> IPv4+intToTBitIPv4 len = IP4 (intToTBitsIPv4 ! len)++intToTBitIPv6 :: Int -> IPv6+intToTBitIPv6 len = IP6 (intToTBitsIPv6 ! len)++intToTBitsWord32 :: [Word32]+intToTBitsWord32 = iterate (`shift` (-1)) 0x80000000++intToTBitsIPv4 :: IntMap IPv4Addr+intToTBitsIPv4 = IM.fromList $ zip [0..32] intToTBitsWord32++intToTBitsIPv6 :: IntMap IPv6Addr+intToTBitsIPv6 = IM.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++----------------------------------------------------------------++{-|   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)+data IPRTable k a =+    Nil+  | Node !(AddrRange k) !k !(Maybe a) (IPRTable k a) (IPRTable k a)+  deriving (Eq, Show)  ----------------------------------------------------------------  {-|   The 'empty' function returns an empty IP routing table. -}-empty :: IP k => IPRTable k a+empty :: Routable 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'+  The 'insert' function inserts a value with a key of 'AddrRange' 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"+insert :: (Routable k) => AddrRange k -> a -> IPRTable k a -> IPRTable k a+insert k1 v1 Nil = Node k1 tb1 (Just v1) Nil Nil+  where+    tb1 = keyToTestBit k1+insert k1 v1 s@(Node k2 tb2 v2 l r)+    | k1 == k2  = Node k1 tb1 (Just v1) l r+    | k2 >:> k1 = if isLeft k1 tb2+                  then Node k2 tb2 v2 (insert k1 v1 l) r+                  else Node k2 tb2 v2 l (insert k1 v1 r)+    | k1 >:> k2 = if isLeft k2 tb1+                  then Node k1 tb1 (Just v1) s Nil+                  else Node k1 tb1 (Just v1) Nil s+    | otherwise = let n = Node k1 tb1 (Just v1) Nil Nil+                  in join n s+  where+    tb1 = keyToTestBit k1 -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+join :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a+join s1@(Node k1 _ _ _ _) s2@(Node k2 _ _ _ _) =+    let kg = glue 0 k1 k2+        tbg = keyToTestBit kg+    in if isLeft k1 tbg+       then Node kg tbg Nothing s1 s2+       else Node kg tbg Nothing s2 s1+join _ _ = error "join" -    | otherwise = makeIPRange (addr k1) (n - 1)+glue :: (Routable k) => Int -> AddrRange k -> AddrRange k -> AddrRange k+glue n k1 k2+    | addr k1 `masked` mk == addr k2 `masked` mk = glue (n + 1) k1 k2+    | otherwise = makeAddrRange (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+keyToTestBit :: Routable k => AddrRange k -> k+keyToTestBit = intToTBit . mlen +isLeft :: Routable k => AddrRange k -> k -> Bool+isLeft adr = isZero (addr adr)+ ----------------------------------------------------------------  {-|-  The 'lookup' function looks up 'IPRTable' with a key of 'IPRange'+  The 'lookup' function looks up 'IPRTable' with a key of 'AddrRange'   and returns its value if exists. -}-lookup :: IP k => IPRange k -> IPRTable k a -> Maybe a+lookup :: Routable k => AddrRange 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 :: Routable k => AddrRange k -> IPRTable k a -> Maybe a -> Maybe a search _ Nil res = res-search k1 (Node e2@(Entry k2 _ Nothing) l r) res+search k1 (Node k2 tb2 Nothing l r) res     | k1 == k2  = res-    | k2 >:> k1 = if isLeft k1 e2+    | k2 >:> k1 = if isLeft k1 tb2                   then search k1 l res                   else search k1 r res     | otherwise = res-search k1 (Node e2@(Entry k2 _ vl) l r) res+search k1 (Node k2 tb2 vl l r) res     | k1 == k2  = vl-    | k2 >:> k1 = if isLeft k1 e2+    | k2 >:> k1 = if isLeft k1 tb2                   then search k1 l vl                   else search k1 r vl     | otherwise = res@@ -103,22 +167,22 @@   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 :: Routable k => [(AddrRange 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+  The 'toList' function creates a list of a pair of 'AddrRange' and   value from an IP routing table. -}-toList :: IP k => IPRTable k a -> [(IPRange k, a)]+toList :: Routable k => IPRTable k a -> [(AddrRange 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+    toL (Node _ _ Nothing  _ _) xs = xs+    toL (Node 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+foldt func v rt@(Node _ _ _ l r) = foldt func (foldt func (func rt v) l) r

@@ -8,8 +8,8 @@   * 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 +    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

@@ -1,7 +1,7 @@ Name:                   iproute-Version:                0.1-Author:                 Kazu Yamamoto <kazu@Mew.org>-Maintainer:             Kazu Yamamoto <kazu@Mew.org>+Version:                1.0.0+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3 License-File:           LICENSE Homepage:               http://www.mew.org/~kazu/proj/iproute/@@ -11,16 +11,24 @@                         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 +Category:               Algorithms Network+Cabal-Version:          >= 1.6+Build-Type:             Simple Extra-Source-Files:     test/Tests.hs test/IPv4Search.hs test/Makefile library-  GHC-Options:          -Wall+  if impl(ghc >= 6.12)+    GHC-Options:        -Wall -fno-warn-unused-do-bind+  else+    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+  Other-Modules:        Data.IP.Addr+                        Data.IP.Mask+                        Data.IP.Op+                        Data.IP.Range+                        Data.IP.RouteTable.Internal+  Build-Depends:        base >= 4 && < 5, appar, containers+Source-Repository head+  Type:                 git+  Location:             git://github.com/kazu-yamamoto/iproute.git 

@@ -15,21 +15,21 @@         target = readIPv4Range range     rt <- loadRoutes file     let res = lookup target rt-    putStrLn $ show res+    print res   where     handler :: ErrorCall -> IO ()     handler _ = help -loadRoutes :: FilePath -> IO (IPRTable IPv4 (IPRange IPv4))+loadRoutes :: FilePath -> IO (IPRTable IPv4 (AddrRange 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+        kvs = zip rs rs -- value is AddrRange itself in this test         radish = fromList kvs     return radish -readIPv4Range :: String -> IPRange IPv4+readIPv4Range :: String -> AddrRange IPv4 readIPv4Range = read  help :: IO ()

@@ -1,7 +1,7 @@ PROG = ipv4_search  all:-	ghc -Wall -i.. --make -o $(PROG) IPv4Search.hs+	ghc -Wall -fno-warn-unused-do-bind -i.. --make -o $(PROG) IPv4Search.hs  clean: 	rm -f *.hi *.o $(PROG)

@@ -1,124 +1,251 @@ {-# LANGUAGE FlexibleInstances #-}++module Tests where+ ------------------------------------------------------------------- +-- -- Tests for IP.RouteTable--- +-- --    runghc -i.. Tests.hs -- +import Control.Monad 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)+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 -options :: TestOptions-options = TestOptions { no_of_tests     = 300-                      , length_of_tests = 0-                      , debug_tests     = False-                      }+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 "Search IPv4" prop_search_ipv4+             , testProperty "Search IPv6" prop_search_ipv6+             , testProperty "Ord IPv4" prop_ord_ipv4+             , testProperty "Ord IPv6" prop_ord_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+             ]+        , testGroup "Test case for IP" [+               testCase "toIPv4" test_toIPv4+             , testCase "toIPv6" test_toIPv6+             , testCase "read IPv4" test_read_IPv4+             , testCase "read IPv6" test_read_IPv6+             , testCase "read IPv6 2" test_read_IPv6_2+             , testCase "read IPv4 range" test_read_IPv4_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 = 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-                          ]+main = defaultMain tests  ---------------------------------------------------------------- -- -- Arbitrary -- -instance Arbitrary (IPRange IPv4) where+instance Arbitrary (AddrRange IPv4) where     arbitrary = arbitraryIP toIPv4 255 4 32-    coarbitrary = undefined -instance Arbitrary (IPRange IPv6) where+instance Arbitrary (AddrRange IPv6) where     arbitrary = arbitraryIP toIPv6 65535 8 128-    coarbitrary = error "coarbitrary" -arbitraryIP :: IP a => ([Int] -> a) -> Int -> Int -> Int -> Gen (IPRange a)+arbitraryIP :: Routable a => ([Int] -> a) -> Int -> Int -> Int -> Gen (AddrRange a) arbitraryIP func width adrlen msklen = do-  a <- sequence $ take adrlen $ repeat (choose (0,width))+  a <- replicateM adrlen (choose (0,width))   let adr = func a   len <- choose (0,msklen)-  return $ makeIPRange adr len+  return $ makeAddrRange adr len  ---------------------------------------------------------------- -- -- Properties -- -prop_sort_ipv4 :: [IPRange IPv4] -> Bool+prop_sort_ipv4 :: [AddrRange IPv4] -> Bool prop_sort_ipv4 = sort_ip -prop_sort_ipv6 :: [IPRange IPv6] -> Bool+prop_sort_ipv6 :: [AddrRange IPv6] -> Bool prop_sort_ipv6 = sort_ip -sort_ip :: (IP a, Ord a) => [IPRange a] -> Bool+sort_ip :: (Routable a, Ord a) => [AddrRange 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 :: [AddrRange IPv4] -> Bool prop_fromto_ipv4 = fromto_ip -prop_fromto_ipv6 :: [IPRange IPv6] -> Bool+prop_fromto_ipv6 :: [AddrRange IPv6] -> Bool prop_fromto_ipv6 = fromto_ip -fromto_ip :: (IP a, Ord a) => [IPRange a] -> Bool+fromto_ip :: (Routable a, Ord a) => [AddrRange 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 :: [AddrRange IPv4] -> Bool prop_ord_ipv4 = ord_ip -prop_ord_ipv6 :: [IPRange IPv6] -> Bool+prop_ord_ipv6 :: [AddrRange IPv6] -> Bool prop_ord_ipv6 = ord_ip -ord_ip :: IP a => [IPRange a] -> Bool+ord_ip :: Routable a => [AddrRange a] -> Bool ord_ip xs = isOrdered (fromList (zip xs xs)) -isOrdered :: IP k => IPRTable k a -> Bool+isOrdered :: Routable k => IPRTable k a -> Bool isOrdered = foldt (\x v -> v && ordered x) True -ordered :: IP k => IPRTable k a -> Bool+ordered :: Routable k => IPRTable k a -> Bool ordered Nil = True-ordered (Node n l r) = ordered' n l && ordered' n r+ordered (Node k _ _ l r) = ordered' k l && ordered' k r   where     ordered' _ Nil = True-    ordered' (Entry k1 _ _) (Node (Entry k2 _ _) _ _) = k1 >:> k2+    ordered' k1 (Node k2 _ _ _ _) = k1 >:> k2  ---------------------------------------------------------------- -prop_search_ipv4 :: IPRange IPv4 -> [IPRange IPv4] -> Bool+prop_search_ipv4 :: AddrRange IPv4 -> [AddrRange IPv4] -> Bool prop_search_ipv4 = search_ip -prop_search_ipv6 :: IPRange IPv6 -> [IPRange IPv6] -> Bool+prop_search_ipv6 :: AddrRange IPv6 -> [AddrRange IPv6] -> Bool prop_search_ipv6 = search_ip -search_ip :: IP a => IPRange a -> [IPRange a] -> Bool+search_ip :: Routable a => AddrRange a -> [AddrRange 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 :: 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 +          | 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++----------------------------------------------------------------++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_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_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 = [+    read "0.0.0.0/0"+  , read "133.4.0.0/16"+  , read "133.5.0.0/16"+  , read "133.5.16.0/24"+  , read "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 (read "127.0.0.1") rt @?= Just (read "0.0.0.0/0")+    lookup (read "133.3.0.1") rt @?= Just (read "0.0.0.0/0")+    lookup (read "133.4.0.0") rt @?= Just (read "133.4.0.0/16")+    lookup (read "133.4.0.1") rt @?= Just (read "133.4.0.0/16")+    lookup (read "133.5.16.0") rt @?= Just (read "133.5.16.0/24")+    lookup (read "133.5.16.1") rt @?= Just (read "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 (read "127.0.0.1") rt @?= Nothing+    lookup (read "133.3.0.1") rt @?= Nothing+    lookup (read "133.4.0.0") rt @?= Just (read "133.4.0.0/16")+    lookup (read "133.4.0.1") rt @?= Just (read "133.4.0.0/16")+    lookup (read "133.5.16.0") rt @?= Just (read "133.5.16.0/24")+    lookup (read "133.5.16.1") rt @?= Just (read "133.5.16.0/24")+  where+    ipv4_list' = tail ipv4_list+    pairs = zip ipv4_list' ipv4_list'