iproute 1.7.15 → 1.8.0
raw patch · 11 files changed
+307/−237 lines, 11 filesdep −byteorderdep −containersdep −semigroupsdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies removed: byteorder, containers, semigroups
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.IP.RouteTable.Internal: intToTBitsIPv4 :: IntMap IPv4Addr
- Data.IP.RouteTable.Internal: intToTBitsIPv6 :: IntMap IPv6Addr
- Data.IP.RouteTable.Internal: intToTBitsWord32 :: [Word32]
- Data.IP.RouteTable: findMatch :: Alternative m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
+ Data.IP.RouteTable: findMatch :: (Alternative m, Routable k) => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
- Data.IP.RouteTable.Internal: findMatch :: Alternative m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
+ Data.IP.RouteTable.Internal: findMatch :: (Alternative m, Routable k) => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
Files
- Data/IP.hs +1/−1
- Data/IP/Addr.hs +123/−91
- Data/IP/Builder.hs +27/−48
- Data/IP/Mask.hs +1/−1
- Data/IP/Op.hs +13/−6
- Data/IP/Range.hs +31/−5
- Data/IP/RouteTable/Internal.hs +23/−36
- iproute.cabal +11/−23
- test/BuilderSpec.hs +0/−4
- test/IPSpec.hs +67/−9
- test/RouteTableSpec.hs +10/−13
Data/IP.hs view
@@ -34,7 +34,7 @@ AddrRange (addr, mask, mlen), -- * Address class- Addr (..),+ Addr (masked, intToMask), makeAddrRange, (>:>), isMatchedTo,
Data/IP/Addr.hs view
@@ -8,15 +8,14 @@ import Data.Bits import Data.Char import Data.Data (Data)-import Data.List (foldl', intersperse)+import qualified Data.List as L import Data.String-import Data.Typeable (Typeable) import Data.Word-import GHC.Enum (predError, succError)+import GHC.ByteOrder (ByteOrder (..), targetByteOrder)+import GHC.Enum (fromEnumError, predError, succError, toEnumError) import GHC.Generics import Network.Socket import Numeric (showHex, showInt)-import System.ByteOrder import Text.Appar.String ----------------------------------------------------------------@@ -32,7 +31,7 @@ data IP = IPv4 {ipv4 :: IPv4} | IPv6 {ipv6 :: IPv6}- deriving (Data, Generic, Typeable)+ deriving (Data, Generic) -- | -- Equality over IP addresses. Correctly compare IPv4 and IPv4-embedded-in-IPv6 addresses.@@ -82,7 +81,7 @@ -- >>> read "192.0.2.1" :: IPv4 -- 192.0.2.1 newtype IPv4 = IP4 IPv4Addr- deriving (Eq, Ord, Bounded, Data, Generic, Typeable)+ deriving (Eq, Ord, Bounded, Data, Generic) -- | -- The abstract data type to express an IPv6 address.@@ -103,32 +102,51 @@ -- >>> read "::0.0.0.1" :: IPv6 -- ::1 newtype IPv6 = IP6 IPv6Addr- deriving (Eq, Ord, Bounded, Data, Generic, Typeable)+ deriving (Eq, Ord, Bounded, Data, Generic) ---------------------------------------------------------------- -- -- Enum -- +-- | Delegates to 'Word32', which stops at 'minBound' and 'maxBound'.+--+-- >>> [read "255.255.255.254" ..] :: [IPv4]+-- [255.255.255.254,255.255.255.255]+-- >>> [read "0.0.0.1", read "0.0.0.0" ..] :: [IPv4]+-- [0.0.0.1,0.0.0.0]+-- >>> [read "192.0.2.2" .. read "192.0.2.1"] :: [IPv4]+-- [] instance Enum IPv4 where fromEnum (IP4 a) = fromEnum a toEnum = IP4 . toEnum+ succ (IP4 a) = IP4 (succ a)+ pred (IP4 a) = IP4 (pred a)+ enumFrom (IP4 a) = IP4 <$> enumFrom a+ enumFromTo (IP4 a) (IP4 b) = IP4 <$> enumFromTo a b+ enumFromThen (IP4 a) (IP4 b) = IP4 <$> enumFromThen a b+ enumFromThenTo (IP4 a) (IP4 b) (IP4 c) = IP4 <$> enumFromThenTo a b c +-- | Stops at 'minBound' and 'maxBound'.+-- 'fromEnum' and 'toEnum' fail if the address does not fit in 'Int'.+--+-- >>> [read "ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffe" ..] :: [IPv6]+-- [ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffe,ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff]+-- >>> [read "::2", read "::1" ..] :: [IPv6]+-- [::2,::1,::]+-- >>> [read "::2" .. read "::1"] :: [IPv6]+-- []+-- >>> fromEnum (read "::1:0" :: IPv6)+-- 65536 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)+ fromEnum ip+ | i > toInteger (maxBound :: Int) = fromEnumError "IPv6" ip+ | otherwise = fromInteger i+ where+ i = ip6ToInteger ip+ toEnum i+ | i < 0 = toEnumError "IPv6" i (minBound :: IPv6, maxBound :: IPv6)+ | otherwise = integerToIP6 (toInteger i) succ (IP6 (0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff)) = succError "IPv6" succ (IP6 (a, 0xffffffff, 0xffffffff, 0xffffffff)) = IP6 (succ a, 0, 0, 0)@@ -142,24 +160,28 @@ 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'+ enumFrom ip = enumFromTo ip maxBound - enumFromTo ip ip' = ip : gen ip+ enumFromTo ip ip'+ | ip > ip' = []+ | otherwise = 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]+ enumFromThen ip ip'+ | ip' >= ip = enumFromThenTo ip ip' maxBound+ | otherwise = enumFromThenTo ip ip' minBound + -- Integer's enumFromThenTo never goes beyond the bounds given.+ enumFromThenTo ip inc fin =+ integerToIP6 <$> [ip6ToInteger ip, ip6ToInteger inc .. ip6ToInteger fin]++-- | Mixed families are enumerated as IPv6, as in 'Eq' and 'Ord'.+--+-- >>> [IPv4 (read "192.0.2.1") .. IPv6 (read "::ffff:192.0.2.2")]+-- [::ffff:192.0.2.1,::ffff:192.0.2.2] instance Enum IP where fromEnum (IPv4 ip) = fromEnum ip fromEnum (IPv6 ip) = fromEnum ip@@ -173,21 +195,22 @@ 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+ enumFrom (IPv4 ip) = IPv4 <$> enumFrom ip+ enumFrom (IPv6 ip) = 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"+ enumFromTo (IPv4 ip) (IPv4 ip') = IPv4 <$> enumFromTo ip ip'+ enumFromTo ip ip' = IPv6 <$> enumFromTo (toV6 ip) (toV6 ip') - 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"+ enumFromThen (IPv4 ip) (IPv4 ip') = IPv4 <$> enumFromThen ip ip'+ enumFromThen ip ip' = IPv6 <$> enumFromThen (toV6 ip) (toV6 ip') - 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"+ enumFromThenTo (IPv4 ip) (IPv4 inc) (IPv4 fin) = IPv4 <$> enumFromThenTo ip inc fin+ enumFromThenTo ip inc fin = IPv6 <$> enumFromThenTo (toV6 ip) (toV6 inc) (toV6 fin) +toV6 :: IP -> IPv6+toV6 (IPv4 ip) = ipv4ToIPv6 ip+toV6 (IPv6 ip) = ip+ ip6ToInteger :: IPv6 -> Integer ip6ToInteger (IP6 (a, b, c, d)) = let a' = word32ToInteger a `shift` 96@@ -223,7 +246,7 @@ -- | Show an IPv4 address in the dot-decimal notation. showIPv4 :: IPv4 -> ShowS-showIPv4 = foldr1 (.) . intersperse (showChar '.') . map showInt . fromIPv4+showIPv4 = foldr1 (.) . L.intersperse (showChar '.') . map showInt . fromIPv4 -- | Show an IPv6 address in the most appropriate notation, based on recommended -- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.@@ -246,7 +269,7 @@ showFields fields where fields = fromIPv6 ip- showFields = foldr (.) id . intersperse (showChar ':') . map showHex+ showFields = foldr (.) id . L.intersperse (showChar ':') . map showHex prefix = take begin fields -- fields before "::" suffix = drop end fields -- fields after "::" begin = end + diff -- the longest run of zeros@@ -392,7 +415,7 @@ -- >>> 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 : []+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@@ -465,12 +488,29 @@ -- Read -- +-- |+-- >>> read "[192.0.2.1,2001:db8::1]" :: [IP]+-- [192.0.2.1,2001:db8::1] instance Read IP where readsPrec _ = parseIP +-- | 'reads' returns the rest of the input.+--+-- >>> reads "192.0.2.1 rest" :: [(IPv4, String)]+-- [(192.0.2.1," rest")]+-- >>> read "(192.0.2.1,80)" :: (IPv4, Int)+-- (192.0.2.1,80)+-- >>> reads "192.0.2.1a" :: [(IPv4, String)]+-- [] instance Read IPv4 where readsPrec _ = parseIPv4 +-- | 'reads' returns the rest of the input.+--+-- >>> reads "::192.0.2.1 rest" :: [(IPv6, String)]+-- [(::192.0.2.1," rest")]+-- >>> read "[::1,2001:db8::1]" :: [IPv6]+-- [::1,2001:db8::1] instance Read IPv6 where readsPrec _ = parseIPv6 @@ -521,10 +561,10 @@ in if n' <= 255 then f n' else Nothing ip4 :: Parser IPv4-ip4 = skipSpaces >> toIPv4 <$> ip4' True+ip4 = skipSpaces >> toIPv4 <$> ip4' -ip4' :: Bool -> Parser [Int]-ip4' checkTermination = do+ip4' :: Parser [Int]+ip4' = do a0 <- octet _ <- char '.' a1 <- octet@@ -532,18 +572,18 @@ a2 <- octet _ <- char '.' a3 <- octet- let as = [a0, a1, a2, a3]- when checkTermination $- skipSpaces >> termination- return as+ boundary+ return [a0, a1, a2, a3] skipSpaces :: Parser () skipSpaces = void $ many (char ' ') -termination :: Parser ()-termination = P $ \str -> case str of- [] -> (Just (), "")- _ -> (Nothing, str)+-- | Succeeds without consuming input if the address cannot continue here,+-- so that 'readsPrec' can return the rest of the input.+boundary :: Parser ()+boundary = P $ \str -> case str of+ c : _ | isHexDigit c || c == '.' || c == ':' -> (Nothing, str)+ _ -> (Just (), str) ---------------------------------------------------------------- --@@ -555,7 +595,7 @@ ns <- some hexDigit check ns let ms = map digitToInt ns- val = foldl' (\x y -> x * 16 + y) 0 ms+ val = L.foldl' (\x y -> x * 16 + y) 0 ms return val where check ns = when (length ns > 4) (fail "IPv6 address -- more than 4 hex")@@ -575,42 +615,44 @@ return $ bs1 ++ spring ++ bs2 ip6 :: Parser IPv6-ip6 = ip6' True--ip6' :: Bool -> Parser IPv6-ip6' checkTermination = skipSpaces >> toIPv6 <$> ip6arr+ip6 = skipSpaces >> toIPv6 <$> ip6arr where+ -- appar's <|> does not backtrack, so each branch is wrapped in try. ip6arr =- ip4Embedded' checkTermination- <|> do- colon2- bs <- option [] hexcolon- format [] bs+ ip4Embedded <|> try ( do+ colon2+ bs <- option [] hexcolon+ boundary+ format [] bs+ )+ <|> try+ ( do rs <- hexcolon+ boundary check rs return rs )- <|> do- bs1 <- hexcolon2- bs2 <- option [] hexcolon- format bs1 bs2+ <|> try+ ( do+ bs1 <- hexcolon2+ bs2 <- option [] hexcolon+ boundary+ 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 = ip4Embedded' True--ip4Embedded' :: Bool -> Parser [Int]-ip4Embedded' checkTermination =+ip4Embedded = try ( do colon2 bs <- beforeEmbedded- embedded <- ip4' checkTermination+ embedded <- ip4' format [] (bs ++ ip4ToIp6 embedded) ) -- matches 2001:db8::192.0.2.1@@ -618,14 +660,14 @@ ( do bs1 <- manyTill (try $ hex <* char ':') (char ':') bs2 <- option [] beforeEmbedded- embedded <- ip4' checkTermination+ embedded <- ip4' format bs1 (bs2 ++ ip4ToIp6 embedded) ) -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1 <|> try ( do bs <- beforeEmbedded- embedded <- ip4' checkTermination+ embedded <- ip4' let rs = bs ++ ip4ToIp6 embedded check rs return rs@@ -647,13 +689,13 @@ -- | The 'fromHostAddress' function converts 'HostAddress' to 'IPv4'. fromHostAddress :: HostAddress -> IPv4 fromHostAddress addr4- | byteOrder == LittleEndian = IP4 $ fixByteOrder addr4+ | targetByteOrder == LittleEndian = IP4 $ byteSwap32 addr4 | otherwise = IP4 addr4 -- | The 'toHostAddress' function converts 'IPv4' to 'HostAddress'. toHostAddress :: IPv4 -> HostAddress toHostAddress (IP4 addr4)- | byteOrder == LittleEndian = fixByteOrder addr4+ | targetByteOrder == LittleEndian = byteSwap32 addr4 | otherwise = addr4 -- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.@@ -664,19 +706,9 @@ 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+ipv4ToIPv6 (IP4 w) = IP6 (0, 0, 0xffff, w) -- | Convert 'SockAddr' to 'IP'. --
Data/IP/Builder.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE NoStrict #-} @@ -34,13 +31,13 @@ -- | 'P.BoundedPrim' bytestring 'B.Builder' for 'IPv4' addresses. ipv4Builder :: IPv4 -> B.Builder-ipv4Builder addr = P.primBounded ipv4Bounded $! fromIPv4w addr+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+ipv6Builder addr = P.primBounded ipv6Bounded $ fromIPv6w addr ------------ Builder utilities @@ -59,11 +56,11 @@ {-# INLINE quads #-} qdot s (W32# a) = ( W8#- (wordToWord8Compat# ((word32ToWordCompat# a `uncheckedShiftRL#` s) `and#` 0xff##))+ (wordToWord8# ((word32ToWord# a `uncheckedShiftRL#` s) `and#` 0xff##)) , () ) {-# INLINE qdot #-}- qfin (W32# a) = W8# (wordToWord8Compat# (word32ToWordCompat# a `and#` 0xff##))+ qfin (W32# a) = W8# (wordToWord8# (word32ToWord# a `and#` 0xff##)) {-# INLINE qfin #-} dotsep = const 0x2e >$< toB P.word8 @@ -129,7 +126,7 @@ -- output128 :: P.BoundedPrim ((FF, FF), (FF, FF)) output128 = output64 >*< output64- output64 = (output32 >*< output32)+ output64 = output32 >*< output32 -- -- And finally the per-word case-work. --@@ -141,7 +138,9 @@ 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:+ P.condB+ (\case CHC _ -> True; _ -> False)+ build_CHC -- :hi: build_HC -- hi: -- encoders for the eight field format (FF) cases.@@ -198,8 +197,8 @@ -- \| Helpers hi16, lo16 :: Word32 -> Word16- hi16 !(W32# w) = W16# (wordToWord16Compat# (word32ToWordCompat# w `uncheckedShiftRL#` 16#))- lo16 !(W32# w) = W16# (wordToWord16Compat# (word32ToWordCompat# w `and#` 0xffff##))+ hi16 (W32# w) = W16# (wordToWord16# (word32ToWord# w `uncheckedShiftRL#` 16#))+ lo16 (W32# w) = W16# (wordToWord16# (word32ToWord# w `and#` 0xffff##)) -- fstUnit :: a -> ((), a) fstUnit = ((),)@@ -211,14 +210,14 @@ -- 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+ 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 =+ makeF0 (I# gapStart) (I# gapEnd) w = case (gapEnd ==# 0#) `orI#` (gapStart ># 1#) of 1# -> HL w _ -> case gapStart ==# 0# of@@ -226,7 +225,7 @@ _ -> HC w {-# INLINE makeF0 #-} - makeF12 (I# gapStart) (I# gapEnd) il ir !w =+ makeF12 (I# gapStart) (I# gapEnd) il ir w = case (gapEnd <=# il) `orI#` (gapStart ># ir) of 1# -> CHL w _ -> case gapStart >=# il of@@ -238,7 +237,7 @@ _ -> CLO w {-# INLINE makeF12 #-} - makeF3 (I# gapStart) (I# gapEnd) !w =+ makeF3 (I# gapStart) (I# gapEnd) w = case gapEnd <=# 6# of 1# -> CHL w _ -> case gapStart ==# 6# of@@ -251,23 +250,23 @@ -- | 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) =+bestgap (W32# a0) (W32# a1) (W32# a2) (W32# a3) = finalGap ( updateGap- (0xffff## `and#` (word32ToWordCompat# a3))+ (0xffff## `and#` word32ToWord# a3) ( updateGap- (0xffff0000## `and#` (word32ToWordCompat# a3))+ (0xffff0000## `and#` word32ToWord# a3) ( updateGap- (0xffff## `and#` (word32ToWordCompat# a2))+ (0xffff## `and#` word32ToWord# a2) ( updateGap- (0xffff0000## `and#` (word32ToWordCompat# a2))+ (0xffff0000## `and#` word32ToWord# a2) ( updateGap- (0xffff## `and#` (word32ToWordCompat# a1))+ (0xffff## `and#` word32ToWord# a1) ( updateGap- (0xffff0000## `and#` (word32ToWordCompat# a1))+ (0xffff0000## `and#` word32ToWord# a1) ( updateGap- (0xffff## `and#` (word32ToWordCompat# a0))- (initGap (0xffff0000## `and#` (word32ToWordCompat# a0)))+ (0xffff## `and#` word32ToWord# a0)+ (initGap (0xffff0000## `and#` word32ToWord# a0)) ) ) )@@ -308,23 +307,3 @@ 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
Data/IP/Mask.hs view
@@ -25,7 +25,7 @@ shiftL128 :: (Word64, Word64) -> Int -> (Word64, Word64) shiftL128 (h, l) i =- ((h `shiftL` i) .|. (l `shift` (i - 64)), (l `shiftL` i))+ ((h `shiftL` i) .|. (l `shift` (i - 64)), l `shiftL` i) shiftR128 :: (Word64, Word64) -> Int -> (Word64, Word64) shiftR128 (h, l) i =
Data/IP/Op.hs view
@@ -1,6 +1,5 @@ module Data.IP.Op where -import Data.Bits import Data.IP.Addr import Data.IP.Mask import Data.IP.Range@@ -36,13 +35,18 @@ -- ::ffff intToMask :: Int -> a + -- | The number of bits of the address. The argument is not evaluated.+ addrBits :: a -> Int+ instance Addr IPv4 where masked = maskedIPv4 intToMask = maskIPv4+ addrBits _ = 32 instance Addr IPv6 where masked = maskedIPv6 intToMask = maskIPv6+ addrBits _ = 128 ---------------------------------------------------------------- @@ -81,26 +85,29 @@ -- 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.+-- A mask length out of range is clamped to it. -- -- >>> 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 (toIPv4 [127,0,2,1]) 40+-- 127.0.2.1/32+-- >>> makeAddrRange (toIPv4 [127,0,2,1]) (-1)+-- 0.0.0.0/0 makeAddrRange :: Addr a => a -> Int -> AddrRange a-makeAddrRange ad len = AddrRange adr msk len+makeAddrRange ad len0 = AddrRange adr msk len where+ len = max 0 $ min (addrBits ad) len0 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)+ makeAddrRange (ipv4ToIPv6 ip) (masklen + 96) where (ip, masklen) = addrRangePair range- [i1, i2, i3, i4] = fromIPv4 ip -- | -- The 'unmakeAddrRange' functions take a 'AddrRange' and
Data/IP/Range.hs view
@@ -11,7 +11,6 @@ import Data.IP.Addr import Data.IP.Mask import Data.String-import Data.Typeable (Typeable) import GHC.Generics import Text.Appar.String @@ -26,11 +25,31 @@ -- 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+-- >>> (read "192.0.2.0/24" :: IPRange) == (read "::ffff:192.0.2.0/120" :: IPRange)+-- True data IPRange = IPv4Range {ipv4range :: AddrRange IPv4} | IPv6Range {ipv6range :: AddrRange IPv6}- deriving (Eq, Ord, Data, Generic, Typeable)+ deriving (Data, Generic) +-- | Like 'IP', an IPv4 range is equal to its IPv4-mapped IPv6 range.+instance Eq IPRange where+ IPv4Range r1 == IPv4Range r2 = r1 == r2+ IPv6Range r1 == IPv6Range r2 = r1 == r2+ IPv4Range r1 == IPv6Range r2 = mapRange r1 == r2+ IPv6Range r1 == IPv4Range r2 = r1 == mapRange r2++instance Ord IPRange where+ IPv4Range r1 `compare` IPv4Range r2 = r1 `compare` r2+ IPv6Range r1 `compare` IPv6Range r2 = r1 `compare` r2+ IPv4Range r1 `compare` IPv6Range r2 = mapRange r1 `compare` r2+ IPv6Range r1 `compare` IPv4Range r2 = r1 `compare` mapRange r2++mapRange :: AddrRange IPv4 -> AddrRange IPv6+mapRange (AddrRange a _ len) = AddrRange (ipv4ToIPv6 a) (maskIPv6 len') len'+ where+ len' = len + 96+ ---------------------------------------------------------------- -- -- Range@@ -57,7 +76,7 @@ , mlen :: {-# UNPACK #-} !Int -- ^ The 'mlen' function returns a mask length from 'AddrRange'. }- deriving (Eq, Ord, Data, Generic, Typeable)+ deriving (Eq, Ord, Data, Generic) ---------------------------------------------------------------- --@@ -76,6 +95,9 @@ -- Read -- +-- |+-- >>> read "[192.0.2.0/24,2001:db8::/32]" :: [IPRange]+-- [192.0.2.0/24,2001:db8::/32] instance Read IPRange where readsPrec _ = parseIPRange @@ -86,6 +108,10 @@ (Just ip, rest) -> [(IPv6Range ip, rest)] (Nothing, _) -> [] +-- | 'reads' returns the rest of the input.+--+-- >>> reads "192.0.2.0/24 rest" :: [(AddrRange IPv4, String)]+-- [(192.0.2.0/24," rest")] instance Read (AddrRange IPv4) where readsPrec _ = parseIPv4Range @@ -119,7 +145,7 @@ ip4range :: Parser (AddrRange IPv4) ip4range = do skipSpaces- ip <- toIPv4 <$> ip4' False+ ip <- toIPv4 <$> ip4' len <- maskLen 32 let msk = maskIPv4 len adr = ip `maskedIPv4` msk@@ -130,7 +156,7 @@ ip6range :: Parser (AddrRange IPv6) ip6range = do- ip <- ip6' False+ ip <- ip6 len <- maskLen 128 let msk = maskIPv6 len adr = ip `maskedIPv6` msk
Data/IP/RouteTable/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} -- |@@ -13,16 +12,14 @@ import qualified Control.Applicative as A (empty) import Control.Monad import Data.Bits-import Data.Foldable (Foldable (..)) import Data.IP.Addr+import Data.IP.Mask import Data.IP.Op import Data.IP.Range-import Data.IntMap (IntMap, (!))-import qualified Data.IntMap as IM (fromList)+import qualified Data.List as L import Data.Monoid hiding ((<>)) import Data.Semigroup import Data.Traversable-import Data.Word import GHC.Generics (Generic, Generic1) import Prelude hiding (lookup) @@ -59,28 +56,10 @@ -- intToTBitIPv4 :: Int -> IPv4-intToTBitIPv4 len = IP4 (intToTBitsIPv4 ! len)+intToTBitIPv4 len = IP4 (0x80000000 `shiftR` 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+intToTBitIPv6 len = IP6 $ toIP6Addr $ (0x8000000000000000, 0) `shiftR128` len ---------------------------------------------------------------- @@ -330,17 +309,17 @@ -- 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+fromList = L.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.+-- value from an IP routing table. The list is sorted by 'AddrRange'.+--+-- >>> let rt = fromList [("10.128.0.0/16",3),("10.0.0.0/8",1),("10.1.0.0/16",2)] :: IPRTable IPv4 Int+-- >>> toList rt+-- [(10.0.0.0/8,1),(10.1.0.0/16,2),(10.128.0.0/16,3)] 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+toList = foldrWithKey (\k a xs -> (k, a) : xs) [] ---------------------------------------------------------------- @@ -349,27 +328,35 @@ 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.+-- left-associative binary operator, in the order of 'AddrRange'. -- This function is equivalent to Data.Map.foldlWithKey with necessary to -- IPRTable changes. -- Since: 1.7.5+--+-- >>> let rt = fromList [("10.128.0.0/16",3),("10.0.0.0/8",1),("10.1.0.0/16",2)] :: IPRTable IPv4 Int+-- >>> foldlWithKey (\ks k _ -> k : ks) [] rt+-- [10.128.0.0/16,10.1.0.0/16,10.0.0.0/8] 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+ go z (Node n _ (Just v) l r) = go (go (f z n v) l) r {-# INLINE foldlWithKey #-} -- | /O(n)/. Fold the keys and values in the IPRTable using the given--- right-associative binary operator.+-- right-associative binary operator, in the order of 'AddrRange'. -- This function is equivalent to Data.Map.foldrWithKey with necessary to -- IPRTable changes. -- Since: 1.7.5+--+-- >>> let rt = fromList [("10.128.0.0/16",3),("10.0.0.0/8",1),("10.1.0.0/16",2)] :: IPRTable IPv4 Int+-- >>> foldrWithKey (\k _ ks -> k : ks) [] rt+-- [10.0.0.0/8,10.1.0.0/16,10.128.0.0/16] 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+ go z (Node n _ (Just v) l r) = f n v (go (go z r) l) {-# INLINE foldrWithKey #-}
iproute.cabal view
@@ -1,13 +1,13 @@-cabal-version: >=1.10+cabal-version: 3.0 name: iproute-version: 1.7.15-license: BSD3+version: 1.8.0+license: BSD-3-Clause license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp> author: Kazu Yamamoto <kazu@iij.ad.jp> 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+ ghc ==9.2.8 ghc ==9.4.8 ghc ==9.6.7 ghc ==9.8.4 ghc ==9.10.3+ ghc ==9.12.4 homepage: http://www.mew.org/~kazu/proj/iproute/ synopsis: IP Routing Table@@ -23,7 +23,7 @@ source-repository head type: git- location: git://github.com/kazu-yamamoto/iproute.git+ location: https://github.com/kazu-yamamoto/iproute.git library exposed-modules:@@ -39,22 +39,15 @@ Data.IP.Op Data.IP.Range - default-language: Haskell2010- ghc-options: -Wall+ default-language: Haskell2010+ default-extensions: Strict StrictData+ ghc-options: -Wall build-depends:- base >=4.9 && <5,+ base >=4.16 && <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 spec type: exitcode-stdio-1.0 main-is: Spec.hs@@ -68,16 +61,11 @@ default-language: Haskell2010 ghc-options: -Wall build-depends:- base >=4.6 && <5,+ base >=4.16 && <5, hspec, QuickCheck, appar,- byteorder, bytestring,- containers, network, safe, iproute-- if impl(ghc <8.0)- build-depends: semigroups >=0.17
test/BuilderSpec.hs view
@@ -1,12 +1,8 @@-{-# 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
test/IPSpec.hs view
@@ -1,14 +1,12 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module IPSpec where -#if __GLASGOW_HASKELL__ < 709-import Control.Applicative-#endif+import Control.Exception (evaluate) import Data.IP-import Data.Maybe (isJust)+import Data.Maybe (isJust, isNothing) import Safe (readMay) import Test.Hspec import Test.Hspec.QuickCheck (prop)@@ -21,7 +19,7 @@ -- Arbitrary -- -data InvalidIPv4Str = Iv4 String deriving (Show)+newtype InvalidIPv4Str = Iv4 String deriving (Show) instance Arbitrary InvalidIPv4Str where arbitrary =@@ -47,7 +45,7 @@ toIv4 adr len = Iv4 $ show adr ++ "/" ++ show len lenGen = oneof [choose (minBound, -1), choose (msklen + 1, maxBound)] -data InvalidIPv6Str = Iv6 String deriving (Show)+newtype InvalidIPv6Str = Iv6 String deriving (Show) instance Arbitrary InvalidIPv6Str where arbitrary = arbitraryIIPv6Str arbitrary 128@@ -82,7 +80,67 @@ it "can read embedded v4 in v6 range" $ do (readMay "::ffff:192.0.2.0/120" :: Maybe (AddrRange IPv6)) `shouldSatisfy` isJust+ prop "lists of IP" $ \xs ys ->+ let ips = map IPv4 xs ++ map IPv6 ys in readMay (show ips) == Just ips+ prop "pairs of IPv4 and Int" $ \x n ->+ readMay (show (x :: IPv4, n :: Int)) == Just (x, n)+ prop "pairs of IPv6 and Int" $ \x n ->+ readMay (show (x :: IPv6, n :: Int)) == Just (x, n)+ prop "lists of IPRange" $ \xs ys ->+ let rs = map IPv4Range xs ++ map IPv6Range ys+ in readMay (show rs) == Just rs+ it "returns the rest of the input" $ do+ (reads "192.0.2.1 x" :: [(IPv4, String)])+ `shouldBe` [(read "192.0.2.1", " x")]+ (reads "::192.0.2.1 x" :: [(IPv6, String)])+ `shouldBe` [(read "::192.0.2.1", " x")]+ (reads "192.0.2.0/24 x" :: [(AddrRange IPv4, String)])+ `shouldBe` [(read "192.0.2.0/24", " x")]+ it "does not stop in the middle of an address" $ do+ (reads "192.0.2.1a" :: [(IPv4, String)]) `shouldBe` []+ (reads "1:2:3:4:5:6:7:8:9" :: [(IPv6, String)]) `shouldBe` [] + describe "makeAddrRange" $ do+ it "clamps the mask length" $ do+ makeAddrRange ("192.0.2.1" :: IPv4) 40 `shouldBe` "192.0.2.1/32"+ makeAddrRange ("192.0.2.1" :: IPv4) (-1) `shouldBe` "0.0.0.0/0"+ makeAddrRange ("2001:db8::1" :: IPv6) 200 `shouldBe` "2001:db8::1/128"+ makeAddrRange ("2001:db8::1" :: IPv6) (-1) `shouldBe` "::/0"+ prop "makes a valid IPv4 range" $ \a n ->+ let r = makeAddrRange (a :: IPv4) n in readMay (show r) == Just r+ prop "makes a valid IPv6 range" $ \a n ->+ let r = makeAddrRange (a :: IPv6) n in readMay (show r) == Just r+ describe "IPv4-mapped IPv6" $ do+ prop "IPRange compares like IP" $ \x y ->+ let r4 = IPv4Range x+ r6 = IPv6Range (ipv4RangeToIPv6 y)+ in (r4 == r6) == (x == y) && compare r4 r6 == compare x y+ it "enumerates mixed families as IPv6" $ do+ [IPv4 "192.0.2.1" .. IPv6 "::ffff:192.0.2.2"]+ `shouldBe` [IPv6 "::ffff:192.0.2.1", IPv6 "::ffff:192.0.2.2"]+ describe "enum" $ do+ it "stops at maxBound" $ do+ [maxBound ..] `shouldBe` [maxBound :: IPv4]+ [maxBound ..] `shouldBe` [maxBound :: IPv6]+ [pred maxBound, maxBound ..] `shouldBe` [pred maxBound, maxBound :: IPv4]+ [pred maxBound, maxBound ..] `shouldBe` [pred maxBound, maxBound :: IPv6]+ it "stops at minBound" $ do+ [succ minBound, minBound ..] `shouldBe` [succ minBound, minBound :: IPv4]+ [succ minBound, minBound ..] `shouldBe` [succ minBound, minBound :: IPv6]+ it "returns [] for an empty range" $ do+ ["::2" .. "::1"] `shouldBe` ([] :: [IPv6])+ ["0.0.0.2" .. "0.0.0.1"] `shouldBe` ([] :: [IPv4])+ it "converts IPv6 to Int and back" $ do+ fromEnum ("::1:0" :: IPv6) `shouldBe` 0x10000+ toEnum 0x10000 `shouldBe` ("::1:0" :: IPv6)+ it "rejects IPv6 which does not fit in Int" $ do+ evaluate (fromEnum ("1::" :: IPv6)) `shouldThrow` anyErrorCall+ evaluate (toEnum (-1) :: IPv6) `shouldThrow` anyErrorCall+ prop "IPv6 enumFromTo is consistent with Integer" $ \x (Small n) ->+ let y = toEnum (fromEnum (x :: IPv4) `mod` 0x10000) :: IPv6+ z = toEnum (fromEnum y + (abs n :: Int)) :: IPv6+ in map fromEnum [y .. z] == [fromEnum y .. fromEnum z]+ to_str_ipv4 :: AddrRange IPv4 -> Bool to_str_ipv4 a = readMay (show a) == Just a @@ -90,7 +148,7 @@ to_str_ipv6 a = readMay (show a) == Just a ipv4_fail :: InvalidIPv4Str -> Bool-ipv4_fail (Iv4 a) = (readMay a :: Maybe (AddrRange IPv4)) == Nothing+ipv4_fail (Iv4 a) = isNothing (readMay a :: Maybe (AddrRange IPv4)) ipv6_fail :: InvalidIPv6Str -> Bool-ipv6_fail (Iv6 a) = (readMay a :: Maybe (AddrRange IPv6)) == Nothing+ipv6_fail (Iv6 a) = isNothing (readMay a :: Maybe (AddrRange IPv6))
test/RouteTableSpec.hs view
@@ -1,12 +1,8 @@-{-# 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 qualified Data.Foldable as Foldable import Data.Function (on)@@ -14,7 +10,6 @@ import Data.IP.RouteTable.Internal import Data.List (nub, sort) import qualified Data.List as List-import Data.Monoid ((<>)) import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck@@ -81,7 +76,7 @@ xs' = sort xs fromto_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool-fromto_ip xs = nub (sort xs) == nub (sort ys)+fromto_ip xs = nub (sort xs) == ys where ys = map fst . toList . fromList $ zip xs xs @@ -101,25 +96,27 @@ -- Foldl and foldr properties are adapted from Data.Map tests prop_foldl :: Int -> [(AddrRange IPv4, Int)] -> Property prop_foldl n ys =- length ys > 0 ==>+ not (null ys) ==> let xs = List.nubBy ((==) `on` fst) ys m = fromList xs- in Foldable.foldl (+) n m == List.foldr (+) n (List.map snd xs)+ in Foldable.foldl (+) n m == List.foldr ((+) . snd) n 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)+ && foldlWithKey (\b _ a -> a + b) n m == List.foldr ((+) . snd) n xs+ && foldlWithKey (\b k a -> (k, a) : b) [] m == reverse (List.sort xs) prop_foldr :: Int -> [(AddrRange IPv4, Int)] -> Property prop_foldr n ys =- length ys > 0 ==>+ not (null ys) ==> let xs = List.nubBy ((==) `on` fst) ys m = fromList xs- in Foldable.foldr (+) n m == List.foldr (+) n (List.map snd xs)+ in Foldable.foldr (+) n m == List.foldr ((+) . snd) n 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)+ && foldrWithKey (\_ a b -> a + b) n m == List.foldr ((+) . snd) n xs+ && foldrWithKey (\k a b -> (k, a) : b) [] m == List.sort xs prop_monoid :: [(AddrRange IPv4, ())] -> [(AddrRange IPv4, ())] -> Property prop_monoid xs ys =- length xs > 0 && length ys > 0 ==>+ not (null xs) && not (null ys) ==> let xm = fromList xs ym = fromList ys in empty <> xm == xm