iproute 1.7.8 → 1.7.9
raw patch · 6 files changed
+506/−33 lines, 6 filesdep +bytestringdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.IP: fromIPv4w :: IPv4 -> Word32
+ Data.IP: fromIPv6w :: IPv6 -> (Word32, Word32, Word32, Word32)
+ Data.IP: toIPv4w :: Word32 -> IPv4
+ Data.IP: toIPv6w :: (Word32, Word32, Word32, Word32) -> IPv6
+ Data.IP.Builder: ipBuilder :: IP -> Builder
+ Data.IP.Builder: ipv4Builder :: IPv4 -> Builder
+ Data.IP.Builder: ipv6Builder :: IPv6 -> Builder
Files
- Data/IP.hs +8/−2
- Data/IP/Addr.hs +131/−29
- Data/IP/Builder.hs +271/−0
- iproute.cabal +18/−1
- test/BuilderSpec.hs +72/−0
- test/doctests.hs +6/−1
Data/IP.hs view
@@ -5,9 +5,15 @@ -- * IP data IP (..) -- ** IPv4- , IPv4, toIPv4, fromIPv4, fromHostAddress, toHostAddress+ , IPv4+ , toIPv4, toIPv4w+ , fromIPv4, fromIPv4w+ , fromHostAddress, toHostAddress -- ** IPv6- , IPv6, toIPv6, toIPv6b, fromIPv6, fromIPv6b, fromHostAddress6, toHostAddress6+ , IPv6+ , toIPv6, toIPv6b, toIPv6w+ , fromIPv6, fromIPv6b, fromIPv6w+ , fromHostAddress6, toHostAddress6 -- ** Converters , ipv4ToIPv6 , fromSockAddr
Data/IP/Addr.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} @@ -258,85 +259,186 @@ -- {-|- The 'toIPv4' function takes a list of 'Int' and returns 'IPv4'.+ 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 = IP4 . toWord32+toIPv4 [a1, a2, a3, a4] = IP4 w where- toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4- toWord32 _ = error "toWord32"+ 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 'toIPv6' function takes a list of 'Int' and returns 'IPv6'.+ 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 ad = IP6 (x1,x2,x3,x4)+toIPv6 [i1,i2,i3,i4,i5,i6,i7,i8] = IP6 (x1,x2,x3,x4) where- [x1,x2,x3,x4] = map toWord32 $ split2 ad- split2 [] = []- split2 x = take 2 x : split2 (drop 2 x)- toWord32 [a1,a2] = fromIntegral $ shift a1 16 + a2- toWord32 _ = error "toWord32"+ !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 takes a list of 'Int'- where each member repserents a single byte and returns 'IPv6'.+ 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 ad = IP6 (x1,x2,x3,x4)+toIPv6b [ h11, h12, l11, l12, h21, h22, l21, l22+ , h31, h32, l31, l32, h41, h42, l41, l42 ] = IP6 (x1,x2,x3,x4) where- [x1,x2,x3,x4] = map toWord32 $ split4 ad- split4 [] = []- split4 x = take 4 x : split4 (drop 4 x)- toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4- toWord32 _ = error "toWord32"+ !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 converts 'IPv4' to a list of 'Int'.+ 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) = map (\n -> fromEnum $ (w `shiftR` n) .&. 0xff) [0o30, 0o20, 0o10, 0o00]+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 'toIPv6' function converts 'IPv6' to a list of 'Int'.+ 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)) = map fromEnum (concatMap split [w1,w2,w3,w4])+fromIPv6 (IP6 (w1, w2, w3, w4)) =+ split w1 . split w2 . split w3 . split w4 $ [] where- split :: Word32 -> [Word32]- split n = [n `shiftR` 0x10 .&. 0xffff, n .&. 0xffff]+ split :: Word32 -> [Int] -> [Int]+ split n acc = fromIntegral (n `unsafeShiftR` 0x10 .&. 0xffff) :+ fromIntegral (n .&. 0xffff) : acc+{-# INLINE fromIPv6 #-} {-|- The 'fromIPv6b' function converts 'IPv6' to a list of 'Int'- where each member represents a single byte.+ 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)) = map fromEnum (concatMap split [w1,w2,w3,w4])+fromIPv6b (IP6 (w1, w2, w3, w4)) =+ split w1 . split w2 . split w3 . split w4 $ [] where- split n = fmap (\s -> n `shiftR` s .&. 0xff) [24,16,8,0]+ 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 #-} ---------------------------------------------------------------- --
+ Data/IP/Builder.hs view
@@ -0,0 +1,271 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# 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 #-}++{-# INLINE ipv4Bounded #-}+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# ((a `uncheckedShiftRL#` s) `and#` 0xff##), ())+ {-# INLINE qdot #-}+ qfin (W32# a) = W8# (a `and#` 0xff##)+ {-# INLINE qfin #-}+ dotsep = const 0x2e >$< toB P.word8++-- | For each of the 32-bit chunks of an IPv6 address, encode how it should be+-- displayed in the presentation form of the address, based its location+-- relative to the "best gap", i.e. the left-most longest run of zeros. The+-- "hi" and, or "lo" parts are accompanied by occasional units mapped to colons.+--+data FF = CHL {-# UNPACK #-} ! Word32 -- ^ :<h>:<l>+ | HL {-# UNPACK #-} ! Word32 -- ^ <h>:<l>+ | NOP -- ^ nop+ | COL -- ^ :+ | CLO {-# UNPACK #-} ! Word32 -- ^ :<l>+ | CC -- ^ : :+ | CHC {-# UNPACK #-} ! Word32 -- ^ :<h>:+ | HC {-# UNPACK #-} ! Word32 -- ^ <h>:++-- Build an IPv6 address in conformance with+-- [RFC5952](http://tools.ietf.org/html/rfc5952 RFC 5952).+--+{-# INLINE ipv6Bounded #-}+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 ffCond03+ ( P.condB ffCond01+ ( P.condB ffCond0+ build_CHL -- :<h>:<l>+ build_HL ) -- <h>:<l>+ ( P.condB ffCond2+ build_NOP -- nop+ build_COL ) ) -- :+ ( P.condB ffCond45+ ( P.condB ffCond4+ build_CLO -- :<l>+ build_CC ) -- : :+ ( P.condB ffCond6+ build_CHC -- :<h>:+ build_HC ) ) -- <h>:++ -- Branch selection predicates+ ffCond03 = \case { CHL _ -> True; HL _ -> True;+ NOP -> True; COL -> True; _ -> False }+ ffCond01 = \case { CHL _ -> True; HL _ -> True; _ -> False }+ ffCond45 = \case { CC -> True; CLO _ -> True; _ -> False }+ ffCond0 = \case { CHL _ -> True; _ -> False }+ ffCond2 = \case { NOP -> True; _ -> False }+ ffCond4 = \case { CLO _ -> True; _ -> False }+ ffCond6 = \case { CHC _ -> True; _ -> False }++ -- encoders for the seven field format (FF) cases.+ --+ build_CHL = (\ (CHL w) -> ( fstUnit (hi16 w), fstUnit (lo16 w) ) )+ >$< (colsep >*< P.word16Hex)+ >*< (colsep >*< P.word16Hex)+ --+ build_HL = (\ (HL w) -> ( hi16 w, fstUnit (lo16 w) ) )+ >$< P.word16Hex >*< colsep >*< P.word16Hex+ --+ build_NOP = P.emptyB+ --+ build_COL = const () >$< colsep+ --+ build_CC = const ((), ()) >$< colsep >*< colsep+ --+ build_CLO = (\ (CLO w) -> fstUnit (lo16 w) )+ >$< colsep >*< P.word16Hex+ --+ build_CHC = (\ (CHC w) -> fstUnit (sndUnit (hi16 w)) )+ >$< colsep >*< P.word16Hex >*< colsep+ --+ build_HC = (\ (HC w) -> sndUnit (hi16 w))+ >$< 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# (w `uncheckedShiftRL#` 16#)+ lo16 !(W32# w) = W16# (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#` a3)+ (updateGap (0xffff0000## `and#` a3)+ (updateGap (0xffff## `and#` a2)+ (updateGap (0xffff0000## `and#` a2)+ (updateGap (0xffff## `and#` a1)+ (updateGap (0xffff0000## `and#` a1)+ (updateGap (0xffff## `and#` a0)+ (initGap (0xffff0000## `and#` 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 #-}
iproute.cabal view
@@ -1,5 +1,5 @@ Name: iproute-Version: 1.7.8+Version: 1.7.9 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -14,11 +14,19 @@ 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@@ -29,10 +37,13 @@ Build-Depends: base >= 4.6 && < 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@@ -42,6 +53,10 @@ 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@@ -50,12 +65,14 @@ 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
+ test/BuilderSpec.hs view
@@ -0,0 +1,72 @@+{-# 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
test/doctests.hs view
@@ -3,4 +3,9 @@ import Test.DocTest main :: IO ()-main = doctest ["-XOverloadedStrings", "Data/IP.hs", "Data/IP/RouteTable.hs"]+main = doctest [ "-XOverloadedStrings"+ , "-package=appar"+ , "-package=byteorder"+ , "-package=network"+ , "Data/IP.hs"+ , "Data/IP/RouteTable.hs"]