ip 1.7.0 → 1.7.1

raw patch · 6 files changed

+272/−44 lines, 6 filesdep +randomdep ~aesondep ~byteslicedep ~bytesmithPVP ok

version bump matches the API change (PVP)

Dependencies added: random

Dependency ranges changed: aeson, byteslice, bytesmith, primitive, small-bytearray-builder

API changes (from Hackage documentation)

Files

• ip.cabal +7/−5
• src/Net/IPv4.hs +95/−34
• src/Net/IPv6.hs +41/−0
• src/Net/Mac.hs +90/−5
• test/Bench.hs +17/−0
• test/Test.hs +22/−0

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: ip-version: 1.7.0+version: 1.7.1 synopsis: Library for IP and MAC addresses homepage: https://github.com/andrewthad/haskell-ip#readme license: BSD-3-Clause@@ -49,14 +49,14 @@     , aeson >= 1.0 && < 1.5     , attoparsec >= 0.13 && < 0.14     , base >= 4.9 && < 5-    , byteslice >= 0.1.2 && < 0.2-    , bytesmith >= 0.3 && < 0.4+    , byteslice >= 0.1.2 && < 0.3+    , bytesmith >= 0.3.3 && < 0.4     , bytestring >= 0.10.8 && < 0.11     , deepseq >= 1.4 && < 1.5     , hashable >= 1.2 && < 1.4     , natural-arithmetic >= 0.1 && <0.2     , primitive >= 0.6.4 && < 0.8-    , small-bytearray-builder >= 0.2.1 && <0.4+    , small-bytearray-builder >= 0.3.2 && <0.4     , text >= 1.2 && < 1.3     , text-short >= 0.1.3 && < 0.2     , vector >= 0.11 && < 0.13@@ -73,7 +73,7 @@     , QuickCheck     , attoparsec     , base-    , byteslice >= 0.1.2 && < 0.2+    , byteslice     , bytestring     , ip     , quickcheck-classes >= 0.4.13 && < 0.7.0.0@@ -128,7 +128,9 @@     , bytestring     , criterion     , ip+    , primitive     , text+    , random   other-modules:     IPv4ByteString1     IPv4DecodeText1

@@ -3,6 +3,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}@@ -76,6 +77,9 @@   , builderRange   , parserRange   , printRange+    -- ** UTF-8 Bytes+  , parserRangeUtf8Bytes+  , parserRangeUtf8BytesLenient     -- * Types   , IPv4(..)   , IPv4#@@ -235,51 +239,71 @@   || mask12 .&. w == p20   || mask16 .&. w == p16 +----------------------------------------+-- Note [The implementation of reserved]+----------------------------------------+-- The @reserved@ function has been optimized to perform well in the+-- microbenchmark @CIDR Inclusion/reserved@. We perform an inital case+-- on the upper three bits (8 possible values), which GHC will compile+-- to a jump table. This helps because the reserved ranges of IPv4+-- addresses are somewhat clustered. Notice that everything in+-- 32.0.0.0/3, 64.0.0.0/3, and 128.0.0.0/3 is publicly routable, and+-- everything in 224.0.0.0/3 is reserved. This means that for exactly+-- half of the IPv4 addresses that exist, this single jump is sufficient+-- for determining whether or not they are reserved. For the others,+-- there is a little more work to do, particularly in the 192.0.0.0/3+-- range. On the laptop that ran the microbenchmark, this function+-- decided the reservedness of 100 random IPv4 addresses in 200ns.+ -- | Checks to see if the 'IPv4' address belongs to a reserved -- network. This includes the three private networks that 'private' -- checks along with several other ranges that are not used--- on the public Internet.+-- on the public Internet. The implementation of this function+-- is optimized. reserved :: IPv4 -> Bool-reserved =-  let a = getIPv4 $ fromOctets' 0 0 0 0-      b = getIPv4 $ fromOctets' 100 64 0 0-      c = getIPv4 $ fromOctets' 127 0 0 0-      d = getIPv4 $ fromOctets' 169 254 0 0-      e = getIPv4 $ fromOctets' 192 0 0 0-      f = getIPv4 $ fromOctets' 192 0 2 0-      g = getIPv4 $ fromOctets' 192 88 99 0-      h = getIPv4 $ fromOctets' 198 18 0 0-      i = getIPv4 $ fromOctets' 198 51 100 0-      j = getIPv4 $ fromOctets' 203 0 113 0-      k = getIPv4 $ fromOctets' 224 0 0 0-      l = getIPv4 $ fromOctets' 240 0 0 0-      m = getIPv4 $ fromOctets' 255 255 255 255-  in \(IPv4 w) -> mask8  .&. w == p24-               || mask12 .&. w == p20-               || mask16 .&. w == p16-               || mask8  .&. w == a-               || mask10 .&. w == b-               || mask8  .&. w == c-               || mask16 .&. w == d-               || mask24 .&. w == e-               || mask24 .&. w == f-               || mask24 .&. w == g-               || mask15 .&. w == h-               || mask24 .&. w == i-               || mask24 .&. w == j-               || mask4  .&. w == k-               || mask4  .&. w == l-               || mask32 .&. w == m+reserved !(IPv4 w) = case unsafeShiftR w 29 of+  0 ->+    let a = getIPv4 $ fromOctets' 0 0 0 0+        y = getIPv4 $ fromOctets' 10 0 0 0+     in mask8  .&. w == a+     || mask8  .&. w == y+  1 -> False+  2 -> False+  3 ->+    let b = getIPv4 $ fromOctets' 100 64 0 0+        c = getIPv4 $ fromOctets' 127 0 0 0+     in mask8  .&. w == c+     || mask10 .&. w == b+  4 -> False+  5 ->+    let d = getIPv4 $ fromOctets' 169 254 0 0+        x = getIPv4 $ fromOctets' 172 16 0 0+     in mask12 .&. w == x+     || mask16 .&. w == d+  6 ->+    let e = getIPv4 $ fromOctets' 192 0 0 0+        f = getIPv4 $ fromOctets' 192 0 2 0+        g = getIPv4 $ fromOctets' 192 88 99 0+        h = getIPv4 $ fromOctets' 198 18 0 0+        i = getIPv4 $ fromOctets' 198 51 100 0+        j = getIPv4 $ fromOctets' 203 0 113 0+        z = getIPv4 $ fromOctets' 192 168 0 0+     in mask15 .&. w == h+     || mask16 .&. w == z+     || mask24 .&. w == e+     || mask24 .&. w == f+     || mask24 .&. w == g+     || mask24 .&. w == i+     || mask24 .&. w == j+  _ -> True -mask8,mask4,mask12,mask16,mask10,mask24,mask32,mask15 :: Word32-mask4  = 0xF0000000+mask8,mask12,mask16,mask10,mask24,mask15 :: Word32 mask8  = 0xFF000000 mask10 = 0xFFC00000 mask12 = 0xFFF00000 mask15 = 0xFFFE0000 mask16 = 0xFFFF0000 mask24 = 0xFFFFFF00-mask32 = 0xFFFFFFFF  -- | Checks to see if the 'IPv4' address is publicly routable. --@@ -447,6 +471,43 @@   Latin.char e '.'   !d <- Latin.decWord8 e   pure (getIPv4 (fromOctets a b c d))++-- | Parse UTF-8-encoded 'Bytes' into an 'IPv4Range'.+-- This requires the mask to be present.+--+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "192.168.0.0/16")+-- 192.168.0.0/16+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "10.10.10.1")+-- nope+--+-- See 'parserRangeUtf8BytesLenient' for a variant that treats+-- a missing mask as a @/32@ mask.+parserRangeUtf8Bytes :: e -> Parser.Parser e s IPv4Range+parserRangeUtf8Bytes e = do+  base <- parserUtf8Bytes e+  Latin.char e '/'+  theMask <- Latin.decWord8 e+  if theMask > 32+    then Parser.fail e+    else pure $! normalize (IPv4Range base theMask)++-- | Variant of 'parserRangeUtf8Bytes' that allows the mask+-- to be omitted. An omitted mask is treated as a @/32@ mask.+--+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "192.168.0.0/16")+-- 192.168.0.0/16+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "10.10.10.1")+-- 10.10.10.1/32+parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv4Range+parserRangeUtf8BytesLenient e = do+  base <- parserUtf8Bytes e+  Latin.trySatisfy (=='/') >>= \case+    True -> do+      theMask <- Latin.decWord8 e+      if theMask > 32+        then Parser.fail e+        else pure $! normalize (IPv4Range base theMask)+    False -> pure $! IPv4Range base 32  -- | Encode an 'IPv4' as a bytestring 'Builder.Builder' --

@@ -56,6 +56,9 @@   , decodeRange   , parserRange   , printRange+    -- ** UTF-8 Bytes+  , parserRangeUtf8Bytes+  , parserRangeUtf8BytesLenient     -- * Types   , IPv6(..)   , IPv6Range(..)@@ -678,6 +681,7 @@     r <- pieceParserStep e w0     pure (Just r) +-- This should probably be moved into bytesmith and renamed. pieceParser :: e -> Parser.Parser e s Word16 pieceParser e = Latin.hexNibble e >>= pieceParserStep e @@ -696,6 +700,43 @@   else Latin.tryHexNibble >>= \case     Nothing -> pure (fromIntegral acc)     Just w -> pieceParserStep e (16 * acc + w)++-- | Parse UTF-8-encoded 'Bytes' into an 'IPv4Range'.+-- This requires the mask to be present.+--+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "1b02:f001:5:200b::/80")+-- 1b02:f001:5:200b::/80+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "abcd::")+-- nope+--+-- See 'parserRangeUtf8BytesLenient' for a variant that treats+-- a missing mask as a @/32@ mask.+parserRangeUtf8Bytes :: e -> Parser.Parser e s IPv6Range+parserRangeUtf8Bytes e = do+  base <- parserUtf8Bytes e+  Latin.char e '/'+  theMask <- Latin.decWord8 e+  if theMask > 128+    then Parser.fail e+    else pure $! normalize (IPv6Range base theMask)++-- | Variant of 'parserRangeUtf8Bytes' that allows the mask+-- to be omitted. An omitted mask is treated as a @/128@ mask.+--+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "1b02:f001:5:200b::/80")+-- 1b02:f001:5:200b::/80+-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "abcd::")+-- abcd::/128+parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv6Range+parserRangeUtf8BytesLenient e = do+  base <- parserUtf8Bytes e+  Latin.trySatisfy (=='/') >>= \case+    True -> do+      theMask <- Latin.decWord8 e+      if theMask > 128+        then Parser.fail e+        else pure $! normalize (IPv6Range base theMask)+    False -> pure $! IPv6Range base 128  -- | Parse an 'IPv6' using 'Atto.Parser'. --

@@ -1,9 +1,11 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -37,6 +39,10 @@   , parserWithUtf8     -- ** ByteString   , decodeBytes+    -- ** UTF-8 Bytes+  , boundedBuilderUtf8+  , decodeUtf8Bytes+  , parserUtf8Bytes     -- ** Printing   , print     -- * Types@@ -71,11 +77,16 @@ import Text.ParserCombinators.ReadPrec (prec,step) import Text.Read (Read(..),Lexeme(Ident),lexP,parens) +import qualified Arithmetic.Nat as Nat import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Attoparsec.ByteString as AB import qualified Data.Attoparsec.ByteString as ABW import qualified Data.Attoparsec.Text as AT+import qualified Data.ByteArray.Builder.Bounded as BBB+import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Parser as Parser+import qualified Data.Bytes.Parser.Latin as Latin import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Builder.Fixed as BFB@@ -121,19 +132,25 @@   , fromIntegral w   ) +-- | This function is deprecated. It will be renamed in a future release+--   since the name is misleading.+decodeBytes :: ByteString -> Maybe Mac+{-# DEPRECATED decodeBytes "Prefer decodeOctets" #-}+decodeBytes = decodeOctets+ -- | Decode a 'Mac' address from a 'ByteString'. Each byte is interpreted --   as an octet of the 'Mac' address. Consequently, 'ByteString's --   of length 6 successfully decode, and all other 'ByteString's fail --   to decode. -----   >>> decodeBytes (B.pack [0x6B,0x47,0x18,0x90,0x55,0xC3])+--   >>> decodeOctets (B.pack [0x6B,0x47,0x18,0x90,0x55,0xC3]) --   Just (mac 0x6b47189055c3)---   >>> decodeBytes (B.replicate 6 0x3A)+--   >>> decodeOctets (B.replicate 6 0x3A) --   Just (mac 0x3a3a3a3a3a3a)---   >>> decodeBytes (B.replicate 7 0x3A)+--   >>> decodeOctets (B.replicate 7 0x3A) --   Nothing-decodeBytes :: ByteString -> Maybe Mac-decodeBytes bs = if B.length bs == 6+decodeOctets :: ByteString -> Maybe Mac+decodeOctets bs = if B.length bs == 6   then Just $ fromOctets     (BU.unsafeIndex bs 0)     (BU.unsafeIndex bs 1)@@ -398,6 +415,74 @@  decodeLenientUtf8 :: ByteString -> Maybe Mac decodeLenientUtf8 bs = rightToMaybe (AB.parseOnly (parserLenientUtf8 <* AB.endOfInput) bs)++-- | Encode a 'Mac' address as colon-separated hexadecimal octets,+--   preferring lowercase for alphabetical characters.+--+--   >>> BBB.run Nat.constant $ boundedBuilderUtf8 $ mac 0xDEADBEEF1609+--   [0x64, 0x65, 0x3a, 0x61, 0x64, 0x3a, 0x62, 0x65, 0x3a, 0x65, 0x66, 0x3a, 0x31, 0x36, 0x3a, 0x30, 0x39]+boundedBuilderUtf8 :: Mac -> BBB.Builder 17+boundedBuilderUtf8 !w =+  BBB.word8PaddedLowerHex w0+  `BBB.append`+  BBB.ascii ':'+  `BBB.append`+  BBB.word8PaddedLowerHex w1+  `BBB.append`+  BBB.ascii ':'+  `BBB.append`+  BBB.word8PaddedLowerHex w2+  `BBB.append`+  BBB.ascii ':'+  `BBB.append`+  BBB.word8PaddedLowerHex w3+  `BBB.append`+  BBB.ascii ':'+  `BBB.append`+  BBB.word8PaddedLowerHex w4+  `BBB.append`+  BBB.ascii ':'+  `BBB.append`+  BBB.word8PaddedLowerHex w5+  where+  (w0,w1,w2,w3,w4,w5) = toOctets w++-- | Lenient decoding of MAC address. This+--   is case insensitive and allows either @:@ or @-@ as the separator.+--   It also allows leading zeroes to be missing.+--+--   >>> decodeUtf8Bytes (Bytes.fromAsciiString "A2:DE:AD:BE:EF:67")+--   Just (mac 0xa2deadbeef67)+--   >>> decodeUtf8Bytes (Bytes.fromAsciiString "13-a2-FE-A4-17-96")+--   Just (mac 0x13a2fea41796)+decodeUtf8Bytes :: Bytes.Bytes -> Maybe Mac+decodeUtf8Bytes = Parser.parseBytesMaybe (parserUtf8Bytes ())++-- | Leniently parse UTF-8-encoded 'Bytes' as a 'Mac' address. This+--   is case insensitive and allows either @:@ or @-@ as the separator.+--   It also allows leading zeroes to be missing.+--+--   >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString "de:ad:BE:EF:1:23")+--   Success (Slice {offset = 16, length = 0, value = mac 0xdeadbeef0123})+parserUtf8Bytes :: e -> Parser.Parser e s Mac+parserUtf8Bytes e = do+  w1 <- Latin.hexWord8 e+  Latin.any e >>= \case+    ':' -> do+      w2 <- Latin.hexWord8 e <* Latin.char e ':'+      w3 <- Latin.hexWord8 e <* Latin.char e ':'+      w4 <- Latin.hexWord8 e <* Latin.char e ':'+      w5 <- Latin.hexWord8 e <* Latin.char e ':'+      w6 <- Latin.hexWord8 e+      pure (fromOctets w1 w2 w3 w4 w5 w6)+    '-' -> do+      w2 <- Latin.hexWord8 e <* Latin.char e '-'+      w3 <- Latin.hexWord8 e <* Latin.char e '-'+      w4 <- Latin.hexWord8 e <* Latin.char e '-'+      w5 <- Latin.hexWord8 e <* Latin.char e '-'+      w6 <- Latin.hexWord8 e+      pure (fromOctets w1 w2 w3 w4 w5 w6)+    _ -> Parser.fail e  -- | Make a bytestring builder from a 'Mac' address --   using a colon as the separator.

@@ -3,6 +3,9 @@ import Criterion.Main import Net.Types (IPv4(..),MacGrouping(..),MacCodec(..)) import Data.Maybe (fromJust)+import Data.Primitive (PrimArray,foldlPrimArray')+import Data.Bool (bool)+import System.Random (mkStdGen,randoms) import qualified Data.Bytes as Bytes import qualified Data.Text as Text import qualified Net.Mac as Mac@@ -15,6 +18,7 @@ import qualified IPv4ByteString1 import qualified IPv4DecodeText1 import qualified IPv4DecodeText2+import qualified GHC.Exts as Exts -- import qualified IPv4TextVariableBuilder  main :: IO ()@@ -36,6 +40,7 @@       ip6Skip = fromJust $ IPv6.decode ip6TextSkip       ip6TextHex = Text.pack "a:b::c:d"       ip6Hex = fromJust $ IPv6.decode ip6TextHex+      hundredAddrs = Exts.fromList (map IPv4 (take 100 (randoms (mkStdGen 42)))) :: PrimArray IPv4   defaultMain     [ bgroup "Mac to Text"       [ bench "Current Implementation, pairs" $ whnf Mac.encode mac@@ -95,4 +100,16 @@       , bench "a:b::c:d" $ whnf IPv6.encodeShort ip6Hex       , bench "2001:db8:ba1:0:aaaa:542c:bb:cc00" $ whnf IPv6.encodeShort ip6Complicated       ]+    , bgroup "CIDR Inclusion"+      [ bench "reserved" $ whnf manyReserved hundredAddrs+      , bench "private" $ whnf manyPrivate hundredAddrs+      ]     ]++manyReserved :: PrimArray IPv4 -> Int+{-# noinline manyReserved #-}+manyReserved x = foldlPrimArray' (\acc addr -> bool 0 1 (IPv4.reserved addr) + acc) 0 x++manyPrivate :: PrimArray IPv4 -> Int+{-# noinline manyPrivate #-}+manyPrivate x = foldlPrimArray' (\acc addr -> bool 0 1 (IPv4.private addr) + acc) 0 x

@@ -118,6 +118,28 @@     , testProperty "Normalize does not affect membership" propNormalizeMember     , testProperty "Membership agrees with bounds" propMemberUpperLower     , testProperty "Range contains self" propRangeSelf+    , testGroup "reserved"+      [ PH.testCase "A" $ IPv4.reserved (IPv4.ipv4 0 1 2 3) @=? True+      , PH.testCase "B" $ IPv4.reserved (IPv4.ipv4 1 0 0 0) @=? False+      , PH.testCase "C" $ IPv4.reserved (IPv4.ipv4 100 64 0 3) @=? True+      , PH.testCase "D" $ IPv4.reserved (IPv4.ipv4 127 255 255 255) @=? True+      , PH.testCase "E" $ IPv4.reserved (IPv4.ipv4 110 0 0 255) @=? False+      , PH.testCase "F" $ IPv4.reserved (IPv4.ipv4 192 0 2 255) @=? True+      , PH.testCase "G" $ IPv4.reserved (IPv4.ipv4 203 0 113 0) @=? True+      , PH.testCase "H" $ IPv4.reserved (IPv4.ipv4 225 0 0 0) @=? True+      , PH.testCase "I" $ IPv4.reserved (IPv4.ipv4 226 0 0 0) @=? True+      , PH.testCase "J" $ IPv4.reserved (IPv4.ipv4 255 255 255 254) @=? True+      , PH.testCase "K" $ IPv4.reserved (IPv4.ipv4 255 255 255 255) @=? True+      , PH.testCase "L" $ IPv4.reserved (IPv4.ipv4 224 0 0 0) @=? True+      , PH.testCase "M" $ IPv4.reserved (IPv4.ipv4 239 255 255 255) @=? True+      , PH.testCase "N" $ IPv4.reserved (IPv4.ipv4 223 255 255 255) @=? False+      , PH.testCase "O" $ IPv4.reserved (IPv4.ipv4 203 0 114 0) @=? False+      , PH.testCase "P" $ IPv4.reserved (IPv4.ipv4 203 0 112 255) @=? False+      , PH.testCase "Q" $ IPv4.reserved (IPv4.ipv4 203 0 113 255) @=? True+      , PH.testCase "R" $ IPv4.reserved (IPv4.ipv4 192 88 100 0) @=? False+      , PH.testCase "S" $ IPv4.reserved (IPv4.ipv4 192 88 99 0) @=? True+      , PH.testCase "T" $ IPv4.reserved (IPv4.ipv4 192 0 1 0) @=? False+      ]     ]   , testGroup "IPv6 Range Operations"     [ testProperty "Idempotence of normalizing IPv6 range"