iproute-1.7.12/0000755000000000000000000000000007346545000011462 5ustar0000000000000000iproute-1.7.12/Data/0000755000000000000000000000000007346545000012333 5ustar0000000000000000iproute-1.7.12/Data/IP.hs0000644000000000000000000000120407346545000013174 0ustar0000000000000000{-| Data structures to express IPv4, IPv6 and IP range. -} module Data.IP ( -- * IP data IP (..) -- ** IPv4 , IPv4 , toIPv4, toIPv4w , fromIPv4, fromIPv4w , fromHostAddress, toHostAddress -- ** IPv6 , IPv6 , toIPv6, toIPv6b, toIPv6w , fromIPv6, fromIPv6b, fromIPv6w , fromHostAddress6, toHostAddress6 -- ** Converters , ipv4ToIPv6 , fromSockAddr , toSockAddr -- * IP range data , IPRange (..) , AddrRange (addr, mask, mlen) -- * Address class , Addr (..) , makeAddrRange, (>:>), isMatchedTo, addrRangePair , ipv4RangeToIPv6 ) where import Data.IP.Addr import Data.IP.Op import Data.IP.Range iproute-1.7.12/Data/IP/0000755000000000000000000000000007346545000012643 5ustar0000000000000000iproute-1.7.12/Data/IP/Addr.hs0000644000000000000000000005210007346545000014047 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Data.IP.Addr where import Control.Monad import Data.Bits import Data.Char import Data.Data (Data) import Data.List (foldl', intersperse) import Data.String import Data.Typeable (Typeable) import Data.Word import Network.Socket import Numeric (showHex, showInt) import System.ByteOrder import Text.Appar.String import GHC.Enum (succError,predError) import GHC.Generics ---------------------------------------------------------------- {-| 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. >>> (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 } | IPv6 { ipv6 :: IPv6 } deriving (Data,Generic,Typeable) {-| Equality over IP addresses. Correctly compare IPv4 and IPv4-embedded-in-IPv6 addresses. >>> (read "2001:db8:00:00:00:00:00:01" :: IP) == (read "2001:db8:00:00:00:00:00:01" :: IP) True >>> (read "2001:db8:00:00:00:00:00:01" :: IP) == (read "2001:db8:00:00:00:00:00:05" :: IP) False >>> (read "127.0.0.1" :: IP) == (read "127.0.0.1" :: IP) True >>> (read "127.0.0.1" :: IP) == (read "10.0.0.1" :: IP) False >>> (read "::ffff:127.0.0.1" :: IP) == (read "127.0.0.1" :: IP) True >>> (read "::ffff:127.0.0.1" :: IP) == (read "127.0.0.9" :: IP) False >>> (read "::ffff:127.0.0.1" :: IP) >= (read "127.0.0.1" :: IP) True >>> (read "::ffff:127.0.0.1" :: IP) <= (read "127.0.0.1" :: IP) True -} instance Eq IP where (IPv4 ip1) == (IPv4 ip2) = ip1 == ip2 (IPv6 ip1) == (IPv6 ip2) = ip1 == ip2 (IPv4 ip1) == (IPv6 ip2) = ipv4ToIPv6 ip1 == ip2 (IPv6 ip1) == (IPv4 ip2) = ip1 == ipv4ToIPv6 ip2 instance Ord IP where (IPv4 ip1) `compare` (IPv4 ip2) = ip1 `compare` ip2 (IPv6 ip1) `compare` (IPv6 ip2) = ip1 `compare` ip2 (IPv4 ip1) `compare` (IPv6 ip2) = ipv4ToIPv6 ip1 `compare` ip2 (IPv6 ip1) `compare` (IPv4 ip2) = ip1 `compare` ipv4ToIPv6 ip2 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 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, Bounded, Data, Generic, Typeable) {-| 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::1 >>> read "2001:db8:11e:c00::101" :: IPv6 2001:db8:11e:c00::101 >>> read "2001:db8:11e:c00:aa:bb:192.0.2.1" :: IPv6 2001:db8:11e:c00:aa:bb:c000:201 >>> read "2001:db8::192.0.2.1" :: IPv6 2001:db8::c000:201 >>> read "0::ffff:192.0.2.1" :: IPv6 ::ffff:192.0.2.1 >>> read "0::0:c000:201" :: IPv6 ::192.0.2.1 >>> read "::0.0.0.1" :: IPv6 ::1 -} newtype IPv6 = IP6 IPv6Addr deriving (Eq, Ord, Bounded, Data, Generic, Typeable) ---------------------------------------------------------------- -- -- Enum -- instance Enum IPv4 where fromEnum (IP4 a) = fromEnum a toEnum = IP4 . toEnum instance Enum IPv6 where -- fromEnum and toEnum are not really useful, but I defined them anyway fromEnum (IP6 (a,b,c,d)) = let a' = fromEnum a `shift` 96 b' = fromEnum b `shift` 64 c' = fromEnum c `shift` 32 d' = fromEnum d in a' .|. b' .|. c' .|. d' toEnum i = let i' = fromIntegral i :: Integer a = fromIntegral (i' `shiftR` 96 .&. 0xffffffff) b = fromIntegral (i' `shiftR` 64 .&. 0xffffffff) c = fromIntegral (i' `shiftR` 32 .&. 0xffffffff) d = fromIntegral (i' .&. 0xffffffff) in IP6 (a,b,c,d) succ (IP6 (0xffffffff,0xffffffff,0xffffffff,0xffffffff)) = succError "IPv6" succ (IP6 (a, 0xffffffff,0xffffffff,0xffffffff)) = IP6 (succ a,0,0,0) succ (IP6 (a, b,0xffffffff,0xffffffff)) = IP6 (a,succ b,0,0) succ (IP6 (a, b, c,0xffffffff)) = IP6 (a,b,succ c,0) succ (IP6 (a, b, c, d)) = IP6 (a,b,c,succ d) pred (IP6 (0,0,0,0)) = predError "IPv6" pred (IP6 (a,0,0,0)) = IP6 (pred a, 0xffffffff, 0xffffffff, 0xffffffff) pred (IP6 (a,b,0,0)) = IP6 ( a, pred b, 0xffffffff, 0xffffffff) pred (IP6 (a,b,c,0)) = IP6 ( a, b, pred c, 0xffffffff) pred (IP6 (a,b,c,d)) = IP6 ( a, b, c, pred d) enumFrom ip = ip:gen ip where gen i = let i' = succ i in i':gen i' enumFromTo ip ip' = ip:gen ip where gen i | i == ip' = [] | otherwise = let i' = succ i in i':gen i' -- These two are implemented via the integer enum instance. -- A more correct implementation would essentially require -- implementing instance Num IPv6, which isn't something -- I wanna do. Another approach is to use Word128 to store -- an IPv6 address. enumFromThen ip ip' = fmap integerToIP6 [ip6ToInteger ip, ip6ToInteger ip' ..] enumFromThenTo ip inc fin = fmap integerToIP6 [ip6ToInteger ip, ip6ToInteger inc .. ip6ToInteger fin] instance Enum IP where fromEnum (IPv4 ip) = fromEnum ip fromEnum (IPv6 ip) = fromEnum ip -- Because Int cannot hold an IPv6 anyway toEnum = IPv4 . toEnum succ (IPv4 ip) = IPv4 $ succ ip succ (IPv6 ip) = IPv6 $ succ ip pred (IPv4 ip) = IPv4 $ pred ip pred (IPv6 ip) = IPv6 $ pred ip enumFrom (IPv4 ip) = fmap IPv4 $ enumFrom ip enumFrom (IPv6 ip) = fmap IPv6 $ enumFrom ip enumFromTo (IPv4 ip) (IPv4 ip') = fmap IPv4 $ enumFromTo ip ip' enumFromTo (IPv6 ip) (IPv6 ip') = fmap IPv6 $ enumFromTo ip ip' enumFromTo _ _ = error "enumFromTo: Incompatible IP families" enumFromThen (IPv4 ip) (IPv4 ip') = fmap IPv4 $ enumFromThen ip ip' enumFromThen (IPv6 ip) (IPv6 ip') = fmap IPv6 $ enumFromThen ip ip' enumFromThen _ _ = error "enumFromThen: Incompatible IP families" enumFromThenTo (IPv4 ip) (IPv4 inc) (IPv4 fin) = fmap IPv4 $ enumFromThenTo ip inc fin enumFromThenTo (IPv6 ip) (IPv6 inc) (IPv6 fin) = fmap IPv6 $ enumFromThenTo ip inc fin enumFromThenTo _ _ _ = error "enumFromThenTo: Incompatible IP families" ip6ToInteger :: IPv6 -> Integer ip6ToInteger (IP6 (a,b,c,d)) = let a' = word32ToInteger a `shift` 96 b' = word32ToInteger b `shift` 64 c' = word32ToInteger c `shift` 32 d' = word32ToInteger d in a' .|. b' .|. c' .|. d' where word32ToInteger :: Word32 -> Integer word32ToInteger = toEnum . fromEnum integerToIP6 :: Integer -> IPv6 integerToIP6 i = let a = integerToWord32 (i `shiftR` 96 .&. 0xffffffff) b = integerToWord32 (i `shiftR` 64 .&. 0xffffffff) c = integerToWord32 (i `shiftR` 32 .&. 0xffffffff) d = integerToWord32 (i .&. 0xffffffff) in IP6 (a,b,c,d) where integerToWord32 :: Integer -> Word32 integerToWord32 = toEnum . fromEnum ---------------------------------------------------------------- -- -- Show -- instance Show IPv4 where show ip = showIPv4 ip "" instance Show IPv6 where show ip = showIPv6 ip "" -- | Show an IPv4 address in the dot-decimal notation. showIPv4 :: IPv4 -> ShowS showIPv4 = foldr1 (.) . intersperse (showChar '.') . map showInt . fromIPv4 -- | Show an IPv6 address in the most appropriate notation, based on recommended -- representation proposed by . -- -- /The implementation is completely compatible with the current implementation -- of the `inet_ntop` function in glibc./ showIPv6 :: IPv6 -> ShowS showIPv6 ip@(IP6 (a1,a2,a3,a4)) -- IPv4-Mapped IPv6 Address | a1 == 0 && a2 == 0 && a3 == 0xffff = showString "::ffff:" . showIPv4 (IP4 a4) -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112) | a1 == 0 && a2 == 0 && a3 == 0 && a4 >= 0x10000 = showString "::" . showIPv4 (IP4 a4) -- length of longest run > 1, replace it with "::" | end - begin > 1 = showFields prefix . showString "::" . showFields suffix -- length of longest run <= 1, don't use "::" | otherwise = showFields fields where fields = fromIPv6 ip showFields = foldr (.) id . intersperse (showChar ':') . map showHex prefix = take begin fields -- fields before "::" suffix = drop end fields -- fields after "::" begin = end + diff -- the longest run of zeros (diff, end) = minimum $ scanl (\c i -> if i == 0 then c - 1 else 0) 0 fields `zip` [0..] ---------------------------------------------------------------- -- -- IntToIP -- {-| The 'toIPv4' function returns the 'IPv4' address corresponding to the given list of 'Int' octets. The function is strict in the four elements of the list. An error is returned if the list has a differnet length. The input elements are silently truncated to their 8 least-significant bits before they are combined to form the IPv4 address. >>> toIPv4 [192,0,2,1] 192.0.2.1 -} toIPv4 :: [Int] -> IPv4 toIPv4 [a1, a2, a3, a4] = IP4 w where w = (fromIntegral a1 .&. 0xff) `unsafeShiftL` 24 .|. (fromIntegral a2 .&. 0xff) `unsafeShiftL` 16 .|. (fromIntegral a3 .&. 0xff) `unsafeShiftL` 8 .|. (fromIntegral a4 .&. 0xff) toIPv4 _ = error "IPv4 field list length != 4" {-# INLINE toIPv4 #-} {-| The 'toIPv4w' function constructs the 'IPv4' address corresponding to the given 'Word32' value. Unlike the 'fromHostAddress' function, it is strict in the input value, which here is in host byte order. >>> toIPv4w 0xc0000201 192.0.2.1 @since 1.7.9 -} toIPv4w :: Word32 -> IPv4 toIPv4w w = IP4 w {-# INLINE toIPv4w #-} {-| The 'toIPv6' function returns the 'IPv6' address corresponding to the given list of eight 16-bit 'Int's. The function is strict in the eight elements of the list. An error is returned if the list has a differnet length. The input elements are in host byte order and are silently truncated to their 16 least-signicant bits before they are combined to form the IPv6 address. >>> toIPv6 [0x2001,0xDB8,0,0,0,0,0,1] 2001:db8::1 -} toIPv6 :: [Int] -> IPv6 toIPv6 [i1,i2,i3,i4,i5,i6,i7,i8] = IP6 (x1,x2,x3,x4) where !x1 = fromIntegral $ (i1 .&. 0xffff) `unsafeShiftL` 16 .|. (i2 .&. 0xffff) !x2 = fromIntegral $ (i3 .&. 0xffff) `unsafeShiftL` 16 .|. (i4 .&. 0xffff) !x3 = fromIntegral $ (i5 .&. 0xffff) `unsafeShiftL` 16 .|. (i6 .&. 0xffff) !x4 = fromIntegral $ (i7 .&. 0xffff) `unsafeShiftL` 16 .|. (i8 .&. 0xffff) toIPv6 _ = error "toIPv6 field list length != 8" {-# INLINE toIPv6 #-} {-| The 'toIPv6b' function returns the IPv6 address corresponding to the given list of sixteen 'Int' octets. The function is strict in the sixteen elements of the list. An error is returned if the list has a differnet length. The input elements are silently truncated to their 8 least-signicant bits before they are combined to form the IPv6 address. >>> toIPv6b [0x20,0x01,0xD,0xB8,0,0,0,0,0,0,0,0,0,0,0,1] 2001:db8::1 -} toIPv6b :: [Int] -> IPv6 toIPv6b [ h11, h12, l11, l12, h21, h22, l21, l22 , h31, h32, l31, l32, h41, h42, l41, l42 ] = IP6 (x1,x2,x3,x4) where !x1 = fromIntegral $ (h11 .&. 0xff) `unsafeShiftL` 24 .|. (h12 .&. 0xff) `unsafeShiftL` 16 .|. (l11 .&. 0xff) `unsafeShiftL` 8 .|. (l12 .&. 0xff) !x2 = fromIntegral $ (h21 .&. 0xff) `unsafeShiftL` 24 .|. (h22 .&. 0xff) `unsafeShiftL` 16 .|. (l21 .&. 0xff) `unsafeShiftL` 8 .|. (l22 .&. 0xff) !x3 = fromIntegral $ (h31 .&. 0xff) `unsafeShiftL` 24 .|. (h32 .&. 0xff) `unsafeShiftL` 16 .|. (l31 .&. 0xff) `unsafeShiftL` 8 .|. (l32 .&. 0xff) !x4 = fromIntegral $ (h41 .&. 0xff) `unsafeShiftL` 24 .|. (h42 .&. 0xff) `unsafeShiftL` 16 .|. (l41 .&. 0xff) `unsafeShiftL` 8 .|. (l42 .&. 0xff) toIPv6b _ = error "toIPv6b field list length != 16" {-| The 'toIPv6w' function constructs the 'IPv6' address corresponding to the given four-tuple of host byte order 'Word32' values. This function differs from the 'fromHostAddress6' function only in the fact that it is strict in the elements of the tuple. >>> toIPv6w (0x20010DB8,0x0,0x0,0x1) 2001:db8::1 @since 1.7.9 -} toIPv6w :: (Word32, Word32, Word32, Word32) -> IPv6 toIPv6w w@(!_, !_, !_, !_) = IP6 w {-# INLINE toIPv6w #-} ---------------------------------------------------------------- -- -- IPToInt -- {-| The 'fromIPv4' function returns the list of four 'Int' octets corresponding to the given 'IPv4' address. >>> fromIPv4 (toIPv4 [192,0,2,1]) [192,0,2,1] -} fromIPv4 :: IPv4 -> [Int] fromIPv4 (IP4 w) = split w 0o30 : split w 0o20 : split w 0o10 : split w 0 : [] where split :: Word32 -> Int -> Int split a n = fromIntegral $ a `unsafeShiftR` n .&. 0xff {-# INLINE fromIPv4 #-} {-| The 'fromIPv4w' function returns a single 'Word32' value corresponding to the given the 'IPv4' address. Unlike the 'toHostAddress' function, the returned value is strictly evaluated, and is not converted to network byte order. >>> fromIPv4w (toIPv4 [0xc0,0,2,1]) == 0xc0000201 True @since 1.7.9 -} fromIPv4w :: IPv4 -> Word32 fromIPv4w (IP4 !ip4rep) = ip4rep {-# INLINE fromIPv4w #-} {-| The 'fromIPv6' function returns a list eight 'Int's in host byte order corresponding to the eight 16-bit fragments of the given IPv6 address. >>> 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)) = split w1 . split w2 . split w3 . split w4 $ [] where split :: Word32 -> [Int] -> [Int] split n acc = fromIntegral (n `unsafeShiftR` 0x10 .&. 0xffff) : fromIntegral (n .&. 0xffff) : acc {-# INLINE fromIPv6 #-} {-| The 'fromIPv6b' function returns the 16 'Int' octets corresponding to the 16 bytes of the given IPv6 address. >>> fromIPv6b (toIPv6b [0x20,0x01,0xD,0xB8,0,0,0,0,0,0,0,0,0,0,0,1]) [32,1,13,184,0,0,0,0,0,0,0,0,0,0,0,1] -} fromIPv6b :: IPv6 -> [Int] fromIPv6b (IP6 (w1, w2, w3, w4)) = split w1 . split w2 . split w3 . split w4 $ [] where split :: Word32 -> [Int] -> [Int] split n acc = fromIntegral (n `unsafeShiftR` 24 .&. 0xff) : fromIntegral (n `unsafeShiftR` 16 .&. 0xff) : fromIntegral (n `unsafeShiftR` 8 .&. 0xff) : fromIntegral (n .&. 0xff) : acc {-| The 'fromIPv6w' function returns a four-tuple of 'Word32' values in host byte order corresponding to the given 'IPv6' address. This is identical to the 'toHostAddress6' function, except that the elements of four-tuple are first strictly evaluated. >>> fromIPv6w (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) == (0x20010DB8, 0, 0, 1) True @since 1.7.9 -} fromIPv6w :: IPv6 -> (Word32, Word32, Word32, Word32) fromIPv6w (IP6 ip6rep) = ip6rep {-# INLINE fromIPv6w #-} ---------------------------------------------------------------- -- -- Read -- instance Read IP where readsPrec _ = parseIP instance Read IPv4 where readsPrec _ = parseIPv4 instance Read IPv6 where readsPrec _ = parseIPv6 parseIP :: String -> [(IP,String)] parseIP cs = case runParser ip4 cs of (Just ip,rest) -> [(IPv4 ip,rest)] (Nothing,_) -> case runParser ip6 cs of (Just ip,rest) -> [(IPv6 ip,rest)] (Nothing,_) -> [] parseIPv4 :: String -> [(IPv4,String)] parseIPv4 cs = case runParser ip4 cs of (Nothing,_) -> [] (Just a4,rest) -> [(a4,rest)] parseIPv6 :: String -> [(IPv6,String)] parseIPv6 cs = case runParser ip6 cs of (Nothing,_) -> [] (Just a6,rest) -> [(a6,rest)] ---------------------------------------------------------------- -- -- IsString -- instance IsString IP where fromString = read instance IsString IPv4 where fromString = read instance IsString IPv6 where fromString = read ---------------------------------------------------------------- -- -- IPv4 Parser -- octet :: Parser Int octet = 0 <$ char '0' <|> (toInt =<< (:) <$> oneOf ['1'..'9'] <*> many digit) where toInt ds = maybe (fail "IPv4 address") pure $ foldr go Just ds 0 go !d !f !n = let n' = n * 10 + ord d - 48 in if n' <= 255 then f n' else Nothing ip4 :: Parser IPv4 ip4 = skipSpaces >> toIPv4 <$> ip4' ip4' :: Parser [Int] ip4' = do as <- octet `sepBy1` char '.' when (length as /= 4) (fail "IPv4 address") return as skipSpaces :: Parser () skipSpaces = void $ many (char ' ') ---------------------------------------------------------------- -- -- 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") colon2 :: Parser () colon2 = void $ string "::" format :: [Int] -> [Int] -> Parser [Int] 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 ip6 :: Parser IPv6 ip6 = skipSpaces >> toIPv6 <$> ip6' ip6' :: Parser [Int] ip6' = ip4Embedded <|> 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 hexcolon = hex `sepBy1` char ':' hexcolon2 = manyTill (hex <* char ':') (char ':') check bs = when (length bs /= 8) (fail "IPv6 address4") ip4Embedded :: Parser [Int] ip4Embedded = try (do colon2 bs <- beforeEmbedded embedded <- ip4' format [] (bs ++ ip4ToIp6 embedded)) -- matches 2001:db8::192.0.2.1 <|> try (do bs1 <- manyTill (try $ hex <* char ':') (char ':') bs2 <- option [] beforeEmbedded embedded <- ip4' format bs1 (bs2 ++ ip4ToIp6 embedded)) -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1 <|> try (do bs <- beforeEmbedded embedded <- ip4' let rs = bs ++ ip4ToIp6 embedded check rs return rs) where beforeEmbedded = many $ try $ hex <* char ':' ip4ToIp6 [a,b,c,d] = [ a `shiftL` 8 .|. b , c `shiftL` 8 .|. d ] ip4ToIp6 _ = error "ip4ToIp6" check bs = when (length bs /= 8) (fail "IPv6 address4") ---------------------------------------------------------------- -- -- HostAddress and HostAddress6 -- -- | The 'fromHostAddress' function converts 'HostAddress' to 'IPv4'. fromHostAddress :: HostAddress -> IPv4 fromHostAddress addr4 | byteOrder == LittleEndian = IP4 $ fixByteOrder addr4 | otherwise = IP4 addr4 -- | The 'toHostAddress' function converts 'IPv4' to 'HostAddress'. toHostAddress :: IPv4 -> HostAddress toHostAddress (IP4 addr4) | byteOrder == LittleEndian = fixByteOrder addr4 | otherwise = addr4 -- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'. fromHostAddress6 :: HostAddress6 -> IPv6 fromHostAddress6 = IP6 -- | The 'toHostAddress6' function converts 'IPv6' to 'HostAddress6'. toHostAddress6 :: IPv6 -> HostAddress6 toHostAddress6 (IP6 addr6) = addr6 fixByteOrder :: Word32 -> Word32 fixByteOrder s = d1 .|. d2 .|. d3 .|. d4 where d1 = shiftL s 24 d2 = shiftL s 8 .&. 0x00ff0000 d3 = shiftR s 8 .&. 0x0000ff00 d4 = shiftR s 24 .&. 0x000000ff -- | Convert IPv4 address to IPv4-embedded-in-IPv6 ipv4ToIPv6 :: IPv4 -> IPv6 ipv4ToIPv6 ip = toIPv6b [0,0,0,0,0,0,0,0,0,0,0xff,0xff,i1,i2,i3,i4] where [i1,i2,i3,i4] = fromIPv4 ip -- | Convert 'SockAddr' to 'IP'. -- -- Since: 1.7.4. fromSockAddr :: SockAddr -> Maybe (IP, PortNumber) fromSockAddr (SockAddrInet pn ha) = Just (IPv4 (fromHostAddress ha), pn) fromSockAddr (SockAddrInet6 pn _ ha6 _) = Just (IPv6 (fromHostAddress6 ha6), pn) fromSockAddr _ = Nothing -- | Convert 'IP' to 'SockAddr'. -- -- Since: 1.7.8. toSockAddr :: (IP, PortNumber) -> SockAddr toSockAddr (IPv4 addr4, pn) = SockAddrInet pn (toHostAddress addr4) toSockAddr (IPv6 addr6, pn) = SockAddrInet6 pn 0 (toHostAddress6 addr6) 0 iproute-1.7.12/Data/IP/Builder.hs0000644000000000000000000002424707346545000014576 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE NoStrict #-} {-# LANGUAGE TupleSections #-} module Data.IP.Builder ( -- * 'P.BoundedPrim' 'B.Builder's for general, IPv4 and IPv6 addresses. ipBuilder , ipv4Builder , ipv6Builder ) where import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Builder.Prim as P import Data.ByteString.Builder.Prim ((>$<), (>*<)) import GHC.Exts import GHC.Word (Word8(..), Word16(..), Word32(..)) import Data.IP.Addr ------------ IP builders {-# INLINE ipBuilder #-} -- | 'P.BoundedPrim' bytestring 'B.Builder' for general 'IP' addresses. ipBuilder :: IP -> B.Builder ipBuilder (IPv4 addr) = ipv4Builder addr ipBuilder (IPv6 addr) = ipv6Builder addr {-# INLINE ipv4Builder #-} -- | 'P.BoundedPrim' bytestring 'B.Builder' for 'IPv4' addresses. ipv4Builder :: IPv4 -> B.Builder ipv4Builder addr = P.primBounded ipv4Bounded $! fromIPv4w addr {-# INLINE ipv6Builder #-} -- | 'P.BoundedPrim' bytestring 'B.Builder' for 'IPv6' addresses. ipv6Builder :: IPv6 -> B.Builder ipv6Builder addr = P.primBounded ipv6Bounded $! fromIPv6w addr ------------ Builder utilities -- Convert fixed to bounded for fusion toB :: P.FixedPrim a -> P.BoundedPrim a toB = P.liftFixedToBounded {-# INLINE toB #-} ipv4Bounded :: P.BoundedPrim Word32 ipv4Bounded = quads >$< ((P.word8Dec >*< dotsep) >*< (P.word8Dec >*< dotsep)) >*< ((P.word8Dec >*< dotsep) >*< P.word8Dec) where quads a = ((qdot 0o30# a, qdot 0o20# a), (qdot 0o10# a, qfin a)) {-# INLINE quads #-} qdot s (W32# a) = (W8# (wordToWord8Compat# ((word32ToWordCompat# a `uncheckedShiftRL#` s) `and#` 0xff##)), ()) {-# INLINE qdot #-} qfin (W32# a) = W8# (wordToWord8Compat# (word32ToWordCompat# a `and#` 0xff##)) {-# INLINE qfin #-} dotsep = const 0x2e >$< toB P.word8 -- | For each 32-bit chunk of an IPv6 address, encode its display format in the -- presentation form of the address, based on its location relative to the -- "best gap", i.e. the left-most longest run of zeros. The "hi" (H) and/or -- "lo" (L) 16 bits may be accompanied by colons (C) on the left and/or right. -- data FF = CHL Word32 -- ^ :: | HL Word32 -- ^ : | NOP -- ^ nop | COL -- ^ : | CC -- ^ : : | CLO Word32 -- ^ : | CHC Word32 -- ^ :: | HC Word32 -- ^ : -- Build an IPv6 address in conformance with -- [RFC5952](http://tools.ietf.org/html/rfc5952 RFC 5952). -- ipv6Bounded :: P.BoundedPrim (Word32, Word32, Word32, Word32) ipv6Bounded = P.condB generalCase ( genFields >$< output128 ) ( P.condB v4mapped ( pairPair >$< (colsep >*< colsep) >*< (ffff >*< (fstUnit >$< colsep >*< ipv4Bounded)) ) ( pairPair >$< (P.emptyB >*< colsep) >*< (colsep >*< ipv4Bounded) ) ) where -- The boundedPrim switches and predicates need to be inlined for best -- performance, gaining a factor of ~2 in throughput in tests. -- {-# INLINE output128 #-} {-# INLINE output64 #-} {-# INLINE generalCase #-} {-# INLINE v4mapped #-} {-# INLINE output32 #-} generalCase :: (Word32, Word32, Word32, Word32) -> Bool generalCase (w0, w1, w2, w3) = w0 /= 0 || w1 /= 0 || (w2 /= 0xffff && (w2 /= 0 || w3 <= 0xffff)) -- v4mapped :: (Word32, Word32, Word32, Word32) -> Bool v4mapped (w0, w1, w2, _) = w0 == 0 && w1 == 0 && w2 == 0xffff -- BoundedPrim for the full 128-bit IPv6 address given as -- a pair of pairs of FF values, which encode the -- output format of each of the 32-bit chunks. -- output128 :: P.BoundedPrim ((FF, FF), (FF, FF)) output128 = output64 >*< output64 output64 = (output32 >*< output32) -- -- And finally the per-word case-work. -- output32 :: P.BoundedPrim FF output32 = P.condB (\case { CHL _ -> True; _ -> False }) build_CHL $ -- :hi:lo P.condB (\case { HL _ -> True; _ -> False }) build_HL $ -- hi:lo P.condB (\case { NOP -> True; _ -> False }) build_NOP $ -- P.condB (\case { COL -> True; _ -> False }) build_COL $ -- : P.condB (\case { CC -> True; _ -> False }) build_CC $ -- : : P.condB (\case { CLO _ -> True; _ -> False }) build_CLO $ -- :lo P.condB (\case { CHC _ -> True; _ -> False }) build_CHC $ -- :hi: build_HC -- hi: -- encoders for the eight field format (FF) cases. -- build_CHL = ( \ case CHL w -> ( fstUnit (hi16 w), fstUnit (lo16 w) ) _ -> undefined ) >$< (colsep >*< P.word16Hex) >*< (colsep >*< P.word16Hex) -- build_HL = ( \ case HL w -> ( hi16 w, fstUnit (lo16 w) ) _ -> undefined ) >$< P.word16Hex >*< colsep >*< P.word16Hex -- build_NOP = P.emptyB -- build_COL = const () >$< colsep -- build_CC = const ((), ()) >$< colsep >*< colsep -- build_CLO = ( \ case CLO w -> fstUnit (lo16 w) _ -> undefined ) >$< colsep >*< P.word16Hex -- build_CHC = ( \ case CHC w -> fstUnit (sndUnit (hi16 w)) _ -> undefined ) >$< colsep >*< P.word16Hex >*< colsep -- build_HC = ( \ case HC w -> sndUnit (hi16 w) _ -> undefined ) >$< P.word16Hex >*< colsep -- static encoders -- colsep :: P.BoundedPrim a colsep = toB $ const 0x3a >$< P.word8 -- ffff :: P.BoundedPrim a ffff = toB $ const 0xffff >$< P.word16HexFixed -- | Helpers hi16, lo16 :: Word32 -> Word16 hi16 !(W32# w) = W16# (wordToWord16Compat# (word32ToWordCompat# w `uncheckedShiftRL#` 16#)) lo16 !(W32# w) = W16# (wordToWord16Compat# (word32ToWordCompat# w `and#` 0xffff##)) -- fstUnit :: a -> ((), a) fstUnit = ((), ) -- sndUnit :: a -> (a, ()) sndUnit = (, ()) -- pairPair (a, b, c, d) = ((a, b), (c, d)) -- Construct fields decorated with output format details genFields (w0, w1, w2, w3) = let !(!gapStart, !gapEnd) = bestgap w0 w1 w2 w3 !f0 = makeF0 gapStart gapEnd w0 !f1 = makeF12 gapStart gapEnd 2# 3# w1 !f2 = makeF12 gapStart gapEnd 4# 5# w2 !f3 = makeF3 gapStart gapEnd w3 in ((f0, f1), (f2, f3)) makeF0 (I# gapStart) (I# gapEnd) !w = case (gapEnd ==# 0#) `orI#` (gapStart ># 1#) of 1# -> HL w _ -> case gapStart ==# 0# of 1# -> COL _ -> HC w {-# INLINE makeF0 #-} makeF12 (I# gapStart) (I# gapEnd) il ir !w = case (gapEnd <=# il) `orI#` (gapStart ># ir) of 1# -> CHL w _ -> case gapStart >=# il of 1# -> case gapStart ==# il of 1# -> COL _ -> CHC w _ -> case gapEnd ==# ir of 0# -> NOP _ -> CLO w {-# INLINE makeF12 #-} makeF3 (I# gapStart) (I# gapEnd) !w = case gapEnd <=# 6# of 1# -> CHL w _ -> case gapStart ==# 6# of 0# -> case gapEnd ==# 8# of 1# -> COL _ -> CLO w _ -> CC {-# INLINE makeF3 #-} -- | Unrolled and inlined calculation of the first longest -- run (gap) of 16-bit aligned zeros in the input address. -- bestgap :: Word32 -> Word32 -> Word32 -> Word32 -> (Int, Int) bestgap !(W32# a0) !(W32# a1) !(W32# a2) !(W32# a3) = finalGap (updateGap (0xffff## `and#` (word32ToWordCompat# a3)) (updateGap (0xffff0000## `and#` (word32ToWordCompat# a3)) (updateGap (0xffff## `and#` (word32ToWordCompat# a2)) (updateGap (0xffff0000## `and#` (word32ToWordCompat# a2)) (updateGap (0xffff## `and#` (word32ToWordCompat# a1)) (updateGap (0xffff0000## `and#` (word32ToWordCompat# a1)) (updateGap (0xffff## `and#` (word32ToWordCompat# a0)) (initGap (0xffff0000## `and#` (word32ToWordCompat# a0)))))))))) where -- The state after the first input word is always i' = 7, -- but if the input word is zero, then also g=z=1 and e'=7. initGap :: Word# -> Int# initGap w = case w of { 0## -> 0x1717#; _ -> 0x0707# } -- Update the nibbles of g|e'|z|i' based on the next input -- word. We always decrement i', reset z on non-zero input, -- otherwise increment z and check for a new best gap, if so -- we replace g|e' with z|i'. updateGap :: Word# -> Int# -> Int# updateGap w g = case w `neWord#` 0## of 1# -> (g +# 0xffff#) `andI#` 0xff0f# -- g, e, 0, --i _ -> let old = g +# 0xf# -- ++z, --i zi = old `andI#` 0xff# new = (zi `uncheckedIShiftL#` 8#) `orI#` zi in case new ># old of 1# -> new -- z, i, z, i _ -> old -- g, e, z, i -- Extract gap start and end from the nibbles of g|e'|z|i' -- where g is the gap width and e' is 8 minus its end. finalGap :: Int# -> (Int, Int) finalGap i = let g = i `uncheckedIShiftRL#` 12# in case g <# 2# of 1# -> (0, 0) _ -> let e = 8# -# ((i `uncheckedIShiftRL#` 8#) `andI#` 0xf#) s = e -# g in (I# s, I# e) {-# INLINE bestgap #-} #if MIN_VERSION_base(4,16,0) word32ToWordCompat# :: Word32# -> Word# word32ToWordCompat# = word32ToWord# wordToWord8Compat# :: Word# -> Word8# wordToWord8Compat# = wordToWord8# wordToWord16Compat# :: Word# -> Word16# wordToWord16Compat# = wordToWord16# #else word32ToWordCompat# :: Word# -> Word# word32ToWordCompat# x = x wordToWord8Compat# :: Word# -> Word# wordToWord8Compat# x = x wordToWord16Compat# :: Word# -> Word# wordToWord16Compat# x = x #endif iproute-1.7.12/Data/IP/Internal.hs0000644000000000000000000000037607346545000014761 0ustar0000000000000000module Data.IP.Internal ( IPv4(..) , IPv6(..) , AddrRange(..) , IPv4Addr , IPv6Addr ) where import Data.IP.Addr import Data.IP.Range iproute-1.7.12/Data/IP/Mask.hs0000644000000000000000000000231707346545000014075 0ustar0000000000000000module Data.IP.Mask where import Data.Bits import Data.IP.Addr import Data.Word maskIPv4 :: Int -> IPv4 maskIPv4 len = IP4 $ complement $ 0xffffffff `shift` (-len) maskIPv6 :: Int -> IPv6 maskIPv6 len = IP6 $ toIP6Addr $ bimapTup complement $ (0xffffffffffffffff, 0xffffffffffffffff) `shift128` (-len) where bimapTup f (x,y) = (f x, f y) shift128 :: (Word64, Word64) -> Int -> (Word64, Word64) shift128 x i | i < 0 = x `shiftR128` (-i) | i > 0 = x `shiftL128` i | otherwise = x shiftL128 :: (Word64, Word64) -> Int -> (Word64, Word64) shiftL128 (h, l) i = ( (h `shiftL` i) .|. (l `shift` (i - 64) ), (l `shiftL` i)) shiftR128 :: (Word64, Word64) -> Int -> (Word64, Word64) shiftR128 (h, l) i = (h `shiftR` i, (l `shiftR` i) .|. h `shift` (64 - i) ) fromIP6Addr :: IPv6Addr -> (Word64, Word64) fromIP6Addr (w3, w2, w1, w0) = ( (fromIntegral w3 `shiftL` 32) .|. fromIntegral w2 , (fromIntegral w1 `shiftL` 32) .|. fromIntegral w0 ) toIP6Addr :: (Word64, Word64) -> IPv6Addr toIP6Addr (h, l) = ( fromIntegral $ (h `shiftR` 32) .&. m , fromIntegral $ h .&. m , fromIntegral $ (l `shiftR` 32) .&. m , fromIntegral $ l .&. m ) where m = 0xffffffff iproute-1.7.12/Data/IP/Op.hs0000644000000000000000000000646207346545000013565 0ustar0000000000000000module Data.IP.Op where import Data.Bits import Data.IP.Addr import Data.IP.Mask import Data.IP.Range ---------------------------------------------------------------- {-| >>> 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 mask and returned a masked 'Addr'. -} masked :: a -> a -> a {-| The 'intToMask' function takes an 'Int' representing the number of bits to be set in the returned contiguous mask. When this integer is positive the bits will be starting from the MSB and from the LSB otherwise. >>> intToMask 16 :: IPv4 255.255.0.0 >>> intToMask (-16) :: IPv4 0.0.255.255 >>> intToMask 16 :: IPv6 ffff:: >>> intToMask (-16) :: IPv6 ::ffff -} intToMask :: Int -> a instance Addr IPv4 where masked = maskedIPv4 intToMask = maskIPv4 instance Addr IPv6 where masked = maskedIPv6 intToMask = maskIPv6 ---------------------------------------------------------------- {-| 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 {-| The 'isMatchedTo' 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 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 (toIPv4 [127,0,2,1]) 8 127.0.0.0/8 >>> makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 8 2000::/8 -} makeAddrRange :: Addr a => a -> Int -> AddrRange a makeAddrRange ad len = AddrRange adr msk len where msk = intToMask len adr = ad `masked` msk -- | Convert IPv4 range to IPV4-embedded-in-IPV6 range ipv4RangeToIPv6 :: AddrRange IPv4 -> AddrRange IPv6 ipv4RangeToIPv6 range = makeAddrRange (toIPv6 [0,0,0,0,0,0xffff, (i1 `shift` 8) .|. i2, (i3 `shift` 8) .|. i4]) (masklen + 96) where (ip, masklen) = addrRangePair range [i1,i2,i3,i4] = fromIPv4 ip {-| The 'unmakeAddrRange' functions take a 'AddrRange' and returns the network address and a mask length. >>> addrRangePair ("127.0.0.0/8" :: AddrRange IPv4) (127.0.0.0,8) >>> addrRangePair ("2000::/8" :: AddrRange IPv6) (2000::,8) -} addrRangePair :: Addr a => AddrRange a -> (a, Int) addrRangePair (AddrRange adr _ len) = (adr, len) iproute-1.7.12/Data/IP/Range.hs0000644000000000000000000001041207346545000014231 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} module Data.IP.Range where import Data.Bits import Data.Char import Data.Data (Data) import Data.IP.Addr import Data.IP.Mask import Data.String import Data.Typeable (Typeable) import Text.Appar.String import GHC.Generics ---------------------------------------------------------------- {-| 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. >>> (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 } | IPv6Range { ipv6range :: AddrRange IPv6 } deriving (Eq, Ord, Data, Generic, Typeable) ---------------------------------------------------------------- -- -- 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'. 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::/48 -} 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 :: {-# UNPACK #-} !Int } deriving (Eq, Ord, Data, Generic, Typeable) ---------------------------------------------------------------- -- -- Show -- instance Show a => Show (AddrRange a) where show x = show (addr x) ++ "/" ++ show (mlen x) instance Show IPRange where show (IPv4Range ip) = show ip show (IPv6Range ip) = show ip ---------------------------------------------------------------- -- -- Read -- instance Read IPRange where readsPrec _ = parseIPRange parseIPRange :: String -> [(IPRange,String)] parseIPRange cs = case runParser ip4range cs of (Just ip,rest) -> [(IPv4Range ip,rest)] (Nothing,_) -> case runParser ip6range cs of (Just ip,rest) -> [(IPv6Range ip,rest)] (Nothing,_) -> [] 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,_) -> [] (Just a4,rest) -> [(a4,rest)] parseIPv6Range :: String -> [(AddrRange IPv6,String)] parseIPv6Range cs = case runParser ip6range cs of (Nothing,_) -> [] (Just a6,rest) -> [(a6,rest)] maskLen :: Int -> Parser Int maskLen maxLen = do hasSlash <- option False $ True <$ char '/' if hasSlash then 0 <$ char '0' <|> (toInt =<< (:) <$> oneOf ['1'..'9'] <*> many digit) else return maxLen where toInt ds = maybe (fail "mask length") pure $ foldr go Just ds 0 go !d !f !n = let n' = n * 10 + ord d - 48 in if n' <= maxLen then f n' else Nothing ip4range :: Parser (AddrRange IPv4) ip4range = do ip <- ip4 len <- maskLen 32 let msk = maskIPv4 len adr = ip `maskedIPv4` msk return $ AddrRange adr msk len maskedIPv4 :: IPv4 -> IPv4 -> IPv4 IP4 a `maskedIPv4` IP4 m = IP4 (a .&. m) ip6range :: Parser (AddrRange IPv6) ip6range = do ip <- ip6 len <- maskLen 128 let msk = maskIPv6 len adr = ip `maskedIPv6` msk return $ AddrRange adr msk 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) ---------------------------------------------------------------- -- -- IsString -- instance IsString IPRange where fromString = read instance IsString (AddrRange IPv4) where fromString = read instance IsString (AddrRange IPv6) where fromString = read iproute-1.7.12/Data/IP/RouteTable.hs0000644000000000000000000000121707346545000015246 0ustar0000000000000000{-| 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. For more information, see: -} module Data.IP.RouteTable ( -- * Documentation -- ** Routable class Routable (..) -- ** Type for IP routing table , IPRTable -- ** Functions to manipulate an IP routing table , empty, insert, delete , I.lookup , I.lookupKeyValue , I.lookupAll , findMatch , fromList, toList , foldlWithKey , foldrWithKey ) where import Data.IP.RouteTable.Internal as I iproute-1.7.12/Data/IP/RouteTable/0000755000000000000000000000000007346545000014711 5ustar0000000000000000iproute-1.7.12/Data/IP/RouteTable/Internal.hs0000644000000000000000000002723007346545000017025 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-| 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 are supported. -} module Data.IP.RouteTable.Internal where import Control.Applicative hiding (empty) import qualified Control.Applicative as A (empty) import Control.Monad import Data.Bits import Data.Foldable (Foldable(..)) 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.Monoid hiding ((<>)) import Data.Semigroup import Data.Traversable import Data.Word import GHC.Generics (Generic, Generic1) 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 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) deriving (Eq, Generic, Generic1, Show) ---------------------------------------------------------------- {-| The 'empty' function returns an empty IP routing table. >>> (empty :: IPRTable IPv4 ()) == fromList [] True -} empty :: Routable k => IPRTable k a empty = Nil instance Functor (IPRTable k) where fmap _ Nil = Nil fmap f (Node r a mv b1 b2) = Node r a (f <$> mv) (fmap f b1) (fmap f b2) instance Foldable (IPRTable k) where foldMap _ Nil = mempty foldMap f (Node _ _ mv b1 b2) = foldMap f mv `mappend` foldMap f b1 `mappend` foldMap f b2 instance Traversable (IPRTable k) where traverse _ Nil = pure Nil traverse f (Node r a mv b1 b2) = Node r a <$> traverse f mv <*> traverse f b1 <*> traverse f b2 -- | Note that Semigroup and Monoid instances are right-biased. -- That is, if both arguments have the same key, the value from the right -- argument will be used. -- Since: 1.7.5 instance Routable k => Semigroup (IPRTable k a) where a <> b = foldlWithKey (\rt k v -> insert k v rt) a b stimes = stimesIdempotent -- | Since: 1.7.5 instance Routable k => Monoid (IPRTable k a) where mempty = empty mappend = (<>) ---------------------------------------------------------------- {-| 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 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 link n s where tb1 = keyToTestBit k1 link :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a link s1@(Node k1 _ _ _ _) s2@(Node k2 _ _ _ _) | isLeft k1 tbg = Node kg tbg Nothing s1 s2 | otherwise = Node kg tbg Nothing s2 s1 where kg = glue 0 k1 k2 tbg = keyToTestBit kg link _ _ = error "link" 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 keyToTestBit :: Routable k => AddrRange k -> k keyToTestBit = intToTBit . mlen isLeft :: Routable k => AddrRange k -> k -> Bool isLeft adr = isZero (addr adr) ---------------------------------------------------------------- {-| 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" () empty) == (empty :: IPRTable IPv4 ()) True -} delete :: (Routable k) => AddrRange k -> IPRTable k a -> IPRTable k a delete _ Nil = Nil delete k1 s@(Node k2 tb2 v2 l r) | k1 == k2 = node k2 tb2 Nothing l r | k2 >:> k1 = if isLeft k1 tb2 then node k2 tb2 v2 (delete k1 l) r else node k2 tb2 v2 l (delete k1 r) | otherwise = s node :: (Routable k) => AddrRange k -> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a node _ _ Nothing Nil r = r node _ _ Nothing l Nil = l node k tb v l r = Node k tb v l r ---------------------------------------------------------------- {-| 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 = fmap snd (search k s Nothing) {-| The 'lookupKeyValue' function looks up 'IPRTable' with a key of 'AddrRange'. If a routing information in 'IPRTable' matches the key, both key and value are returned. >>> :set -XOverloadedStrings >>> let rt = fromList ([("192.168.0.0/24", 1), ("10.10.0.0/16", 2)] :: [(AddrRange IPv4, Int)]) >>> lookupKeyValue "127.0.0.1" rt Nothing >>> lookupKeyValue "192.168.0.1" rt Just (192.168.0.0/24,1) >>> lookupKeyValue "10.10.0.1" rt Just (10.10.0.0/16,2) -} lookupKeyValue :: Routable k => AddrRange k -> IPRTable k a -> Maybe (AddrRange k, a) lookupKeyValue k s = search k s Nothing search :: Routable k => AddrRange k -> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a) search _ Nil res = res search k1 (Node k2 tb2 Nothing l r) res | k1 == k2 = res | k2 >:> k1 = if isLeft k1 tb2 then search k1 l res else search k1 r res | otherwise = res search k1 (Node k2 tb2 (Just vl) l r) res | k1 == k2 = Just (k1, vl) | k2 >:> k1 = if isLeft k1 tb2 then search k1 l $ Just (k2, vl) else search k1 r $ Just (k2, vl) | otherwise = res {-| 'lookupAll' is a version of 'lookup' that returns all entries matching the given key, not just the longest match. >>> :set -XOverloadedStrings >>> let rt = fromList ([("192.168.0.0/24", 1), ("10.10.0.0/16", 2), ("10.0.0.0/8", 3)] :: [(AddrRange IPv4, Int)]) >>> lookupAll "127.0.0.1" rt [] >>> lookupAll "192.168.0.1" rt [(192.168.0.0/24,1)] >>> lookupAll "10.10.0.1" rt [(10.10.0.0/16,2),(10.0.0.0/8,3)] -} lookupAll :: Routable k => AddrRange k -> IPRTable k a -> [(AddrRange k, a)] lookupAll range = go [] where go acc Nil = acc go acc (Node k tb Nothing l r) | k == range = acc | k >:> range = go acc $ if isLeft range tb then l else r | otherwise = acc go acc (Node k tb (Just v) l r) | k == range = (k,v):acc | k >:> range = go ((k,v):acc) $ if isLeft range tb then l else r | otherwise = acc ---------------------------------------------------------------- {-| 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 :: Alternative m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a) findMatch _ Nil = A.empty findMatch k1 (Node k2 _ Nothing l r) | k1 >:> k2 = findMatch k1 l <|> findMatch k1 r | k2 >:> k1 = findMatch k1 l <|> findMatch k1 r | otherwise = A.empty findMatch k1 (Node k2 _ (Just vl) l r) | k1 >:> k2 = pure (k2, vl) <|> findMatch k1 l <|> findMatch k1 r | k2 >:> k1 = findMatch k1 l <|> findMatch k1 r | otherwise = A.empty ---------------------------------------------------------------- {-| The 'fromList' function creates a new IP routing table from a list of a pair of 'IPrange' and value. -} 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 'AddrRange' and value from an IP routing table. -} toList :: Routable k => IPRTable k a -> [(AddrRange k, a)] toList = foldt toL [] where toL Nil xs = 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 -- | /O(n)/. Fold the keys and values in the IPRTable using the given -- left-associative binary operator. -- This function is equivalent to Data.Map.foldlWithKey with necessary to -- IPRTable changes. -- Since: 1.7.5 foldlWithKey :: (b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b foldlWithKey f zr = go zr where go z Nil = z go z (Node _ _ Nothing l r) = go (go z l) r go z (Node n _ (Just v) l r) = go (f (go z l) n v) r {-# INLINE foldlWithKey #-} -- | /O(n)/. Fold the keys and values in the IPRTable using the given -- right-associative binary operator. -- This function is equivalent to Data.Map.foldrWithKey with necessary to -- IPRTable changes. -- Since: 1.7.5 foldrWithKey :: (AddrRange k -> a -> b -> b) -> b -> IPRTable k a -> b foldrWithKey f zr = go zr where go z Nil = z go z (Node _ _ Nothing l r) = go (go z r) l go z (Node n _ (Just v) l r) = go (f n v (go z r)) l {-# INLINE foldrWithKey #-} iproute-1.7.12/LICENSE0000644000000000000000000000276507346545000012501 0ustar0000000000000000Copyright (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. iproute-1.7.12/Setup.hs0000644000000000000000000000005607346545000013117 0ustar0000000000000000import Distribution.Simple main = defaultMain iproute-1.7.12/iproute.cabal0000644000000000000000000000566707346545000014153 0ustar0000000000000000Name: iproute Version: 1.7.12 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto 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, Network Cabal-Version: >= 1.10 Build-Type: Simple Tested-With: GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.2 Library Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Data.IP Data.IP.Builder Data.IP.Internal Data.IP.RouteTable Data.IP.RouteTable.Internal Other-Modules: Data.IP.Addr Data.IP.Mask Data.IP.Op Data.IP.Range Build-Depends: base >= 4.9 && < 5 , appar , byteorder , bytestring , containers , network if impl(ghc < 8.0) Build-Depends: semigroups >= 0.17 if impl(ghc >= 8) Default-Extensions: Strict StrictData Test-Suite doctest Type: exitcode-stdio-1.0 Default-Language: Haskell2010 HS-Source-Dirs: test Ghc-Options: -threaded -Wall Main-Is: doctests.hs Build-Depends: base >= 4.6 && < 5 , doctest >= 0.9.3 , appar , byteorder , bytestring , network Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test Ghc-Options: -Wall Main-Is: Spec.hs Other-Modules: RouteTableSpec , BuilderSpec , IPSpec Build-Depends: base >= 4.6 && < 5 , hspec , QuickCheck , appar , byteorder , bytestring , containers , network , safe , iproute if impl(ghc < 8.0) Build-Depends: semigroups >= 0.17 Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/iproute.git iproute-1.7.12/test/0000755000000000000000000000000007346545000012441 5ustar0000000000000000iproute-1.7.12/test/BuilderSpec.hs0000644000000000000000000000353707346545000015206 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module BuilderSpec where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif import Control.Monad import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy.Char8 as LBSC import Data.IP import Data.IP.Builder import Data.IP.RouteTable import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck ---------------------------------------------------------------- -- -- Arbitrary -- b16, b17 :: Int b16 = 65535 b17 = (b16 + 1) * 2 - 1 instance Arbitrary IPv4 where arbitrary = arbitraryAdr toIPv4 255 255 4 -- | Bias the IPv6 generator to produce 0s with ~50% probability, so that we -- stand a non-trivial chance of testing the gap computation corner cases. -- We also give 0xffff enhanced odds, by choosing that instead of 0 one -- time out of 16. -- instance Arbitrary IPv6 where arbitrary = arbitraryAdr toIPv6 b16 b17 8 arbitraryAdr :: Routable a => ([Int] -> a) -> Int -> Int -> Int -> Gen a arbitraryAdr func width range adrlen = func <$> replicateM adrlen biased where biased = do n <- choose(0, range) if n <= width then return n else do f <- choose (0, 15 :: Int) if f < 15 then return 0 else return width ---------------------------------------------------------------- -- -- Spec -- spec :: Spec spec = do describe "test builders" $ do prop "IPv4 Builder matches Show instance" v4_compat prop "IPv6 Builder matches Show instance" v6_compat v4_compat :: IPv4 -> Bool v4_compat a = builderToString (ipv4Builder a) == show a v6_compat :: IPv6 -> Bool v6_compat a = builderToString (ipv6Builder a) == show a builderToString :: BB.Builder -> String builderToString = LBSC.unpack . BB.toLazyByteString iproute-1.7.12/test/IPSpec.hs0000644000000000000000000000454607346545000014131 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module IPSpec where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif import Data.IP import Safe (readMay) import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck import RouteTableSpec () ---------------------------------------------------------------- -- -- Arbitrary -- data InvalidIPv4Str = Iv4 String deriving (Show) instance Arbitrary InvalidIPv4Str where arbitrary = arbitraryIIPv4Str arbitrary 32 arbitraryIIPv4Str :: Gen IPv4 -> Int -> Gen InvalidIPv4Str arbitraryIIPv4Str adrGen msklen = toIv4 <$> adrGen <*> lenGen where toIv4 adr len = Iv4 $ show adr ++ "/" ++ show len lenGen = oneof [choose (minBound, -1), choose (msklen + 1, maxBound)] data InvalidIPv6Str = Iv6 String deriving (Show) instance Arbitrary InvalidIPv6Str where arbitrary = arbitraryIIPv6Str arbitrary 128 arbitraryIIPv6Str :: Gen IPv6 -> Int -> Gen InvalidIPv6Str arbitraryIIPv6Str adrGen msklen = toIv6 <$> adrGen <*> lenGen where toIv6 adr len = Iv6 $ show adr ++ "/" ++ show len lenGen = oneof [choose (minBound, -1), choose (msklen + 1, maxBound)] ---------------------------------------------------------------- -- -- Spec -- spec :: Spec spec = do describe "read" $ do prop "IPv4" to_str_ipv4 prop "IPv6" to_str_ipv6 prop "IPv4 failure" ipv4_fail prop "IPv6 failure" ipv6_fail it "can read even if unnecessary spaces exist" $ do (readMay " 127.0.0.1" :: Maybe IPv4) `shouldBe` readMay "127.0.0.1" it "does not read overflow IPv4 octets" $ do (readMay "127.0.0.18446744073709551617" :: Maybe IPv4) `shouldBe` Nothing it "can read even if unnecessary spaces exist" $ do (readMay " ::1" :: Maybe IPv4) `shouldBe` readMay "::1" it "does not read overflow mask lengths" $ do (readMay "192.168.0.1/18446744073709551648" :: Maybe (AddrRange IPv4)) `shouldBe` Nothing to_str_ipv4 :: AddrRange IPv4 -> Bool to_str_ipv4 a = readMay (show a) == Just a to_str_ipv6 :: AddrRange IPv6 -> Bool to_str_ipv6 a = readMay (show a) == Just a ipv4_fail :: InvalidIPv4Str -> Bool ipv4_fail (Iv4 a) = (readMay a :: Maybe (AddrRange IPv4)) == Nothing ipv6_fail :: InvalidIPv6Str -> Bool ipv6_fail (Iv6 a) = (readMay a :: Maybe (AddrRange IPv6)) == Nothing iproute-1.7.12/test/RouteTableSpec.hs0000644000000000000000000000753607346545000015671 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module RouteTableSpec where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative hiding (empty) #endif import Control.Monad import Data.Function (on) import Data.IP import Data.IP.RouteTable.Internal import qualified Data.Foldable as Foldable import Data.List (sort, nub) import qualified Data.List as List import Data.Monoid ((<>)) import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck ---------------------------------------------------------------- -- -- 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 = func <$> replicateM adrlen (choose (0, width)) arbitraryIP :: Routable a => Gen a -> Int -> Gen (AddrRange a) arbitraryIP adrGen msklen = makeAddrRange <$> adrGen <*> choose (0,msklen) ---------------------------------------------------------------- -- -- Spec -- spec :: Spec spec = do describe "fromList" $ do prop "creates the same tree for random input and ordered input" (sort_ip :: [AddrRange IPv4] -> Bool) prop "creates the same tree for random input and ordered input" (sort_ip :: [AddrRange IPv6] -> Bool) prop "stores input in the incremental order" (ord_ip :: [AddrRange IPv4] -> Bool) prop "stores input in the incremental order" (ord_ip :: [AddrRange IPv6] -> Bool) describe "toList" $ do prop "expands as sorted" (fromto_ip :: [AddrRange IPv4] -> Bool) prop "expands as sorted" (fromto_ip :: [AddrRange IPv6] -> Bool) describe "folds" $ do prop "foldl" prop_foldl prop "foldr" prop_foldr describe "monoid" $ do prop "monoid instance" prop_monoid sort_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool sort_ip xs = fromList (zip xs xs) == fromList (zip xs' xs') where xs' = sort xs 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 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 -- Foldl and foldr properties are adapted from Data.Map tests prop_foldl :: Int -> [(AddrRange IPv4, Int)] -> Property prop_foldl n ys = length ys > 0 ==> let xs = List.nubBy ((==) `on` fst) ys m = fromList xs in Foldable.foldl (+) n m == List.foldr (+) n (List.map snd xs) && Foldable.foldl (flip (:)) [] m == reverse (List.map snd (List.sort xs)) && foldlWithKey (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) prop_foldr :: Int -> [(AddrRange IPv4, Int)] -> Property prop_foldr n ys = length ys > 0 ==> let xs = List.nubBy ((==) `on` fst) ys m = fromList xs in Foldable.foldr (+) n m == List.foldr (+) n (List.map snd xs) && Foldable.foldr (:) [] m == List.map snd (List.sortBy (compare `on` fst) xs) && foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) prop_monoid :: [(AddrRange IPv4, ())] -> [(AddrRange IPv4, ())] -> Property prop_monoid xs ys = length xs > 0 && length ys > 0 ==> let xm = fromList xs ym = fromList ys in empty <> xm == xm && ym <> empty == ym && xm <> ym == fromList (xs ++ ys) iproute-1.7.12/test/Spec.hs0000644000000000000000000000005407346545000013666 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} iproute-1.7.12/test/doctests.hs0000644000000000000000000000042107346545000014622 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-XOverloadedStrings" , "-package=appar" , "-package=byteorder" , "-package=network" , "Data/IP.hs" , "Data/IP/RouteTable.hs"]