ip 1.5.1 → 1.6.0

raw patch · 9 files changed

+722/−132 lines, 9 filesdep +byteslicedep +bytesmithdep +natural-arithmeticdep −test-frameworkdep −test-framework-hunitdep −test-framework-quickcheck2dep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: byteslice, bytesmith, natural-arithmetic, small-bytearray-builder, tasty, tasty-hunit, tasty-quickcheck, text-short

Dependencies removed: test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

Files

• ip.cabal +47/−39
• src/Net/IP.hs +50/−0
• src/Net/IPv4.hs +145/−4
• src/Net/IPv6.hs +365/−33
• src/Net/Mac.hs +0/−3
• test/Bench.hs +33/−10
• test/IPv4Text1.hs +0/−1
• test/IPv4Text2.hs +0/−1
• test/Test.hs +82/−41

@@ -1,9 +1,9 @@-cabal-version: 2.0+cabal-version: 2.2 name: ip-version: 1.5.1+version: 1.6.0 synopsis: Library for IP and MAC addresses homepage: https://github.com/andrewthad/haskell-ip#readme-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Andrew Martin maintainer: andrew.thaddeus@gmail.com@@ -34,26 +34,31 @@ library   hs-source-dirs: src   exposed-modules:-    Net.Mac+    Net.IP     Net.IPv4     Net.IPv6-    Net.IP+    Net.Mac     Net.Types   other-modules:-    Data.Word.Synthetic.Word12+    Data.ByteString.Builder.Fixed+    Data.Text.Builder.Common.Internal     Data.Text.Builder.Fixed     Data.Text.Builder.Variable-    Data.Text.Builder.Common.Internal-    Data.ByteString.Builder.Fixed+    Data.Word.Synthetic.Word12   build-depends:-      base >= 4.9.1.0 && < 5     , aeson >= 1.0 && < 1.5     , attoparsec >= 0.13 && < 0.14-    , bytestring >= 0.10 && < 0.11+    , base >= 4.9.1.0 && < 5+    , byteslice >= 0.1.2 && < 0.2+    , bytesmith >= 0.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-    , text >= 1.2  && < 1.3+    , small-bytearray-builder >= 0.2.1 && <0.3+    , text >= 1.2 && < 1.3+    , text-short >= 0.1.3 && < 0.2     , vector >= 0.11 && < 0.13     , wide-word >= 0.1.0.8 && < 0.2   ghc-options: -Wall -O2@@ -64,38 +69,40 @@   hs-source-dirs:      test   main-is:             Test.hs   build-depends:-      base-    , ip-    , wide-word-    , test-framework-    , test-framework-quickcheck2+    , HUnit     , QuickCheck+    , attoparsec+    , base+    , byteslice >= 0.1.2 && < 0.2+    , bytestring+    , ip     , quickcheck-classes >= 0.4.13 && < 0.7.0.0+    , tasty+    , tasty-hunit+    , tasty-quickcheck     , text-    , bytestring-    , HUnit-    , test-framework-hunit-    , attoparsec+    , text-short+    , wide-word   other-modules:-    Naive+    IPv4ByteString1     IPv4Text1     IPv4Text2-    IPv4ByteString1+    Naive   ghc-options: -Wall -O2   default-language: Haskell2010  test-suite spec-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Spec.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs   build-depends:-      base+    , base+    , hspec >= 2.5.5     , ip     , wide-word-    , hspec >= 2.5.5   other-modules:-    Net.IPv4Spec     Net.IPv4.RangeSpec+    Net.IPv4Spec   ghc-options: -Wall -O2   default-language: Haskell2010   build-tool-depends: hspec-discover:hspec-discover >= 2.5.5@@ -105,29 +112,30 @@   hs-source-dirs: test   main-is: Doctests.hs   build-depends:-      base+    , QuickCheck+    , base+    , doctest >= 0.10     , ip     , wide-word-    , doctest >= 0.10-    , QuickCheck   default-language:    Haskell2010  benchmark criterion   type: exitcode-stdio-1.0   build-depends:-      base-    , ip+    , attoparsec+    , base+    , byteslice+    , bytestring     , criterion+    , ip     , text-    , bytestring-    , attoparsec   other-modules:-    Naive-    IPv4Text1-    IPv4Text2+    IPv4ByteString1     IPv4DecodeText1     IPv4DecodeText2-    IPv4ByteString1+    IPv4Text1+    IPv4Text2+    Naive   ghc-options: -Wall -O2   default-language: Haskell2010   hs-source-dirs: test

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}  {-# OPTIONS_GHC -Wall #-}@@ -39,7 +40,12 @@     -- * Textual Conversion     -- ** Text   , encode+  , encodeShort   , decode+  , decodeShort+  , boundedBuilderUtf8+    -- ** Bytes+  , parserUtf8Bytes     -- ** Printing   , print     -- * Types@@ -49,6 +55,7 @@ import Control.DeepSeq (NFData) import Data.Aeson (FromJSON(..),ToJSON(..)) import Data.Bits+import Data.Coerce (coerce) import Data.Text (Text) import Data.WideWord (Word128(..)) import Data.Word (Word8,Word16)@@ -58,13 +65,19 @@ import Prelude hiding (print) import Text.ParserCombinators.ReadPrec ((+++)) import Text.Read (Read(..))+import Data.Text.Short (ShortText)++import qualified Arithmetic.Lte as Lte import qualified Data.Aeson as Aeson+import qualified Data.ByteArray.Builder.Bounded as BB import qualified Data.Text.IO as TIO+import qualified Data.Bytes.Parser as Parser import qualified Net.IPv4 as IPv4 import qualified Net.IPv6 as IPv6  -- $setup -- >>> :set -XOverloadedStrings+-- >>> import qualified Arithmetic.Nat as Nat  -- | Run a function over an 'IP' depending on its status --   as an 'IPv4' or 'IPv6'.@@ -113,6 +126,25 @@ encode :: IP -> Text encode = case_ IPv4.encode IPv6.encode +-- | Encode an 'IP' as 'ShortText'.+--+--   >>> encodeShort (ipv4 10 0 1 26)+--   "10.0.1.26"+--+--   >>> encodeShort (ipv6 0x3124 0x0 0x0 0xDEAD 0xCAFE 0xFF 0xFE01 0x0000)+--   "3124::dead:cafe:ff:fe01:0"+encodeShort :: IP -> ShortText+encodeShort = case_ IPv4.encodeShort IPv6.encodeShort++-- | Encode an 'IP' as a bounded bytearray builder.+--+-- >>> BB.run Nat.constant (boundedBuilderUtf8 (ipv4 192 168 2 14))+-- [0x31, 0x39, 0x32, 0x2e, 0x31, 0x36, 0x38, 0x2e, 0x32, 0x2e, 0x31, 0x34]+boundedBuilderUtf8 :: IP -> BB.Builder 39+boundedBuilderUtf8 = case_+  (\y -> BB.weaken Lte.constant (IPv4.boundedBuilderUtf8 y))+  IPv6.boundedBuilderUtf8+ -- | Decode an 'IP' from 'Text'. -- --   >>> decode "10.0.0.25"@@ -132,6 +164,24 @@     Nothing -> Nothing     Just v6 -> Just (fromIPv6 v6)   Just v4 -> Just (fromIPv4 v4)++-- | Decode an 'IP' from 'ShortText'.+--+--   >>> decodeShort "10.0.0.25"+--   Just (ipv4 10 0 0 25)+--   >>> decodeShort "::dead:cafe"+--   Just (ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0xdead 0xcafe)+decodeShort :: ShortText -> Maybe IP+decodeShort t+  | Just x <- IPv4.decodeShort t = Just (fromIPv4 x)+  | otherwise = coerce (IPv6.decodeShort t)++-- | Parse UTF-8-encoded 'Bytes' as an 'IP' address.+parserUtf8Bytes :: e -> Parser.Parser e s IP+parserUtf8Bytes e =+  fmap fromIPv4 (IPv4.parserUtf8Bytes ())+  `Parser.orElse`+  coerce (IPv6.parserUtf8Bytes e)  -- | Is the 'IP' an IPv4 address? --

@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-}@@ -33,11 +34,18 @@   , builder   , reader   , parser+  , decodeShort+  , encodeShort     -- ** UTF-8 ByteString   , encodeUtf8   , decodeUtf8   , builderUtf8   , parserUtf8+    -- ** UTF-8 Bytes+  , decodeUtf8Bytes+  , parserUtf8Bytes+  , byteArrayBuilderUtf8+  , boundedBuilderUtf8     -- ** String     -- $string   , encodeString@@ -69,7 +77,14 @@   , printRange     -- * Types   , IPv4(..)+  , IPv4#   , IPv4Range(..)+    -- * Unboxing+    -- | These functions are useful for micro-optimizing+    --   when GHC does a poor job with worker-wrapper.+  , box+  , unbox+  , parserUtf8Bytes#     -- * Interoperability     -- $interoperability   ) where@@ -81,30 +96,41 @@ import Data.Aeson (ToJSONKey(..),FromJSONKey(..),ToJSONKeyFunction(..),FromJSONKeyFunction(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,unsafeShiftR,complement,shift) import Data.ByteString (ByteString)+import Data.Coerce (coerce) import Data.Hashable-import Data.Monoid ((<>)) import Data.Primitive.Types (Prim) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8') import Data.Text.Internal (Text(..))+import Data.Text.Short (ShortText) import Data.Vector.Generic.Mutable (MVector(..)) import Data.Word import Foreign.Ptr (Ptr,plusPtr) import Foreign.Storable (Storable, poke)+import GHC.Exts (Word#) import GHC.Generics (Generic)+import GHC.Word (Word32(W32#)) import Prelude hiding (any, print, print) import Text.ParserCombinators.ReadPrec (prec,step) import Text.Printf (printf) 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.Char8 as AB import qualified Data.Attoparsec.Text as AT import qualified Data.Bits as Bits+import qualified Data.ByteArray.Builder.Bounded as BB+import qualified Data.ByteArray.Builder as UB import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Internal as I import qualified Data.ByteString.Unsafe as ByteString+import qualified Data.ByteString.Short.Internal as BSS+import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Parser as Parser+import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Primitive as PM import qualified Data.Text as Text import qualified Data.Text.Array as TArray import qualified Data.Text.IO as TIO@@ -112,6 +138,8 @@ import qualified Data.Text.Lazy.Builder as TBuilder import qualified Data.Text.Lazy.Builder.Int as TBI import qualified Data.Text.Read as TextRead+import qualified Data.Text.Short as TS+import qualified Data.Text.Short.Unsafe as TS import qualified Data.Vector.Generic as GVector import qualified Data.Vector.Generic.Mutable as MGVector import qualified Data.Vector.Primitive as PVector@@ -348,15 +376,116 @@ -- --   >>> decodeUtf8 "192.168.2.47" --   Just (ipv4 192 168 2 47)+--+--   Currently not terribly efficient since the implementation+--   re-encodes the argument as UTF-16 text before decoding that+--   IPv4 address from that. PRs to fix this are welcome. decodeUtf8 :: ByteString -> Maybe IPv4 decodeUtf8 = decode <=< rightToMaybe . decodeUtf8' -- This (decodeUtf8) should be rewritten to not go through text -- as an intermediary. --- | Encode an 'IPv4' as a 'Builder.Builder'+-- | Decode 'ShortText' as an 'IPv4' address.+--+--   >>> decodeShort "192.168.3.48"+--   Just (ipv4 192 168 3 48)+decodeShort :: ShortText -> Maybe IPv4+decodeShort t = decodeUtf8Bytes (Bytes.fromByteArray b)+  where b = shortByteStringToByteArray (TS.toShortByteString t)++-- | Encode an 'IPv4' address as 'ShortText'.+--+--   >>> encodeShort (ipv4 192 168 5 99)+--   "192.168.5.99"+encodeShort :: IPv4 -> ShortText+encodeShort !w = id+  $ TS.fromShortByteStringUnsafe+  $ byteArrayToShortByteString+  $ BB.run Nat.constant+  $ boundedBuilderUtf8+  $ w++shortByteStringToByteArray :: BSS.ShortByteString -> PM.ByteArray+shortByteStringToByteArray (BSS.SBS x) = PM.ByteArray x++byteArrayToShortByteString :: PM.ByteArray -> BSS.ShortByteString+byteArrayToShortByteString (PM.ByteArray x) = BSS.SBS x++-- | Decode UTF-8-encoded 'Bytes' into an 'IPv4' address.+--+--   >>> decodeUtf8Bytes (Bytes.fromAsciiString "127.0.0.1")+--   Just (ipv4 127 0 0 1)+decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv4+decodeUtf8Bytes !b = case Parser.parseBytes (parserUtf8Bytes ()) b of+  Parser.Success (Parser.Slice _ len addr) -> case len of+    0 -> Just addr+    _ -> Nothing+  Parser.Failure _ -> Nothing++-- | Parse UTF-8-encoded 'Bytes' as an 'IPv4' address.+--+--   >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString "10.0.1.254")+--   Success (Slice {offset = 10, length = 0, value = ipv4 10 0 1 254})+parserUtf8Bytes :: e -> Parser.Parser e s IPv4+{-# inline parserUtf8Bytes #-}+parserUtf8Bytes e = coerce (Parser.boxWord32 (parserUtf8Bytes# e))++-- | Variant of 'parserUtf8Bytes' with unboxed result type.+parserUtf8Bytes# :: e -> Parser.Parser e s IPv4#+{-# noinline parserUtf8Bytes# #-}+parserUtf8Bytes# e = Parser.unboxWord32 $ do+  !a <- Latin.decWord8 e+  Latin.char e '.'+  !b <- Latin.decWord8 e+  Latin.char e '.'+  !c <- Latin.decWord8 e+  Latin.char e '.'+  !d <- Latin.decWord8 e+  pure (getIPv4 (fromOctets a b c d))++-- | Encode an 'IPv4' as a bytestring 'Builder.Builder'+--+-- >>> Builder.toLazyByteString (builderUtf8 (fromOctets 192 168 2 12))+-- "192.168.2.12" builderUtf8 :: IPv4 -> Builder.Builder builderUtf8 = Builder.byteString . encodeUtf8 +-- | Encode an 'IPv4' address as a unbounded byte array builder.+--+-- >>> UB.run 1 (byteArrayBuilderUtf8 (fromOctets 192 168 2 13))+-- [0x31, 0x39, 0x32, 0x2e, 0x31, 0x36, 0x38, 0x2e, 0x32, 0x2e, 0x31, 0x33]+--+-- Note that period is encoded by UTF-8 as @0x2e@.+byteArrayBuilderUtf8 :: IPv4 -> UB.Builder+byteArrayBuilderUtf8 = UB.fromBounded Nat.constant . boundedBuilderUtf8++-- | Encode an 'IPv4' address as a bounded byte array builder.+--+-- >>> BB.run Nat.constant (boundedBuilderUtf8 (fromOctets 192 168 2 14))+-- [0x31, 0x39, 0x32, 0x2e, 0x31, 0x36, 0x38, 0x2e, 0x32, 0x2e, 0x31, 0x34]+--+-- Note that period is encoded by UTF-8 as @0x2e@.+boundedBuilderUtf8 :: IPv4 -> BB.Builder 15+boundedBuilderUtf8 (IPv4 !w) =+  BB.word8Dec w1+  `BB.append`+  BB.ascii '.'+  `BB.append`+  BB.word8Dec w2+  `BB.append`+  BB.ascii '.'+  `BB.append`+  BB.word8Dec w3+  `BB.append`+  BB.ascii '.'+  `BB.append`+  BB.word8Dec w4+  where+  w1 = fromIntegral (shiftR w 24) :: Word8+  w2 = fromIntegral (shiftR w 16) :: Word8+  w3 = fromIntegral (shiftR w 8) :: Word8+  w4 = fromIntegral w :: Word8+ -- | Parse an 'IPv4' using a 'AB.Parser'. -- --   >>> AB.parseOnly parserUtf8 "192.168.2.47"@@ -398,6 +527,20 @@ decodeString = decode . Text.pack  +-- | Unboxed variant of 'IPv4'. Before GHC 8.10, this is+-- implemented as a type synonym. Portable use of this type requires+-- treating it as though it were opaque. Use 'box' and 'unbox' to+-- convert between this and the lifted 'IPv4'.+type IPv4# = Word#++-- | Convert an unboxed IPv4 address to a boxed one. +box :: IPv4# -> IPv4+box w = IPv4 (W32# w)++-- | Convert a boxed IPv4 address to an unboxed one. +unbox :: IPv4 -> IPv4#+unbox (IPv4 (W32# w)) = w+ -- | A 32-bit Internet Protocol version 4 address. To use this with the --   @network@ library, it is necessary to use @Network.Socket.htonl@ to --   convert the underlying 'Word32' from host byte order to network byte@@ -486,7 +629,6 @@ instance FromJSON IPv4 where   parseJSON = Aeson.withText "IPv4" aesonParser -#if MIN_VERSION_aeson(1,0,0) instance ToJSONKey IPv4 where   toJSONKey = ToJSONKeyText     encode@@ -494,7 +636,6 @@  instance FromJSONKey IPv4 where   fromJSONKey = FromJSONKeyTextParser aesonParser-#endif  aesonParser :: Text -> Aeson.Parser IPv4 aesonParser t = case decode t of

@@ -1,11 +1,14 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE InstanceSigs               #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeInType                 #-}-{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UnboxedTuples #-}  {-| This module provides the IPv6 data type and functions for working     with it.@@ -27,8 +30,14 @@     -- * Textual Conversion     -- ** Text   , encode+  , encodeShort   , decode+  , decodeShort   , parser+    -- * UTF-8 Bytes+  , parserUtf8Bytes+  , decodeUtf8Bytes+  , boundedBuilderUtf8     -- ** Printing   , print     -- * IPv6 Ranges@@ -51,34 +60,47 @@   , IPv6Range(..)   ) where +import Prelude hiding (any, print)+ import Net.IPv4 (IPv4(..))-import qualified Net.IPv4 as IPv4  import Control.Applicative import Control.DeepSeq (NFData)+import Control.Monad.ST (ST) import Data.Bits import Data.Char (chr) import Data.List (intercalate, group)+import Data.Primitive (MutablePrimArray) import Data.Primitive.Types (Prim)-#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup ((<>))-#endif-import qualified Data.Aeson as Aeson-import qualified Data.Attoparsec.Text as AT-import qualified Data.Attoparsec.Text as Atto import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as TIO+import Data.Text.Short (ShortText) import Data.WideWord.Word128 (Word128(..), zeroWord128) import Data.Word import Foreign.Storable (Storable)-import GHC.Exts+import GHC.Exts (Int#,Word#,Int(I#)) import GHC.Generics (Generic)+import GHC.Word (Word16(W16#)) import Numeric (showHex)-import Prelude hiding (any, print) import Text.ParserCombinators.ReadPrec (prec,step) import Text.Read (Read(..),Lexeme(Ident),lexP,parens) +import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Data.Aeson as Aeson+import qualified Data.Attoparsec.Text as AT+import qualified Data.Attoparsec.Text as Atto+import qualified Data.ByteArray.Builder.Bounded as BB+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.Short.Internal as BSS+import qualified Data.Primitive as PM+import qualified Data.Text as Text+import qualified Data.Text.IO as TIO+import qualified Data.Text.Short.Unsafe as TS+import qualified Data.Text.Short as TS+import qualified Net.IPv4 as IPv4+ -- $setup -- -- These are here to get doctest work.@@ -120,6 +142,17 @@ print :: IPv6 -> IO () print = TIO.putStrLn . encode +-- | Decode 'ShortText' as an 'IPv6' address.+--+--   >>> decodeShort "ffff::2:b"+--   Just (ipv6 0xffff 0x0000 0x0000 0x0000 0x0000 0x0000 0x0002 0x000b)+decodeShort :: ShortText -> Maybe IPv6+decodeShort t = decodeUtf8Bytes (Bytes.fromByteArray b)+  where b = shortByteStringToByteArray (TS.toShortByteString t)++shortByteStringToByteArray :: BSS.ShortByteString -> PM.ByteArray+shortByteStringToByteArray (BSS.SBS x) = PM.ByteArray x+ showHexWord16 :: Word16 -> ShowS showHexWord16 w =     showString "0x"@@ -318,8 +351,8 @@ any :: IPv6 any = IPv6 zeroWord128 --- | Encodes the IP, using zero-compression on the leftmost-longest string of--- zeroes in the address.+-- | Encodes the 'IPv6' address using zero-compression on the leftmost longest+-- string of zeroes in the address. -- Per <https://tools.ietf.org/html/rfc5952#section-5 RFC 5952 Section 5>, -- this uses mixed notation when encoding an IPv4-mapped IPv6 address: --@@ -329,20 +362,29 @@ -- ::ffff:100.55.165.180 -- >>> T.putStrLn $ encode $ fromWord16s 0x0 0x0 0x0 0x0 0x0 0x0 0x0 0x0 -- ::+--+-- Per <https://tools.ietf.org/html/rfc5952#section-4.2.2 Section 4.2.2> of the+-- same RFC, this does not use @::@ to shorten a single 16-bit 0 field. Only+-- runs of multiple 0 fields are considered. encode :: IPv6 -> Text-encode ip =-  if isIPv4MappedAddress-  -- This representation is RECOMMENDED by https://tools.ietf.org/html/rfc5952#section-5-  then Text.pack "::ffff:" `mappend` IPv4.encode (IPv4.IPv4 (fromIntegral w7 `unsafeShiftL` 16 .|. fromIntegral w8))-  else toText [w1, w2, w3, w4, w5, w6, w7, w8]+encode !ip =+  -- TODO: This implementation, while correct, is not particularly efficient.+  -- It uses string all over the place.+  if isIPv4Mapped ip+    -- This representation is RECOMMENDED by https://tools.ietf.org/html/rfc5952#section-5+    then+      Text.pack "::ffff:"+      `mappend`+      IPv4.encode (IPv4.IPv4 (fromIntegral w7 `unsafeShiftL` 16 .|. fromIntegral w8))+    else toText [w1, w2, w3, w4, w5, w6, w7, w8]   where-  isIPv4MappedAddress = w1 == 0 && w2 == 0 && w3 == 0 && w4 == 0 && w5 == 0 && w6 == 0xFFFF   (w1, w2, w3, w4, w5, w6, w7, w8) = toWord16s ip-  toText ws = Text.pack $ intercalate ":" $ expand 0 longestZ grouped+  toText ws = Text.pack $ intercalate ":"+      $ expand 0 (if longestZ > 1 then longestZ else 0) grouped     where-    expand _ 8 _ = ["::"]-    expand _ _ [] = []-    expand i longest ((x, len):wsNext)+    expand !_ 8 !_ = ["::"]+    expand !_ !_ [] = []+    expand !i !longest ((x, len):wsNext)         -- zero-compressed group:         | x == 0 && len == longest =             -- first and last need an extra colon since there's nothing@@ -354,15 +396,305 @@     longestZ = maximum . (0:) . map snd . filter ((==0) . fst) $ grouped     grouped = map (\x -> (head x, length x)) (group ws) --- | Decode an IPv6 address. This accepts both standard IPv6+isIPv4Mapped :: IPv6 -> Bool+isIPv4Mapped (IPv6 (Word128 w1 w2)) =+  w1 == 0 && (0xFFFFFFFF00000000 .&. w2 == 0x0000FFFF00000000)++-- | Decode UTF-8-encoded 'Bytes' into an 'IPv6' address.+--+--   >>> decodeUtf8Bytes (Bytes.fromAsciiString "::cab:1")+--   Just (ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0cab 0x0001)+decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv6+decodeUtf8Bytes !b = case Parser.parseBytes (parserUtf8Bytes ()) b of+  Parser.Success (Parser.Slice _ len addr) -> case len of+    0 -> Just addr+    _ -> Nothing+  Parser.Failure _ -> Nothing++-- | Encodes the 'IPv6' address using zero-compression on the+-- leftmost longest string of zeroes in the address.+--+-- >>> BB.run Nat.constant $ boundedBuilderUtf8 $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234+-- [0x64, 0x65, 0x61, 0x64, 0x3a, 0x62, 0x65, 0x65, 0x66, 0x3a, 0x3a, 0x31, 0x32, 0x33, 0x34]+boundedBuilderUtf8 :: IPv6 -> BB.Builder 39+boundedBuilderUtf8 !ip@(IPv6 (Word128 hi lo))+  | hi == 0 && lo == 0 = BB.weaken Lte.constant+      (BB.ascii ':' `BB.append` BB.ascii ':')+  | isIPv4Mapped ip = BB.weaken Lte.constant $+      BB.ascii ':'+      `BB.append`+      BB.ascii ':'+      `BB.append`+      BB.ascii 'f'+      `BB.append`+      BB.ascii 'f'+      `BB.append`+      BB.ascii 'f'+      `BB.append`+      BB.ascii 'f'+      `BB.append`+      BB.ascii ':'+      `BB.append`+      IPv4.boundedBuilderUtf8 (IPv4.IPv4 (fromIntegral lo))+  | otherwise =+      let (w0,w1,w2,w3,w4,w5,w6,w7) = toWord16s ip+          IntTriple startLongest longest _ = longestRun w0 w1 w2 w3 w4 w5 w6 w7+          start = startLongest+          end = start + longest+          -- start is inclusive. end is exclusive+       in firstPiece w0 start+          `BB.append`+          piece 1 w1 start end+          `BB.append`+          piece 2 w2 start end+          `BB.append`+          piece 3 w3 start end+          `BB.append`+          piece 4 w4 start end+          `BB.append`+          piece 5 w5 start end+          `BB.append`+          piece 6 w6 start end+          `BB.append`+          lastPiece w7 end++firstPiece :: Word16 -> Int -> BB.Builder 4+firstPiece !w !start = case start of+  0 -> BB.weaken Lte.constant (BB.ascii ':')+  _ -> BB.word16LowerHex w++-- Note about the implementation of piece:+-- It is important to manually perform worker-wrapper so that+-- we can stop piece from inlining. If we do not do this, GHC+-- inlines piece, leading to enormous blowup in the generated+-- Core. The implementation of boundedBuilderUtf8 becomes+-- thousands of lines of Core. Even in the microbenchmark that+-- comes with this library, it can be observed that preventing+-- this inlining improves performance of encodeShort by 50%.+piece :: Int -> Word16 -> Int -> Int -> BB.Builder 5+{-# inline piece #-}+piece (I# ix) (W16# w) (I# start) (I# end) =+  piece# ix w start end++piece# :: Int# -> Word# -> Int# -> Int# -> BB.Builder 5+{-# noinline piece# #-}+piece# !ix# !w# !start# !end# = case compare ix start of+  LT -> BB.ascii ':' `BB.append` BB.word16LowerHex w+  EQ -> BB.weaken Lte.constant (BB.ascii ':')+  GT -> if ix < end+    then BB.weaken Lte.constant BB.empty+    else BB.ascii ':' `BB.append` BB.word16LowerHex w+  where+  ix = I# ix#+  start = I# start#+  end = I# end#+  w = W16# w#++lastPiece :: Word16 -> Int -> BB.Builder 5+lastPiece !w !end = case end of+  8 -> BB.weaken Lte.constant (BB.ascii ':')+  _ -> BB.ascii ':' `BB.append` BB.word16LowerHex w++data IntTriple = IntTriple !Int !Int !Int++-- Choose the longest run. Prefer the leftmost run in the+-- event of a tie.+stepZeroRunLength :: Int -> Word16 -> IntTriple -> IntTriple+stepZeroRunLength !ix !w (IntTriple startLongest longest current) = case w of+  0 -> let !x = current + 1 in+    if x > longest+      then IntTriple (ix - current) x x+      else IntTriple startLongest longest x+  _ -> IntTriple startLongest longest 0++-- We start out by setting the longest run to size 1. This+-- means that we will only detect runs of length two or greater.+longestRun ::+     Word16+  -> Word16+  -> Word16+  -> Word16+  -> Word16+  -> Word16+  -> Word16+  -> Word16+  -> IntTriple+longestRun !w0 !w1 !w2 !w3 !w4 !w5 !w6 !w7 = id+  $ stepZeroRunLength 7 w7+  $ stepZeroRunLength 6 w6+  $ stepZeroRunLength 5 w5+  $ stepZeroRunLength 4 w4+  $ stepZeroRunLength 3 w3+  $ stepZeroRunLength 2 w2+  $ stepZeroRunLength 1 w1+  $ stepZeroRunLength 0 w0+  $ IntTriple (-1) 1 0++-- | Encodes the 'IPv6' address as 'ShortText' using zero-compression on+-- the leftmost longest string of zeroes in the address.+-- Per <https://tools.ietf.org/html/rfc5952#section-5 RFC 5952 Section 5>,+-- this uses mixed notation when encoding an IPv4-mapped IPv6 address.+-- +-- >>> encodeShort $ fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0ABC 0x0 0x1234+-- "dead:beef::abc:0:1234"+encodeShort :: IPv6 -> ShortText+encodeShort w = id+  $ TS.fromShortByteStringUnsafe+  $ byteArrayToShortByteString+  $ BB.run Nat.constant+  $ boundedBuilderUtf8+  $ w++byteArrayToShortByteString :: PM.ByteArray -> BSS.ShortByteString+byteArrayToShortByteString (PM.ByteArray x) = BSS.SBS x++-- | Decode an 'IPv6' address. This accepts both standard IPv6 -- notation (with zero compression) and mixed notation for--- IPv4-mapped IPv6 addresses.+-- IPv4-mapped IPv6 addresses. For a decoding function that+-- additionally accepts dot-decimal-encoded IPv4 addresses,+-- see @Net.IP.decode@. decode :: Text -> Maybe IPv6 decode t = rightToMaybe (AT.parseOnly (parser <* AT.endOfInput) t) +-- | Parse UTF-8-encoded 'Bytes' as an 'IPv6' address. This accepts+-- both uppercase and lowercase characters in the hexadecimal components.+--+-- >>> let str = "dead:beef:3240:a426:ba68:1cd0:4263:109b -> alive"+-- >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString str)+-- Success (Slice {offset = 39, length = 9, value = ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b})+--+-- This does not currently support parsing embedded IPv4 address+-- (e.g. @ff00:8000:abc::224.1.2.3@).+parserUtf8Bytes :: e -> Parser.Parser e s IPv6+parserUtf8Bytes e = do+  marr <- Parser.effect (PM.newPrimArray 8)+  -- We cannot immidiately call preZeroes since it wants a+  -- leading colon present.+  Latin.trySatisfy (== ':') >>= \case+    True -> do+      Latin.char e ':'+      postZeroesBegin e marr 0 0+    False -> do+      w <- pieceParser e+      Parser.effect (PM.writePrimArray marr 0 w)+      preZeroes e marr 1++-- This is called when we are positioned before a colon.+-- We may encounter another colon immidiately after+-- the one that we consume here. This indicates zero+-- compression. Or we may encounter another hex-encoded+-- number.+preZeroes ::+     e+  -> MutablePrimArray s Word16 -- length must be 8+  -> Int+  -> Parser.Parser e s IPv6+preZeroes e !marr !ix = case ix of+  8 -> Parser.effect (combinePieces marr)+  _ -> do+    Latin.char e ':'+    Latin.trySatisfy (== ':') >>= \case+      True -> postZeroesBegin e marr ix ix+      False -> do+        w <- pieceParser e+        Parser.effect (PM.writePrimArray marr ix w)+        preZeroes e marr (ix + 1)++-- The same as postZeroes except that there is no+-- leading that gets consumed. This is called right+-- after a double colon is consumed.+-- Precondition: the index is less than 8. This parser+-- is only called by preZeroes, which ensures that+-- this holds.+postZeroesBegin ::+     e+  -> MutablePrimArray s Word16 -- length must be 8+  -> Int -- current index in array+  -> Int -- index where compression happened+  -> Parser.Parser e s IPv6+postZeroesBegin e !marr !ix !compress = do+  optionalPieceParser e >>= \case+    Nothing -> do -- the end has come+      Parser.effect (conclude marr ix compress)+    Just w -> do+      Parser.effect (PM.writePrimArray marr ix w)+      postZeroes e marr (ix + 1) compress++-- Should be run right before a colon.+postZeroes :: +     e+  -> MutablePrimArray s Word16 -- length must be 8+  -> Int -- current index in array+  -> Int -- index where compression happened+  -> Parser.Parser e s IPv6+postZeroes e !marr !ix !compress = case ix of+  8 -> Parser.fail e+  _ -> do+    Latin.trySatisfy (== ':') >>= \case+      False -> -- The end has come+        Parser.effect (conclude marr ix compress)+      True -> do+        w <- pieceParser e+        Parser.effect (PM.writePrimArray marr ix w)+        postZeroes e marr (ix + 1) compress++conclude :: MutablePrimArray s Word16 -> Int -> Int -> ST s IPv6+conclude !marr !ix !compress = do+  -- This will overlap, but GHC's copy primop is fine with that.+  let postCompressionLen = ix - compress+  PM.copyMutablePrimArray marr (8 - postCompressionLen) marr compress postCompressionLen+  let compressedArea = 8 - ix+  PM.setPrimArray marr compress compressedArea (0 :: Word16)+  combinePieces marr++-- Example memmove that may need to happen:+-- A B C H  ==> A B C 0 0 0 0 H+--       *+-- ix = 4, compress = 3, postCompressionLen = 1, compressedArea = 4+-- copyPrimArray marr 7 marr 3 1+-- setPrimArray marr 3 4 (0 :: Word16)++combinePieces ::+     MutablePrimArray s Word16+  -> ST s IPv6+combinePieces !marr = fromWord16s+  <$> PM.readPrimArray marr 0+  <*> PM.readPrimArray marr 1+  <*> PM.readPrimArray marr 2+  <*> PM.readPrimArray marr 3+  <*> PM.readPrimArray marr 4+  <*> PM.readPrimArray marr 5+  <*> PM.readPrimArray marr 6+  <*> PM.readPrimArray marr 7++optionalPieceParser :: e -> Parser.Parser e s (Maybe Word16)+optionalPieceParser e = Latin.tryHexNibble >>= \case+  Nothing -> pure Nothing+  Just w0 -> do+    r <- pieceParserStep e w0+    pure (Just r)++pieceParser :: e -> Parser.Parser e s Word16+pieceParser e = Latin.hexNibble e >>= pieceParserStep e++-- Parses the remainder of a lowercase hexadecimal number.+-- Leaves trailing colons alone. This fails if there are+-- more than four hex digits unless there are leading zeroes.+-- I cannot find a spec that is clear about what to do+-- if someone puts 00000 in a piece of an encoded IPv6+-- address, so I veer on the side of leniency.+pieceParserStep ::+     e+  -> Word+  -> Parser.Parser e s Word16+pieceParserStep e !acc = if acc > 0xFFFF+  then Parser.fail e+  else Latin.tryHexNibble >>= \case+    Nothing -> pure (fromIntegral acc)+    Just w -> pieceParserStep e (16 * acc + w)+ -- | Parse an 'IPv6' using 'Atto.Parser'. -----   >>> ip = ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B --   >>> Atto.parseOnly parser (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b") --   Right (ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b) parser :: Atto.Parser IPv6

@@ -60,7 +60,6 @@ #endif import Data.Text (Text) import Data.Word-import Data.Word (Word8) import Data.Word.Synthetic.Word12 (Word12) import GHC.Enum (predError, succError) import GHC.Exts@@ -756,7 +755,6 @@ instance ToJSON Mac where   toJSON = Aeson.String . encode -#if MIN_VERSION_aeson(1,0,0)  instance ToJSONKey Mac where   toJSONKey = ToJSONKeyText     encode@@ -766,7 +764,6 @@   fromJSONKey = FromJSONKeyTextParser $ \t -> case decode t of     Nothing -> fail "invalid mac address"     Just addr -> return addr-#endif  instance FromJSON Mac where   parseJSON = attoparsecParseJSON parser

@@ -3,6 +3,7 @@ import Criterion.Main import Net.Types (IPv4(..),MacGrouping(..),MacCodec(..)) import Data.Maybe (fromJust)+import qualified Data.Bytes as Bytes import qualified Data.Text as Text import qualified Net.Mac as Mac import qualified Net.IPv4 as IPv4@@ -20,11 +21,17 @@ main = do   let ipAddr = IPv4 1000000009       ipText = Text.pack "192.168.5.99"+      ipBytes = Bytes.fromAsciiString "192.168.5.99"       mac = Mac.fromOctets 0xFA 0xBB 0x43 0xA1 0x22 0x09       ip6Text = Text.pack "::"       ip6 = fromJust $ IPv6.decode ip6Text-      ip6TextBigger = Text.pack "1:2:3:4:5:6:7:8"+      ip6StrBigger = "1:2:3:4:5:6:7:8"+      ip6TextBigger = Text.pack ip6StrBigger+      ip6BytesBigger = Bytes.fromAsciiString "1:2:3:4:5:6:7:8"       ip6Bigger = fromJust $ IPv6.decode ip6TextBigger+      ip6ComplicatedStr = "2001:db8:ba1:0:aaaa:542c:bb:cc00"+      ip6ComplicatedBytes = Bytes.fromAsciiString ip6ComplicatedStr+      ip6Complicated = fromJust $ IPv6.decode (Text.pack ip6ComplicatedStr)       ip6TextSkip = Text.pack "1:2::7:8"       ip6Skip = fromJust $ IPv6.decode ip6TextSkip       ip6TextHex = Text.pack "a:b::c:d"@@ -44,6 +51,9 @@       , bench "Current Implementation, no separator"           $ whnf (Mac.encodeWithUtf8 (MacCodec MacGroupingNoSeparator True)) mac       ]+    , bgroup "IPv4 to ShortText"+      [ bench "Implementation" $ whnf IPv4.encodeShort ipAddr+      ]     , bgroup "IPv4 to Text"       [ bench "Naive" $ whnf Naive.encodeText ipAddr       , bench "Text Builder" $ whnf IPv4Text2.encode ipAddr@@ -55,21 +65,34 @@       , bench "Attoparsec" $ whnf IPv4DecodeText2.decodeText ipText       , bench "Text Reader" $ whnf IPv4DecodeText1.decodeText ipText       ]+    , bgroup "IPv4 from Bytes"+      [ bench "Current" $ whnf IPv4.decodeUtf8Bytes ipBytes+      ]     , bgroup "IPv4 to ByteString"       [ bench "Naive" $ whnf Naive.encodeByteString ipAddr       , bench "Preallocated: No Lookup Tables" $ whnf IPv4ByteString1.encode ipAddr       , bench "Preallocated" $ whnf IPv4.encodeUtf8 ipAddr       ]+    , bgroup "IPv6 from Text"+      [ bench "::" $ whnf IPv6.decode ip6Text+      , bench "1:2:3:4:5:6:7:8" $ whnf IPv6.decode ip6TextBigger+      , bench "1:2::7:8" $ whnf IPv6.decode ip6TextSkip+      , bench "a:b::c:d" $ whnf IPv6.decode ip6TextHex+      ]+    , bgroup "IPv6 bytesmith"+      [ bench "1:2:3:4:5:6:7:8" $ whnf IPv6.decodeUtf8Bytes ip6BytesBigger+      , bench "2001:db8:ba1:0:aaaa:542c:bb:cc00" $ whnf IPv6.decodeUtf8Bytes ip6ComplicatedBytes+      ]     , bgroup "IPv6 to Text"-      [ bench "New '::'" $ whnf IPv6.decode ip6Text-      , bench "New '1:2:3:4:5:6:7:8'" $ whnf IPv6.decode ip6TextBigger-      , bench "New '1:2::7:8'" $ whnf IPv6.decode ip6TextSkip-      , bench "New 'a:b::c:d'" $ whnf IPv6.decode ip6TextHex+      [ bench "::" $ whnf IPv6.encode ip6+      , bench "1:2:3:4:5:6:7:8" $ whnf IPv6.encode ip6Bigger+      , bench "1:2::7:8" $ whnf IPv6.encode ip6Skip+      , bench "a:b::c:d" $ whnf IPv6.encode ip6Hex       ]-    , bgroup "IPv6 from Text"-      [ bench "New '::'" $ whnf IPv6.encode ip6-      , bench "New '1:2:3:4:5:6:7:8'" $ whnf IPv6.encode ip6Bigger-      , bench "New '1:2::7:8'" $ whnf IPv6.encode ip6Skip-      , bench "New 'a:b::c:d'" $ whnf IPv6.encode ip6Hex+    , bgroup "IPv6 to ShortText"+      [ bench "1:2:3:4:5:6:7:8" $ whnf IPv6.encodeShort ip6Bigger+      , bench "1:2::7:8" $ whnf IPv6.encodeShort ip6Skip+      , bench "a:b::c:d" $ whnf IPv6.encodeShort ip6Hex+      , bench "2001:db8:ba1:0:aaaa:542c:bb:cc00" $ whnf IPv6.encodeShort ip6Complicated       ]     ]

@@ -2,7 +2,6 @@  import Net.Types (IPv4(..)) import Data.Text (Text)-import Data.Monoid ((<>)) import Data.Text.Internal (Text(..)) import Data.Word import Data.ByteString (ByteString)

@@ -3,7 +3,6 @@ import Net.Types (IPv4(..)) import Data.Text (Text) import Data.Bits ((.&.),shiftR)-import Data.Monoid ((<>)) import Data.Text.Lazy.Builder.Int (decimal) import qualified Data.Text.Lazy         as LText import qualified Data.Text.Lazy.Builder as TBuilder

@@ -7,20 +7,23 @@  import Naive import Control.Applicative (liftA2)+import Data.Bytes (Bytes) import Data.Proxy (Proxy(..))-import Test.Framework (defaultMain, testGroup, Test)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(..),Property,oneof,Gen,elements,choose,(===))+import Test.Tasty (defaultMain, testGroup, TestTree)+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck (Arbitrary(..),oneof,Gen,elements,choose,(===)) import Test.HUnit (Assertion,(@?=),(@=?)) import Numeric (showHex) import Test.QuickCheck.Property (failed,succeeded,Result(..)) import Data.Bifunctor-import Test.QuickCheck.Classes (Laws(..),jsonLaws,showReadLaws,bitsLaws,primLaws,boundedEnumLaws)-import qualified Test.Framework.Providers.HUnit as PH+import Test.QuickCheck.Classes (Laws(..),jsonLaws,showReadLaws,primLaws,boundedEnumLaws)+import qualified Test.Tasty.HUnit as PH  import Net.Types (IP,IPv4(..),IPv4Range(..),Mac(..),IPv6(..),MacGrouping(..),MacCodec(..),IPv6Range(..)) import Data.WideWord (Word128(..))+import qualified Data.Bytes as Bytes import qualified Data.Text as Text+import qualified Data.Text.Short as TS import qualified Data.ByteString.Char8 as BC8 import qualified Net.IPv4 as IPv4 import qualified Net.IPv6 as IPv6@@ -38,14 +41,23 @@ main :: IO () main = defaultMain tests -tests :: [Test]-tests =+tests :: TestTree+tests = testGroup "tests"   [ testGroup "Encoding and Decoding"     [ testGroup "Currently used IPv4 encode/decode" $       [ testProperty "Isomorphism"           $ propEncodeDecodeIso IPv4.encode IPv4.decode       , PH.testCase "Decode an IP" testIPv4Decode       ] ++ testDecodeFailures+    , testGroup "Currently used IPv4 encodeShort/decodeShort" $+      [ testProperty "Isomorphism"+          $ propEncodeDecodeIso IPv4.encodeShort IPv4.decodeShort+      ] ++ testDecodeFailures+    , testGroup "Currently used IPv4 UTF-8 Bytes decode"+      [ testProperty "Isomorphism"+          $ propEncodeDecodeIso (byteStringToBytes . IPv4.encodeUtf8) IPv4.decodeUtf8Bytes+      , PH.testCase "Encode a MAC Address" testMacEncode+      ]     , testGroup "Currently used MAC Text encode/decode"       [ testProperty "Isomorphism"           $ propEncodeDecodeIsoSettings Mac.encodeWith Mac.decodeWith@@ -84,9 +96,20 @@       [ PH.testCase "Parser Test Cases" testIPv4Parser       ]     , testGroup "IPv6 encode/decode"-      [ PH.testCase "Parser Test Cases" testIPv6Parser-      , PH.testCase "Encode test cases" testIPv6Encode-      , PH.testCase "Parser Failure Test Cases" testIPv6ParserFailure+      [ PH.testCase "Parser Test Cases" $ testIPv6Parser $ \str -> +          either (\_ -> Nothing) (Just . HexIPv6)+            (AT.parseOnly+              (IPv6.parser <* AT.endOfInput)+              (Text.pack str)+            )+      , PH.testCase "Bytes Parser Test Cases" $ testIPv6Parser $ \str ->+          fmap HexIPv6 (IPv6.decodeUtf8Bytes (Bytes.fromAsciiString str))+      , PH.testCase "Encode test cases" (testIPv6Encode IPv6.encode)+      , PH.testCase "Encode ShortText" (testIPv6Encode (TS.toText . IPv6.encodeShort))+      , PH.testCase "Parser Failure Test Cases"+          (testIPv6ParserFailure expectIPv6ParserFailure)+      , PH.testCase "Bytes Parser Failure Test Cases"+          (testIPv6ParserFailure expectIPv6BytesParserFailure)       ]     ]   , testGroup "IPv4 Range Operations"@@ -148,11 +171,21 @@     ]   ] -lawsToTest :: Laws -> Test+lawsToTest :: Laws -> TestTree lawsToTest (Laws name pairs) = testGroup name (map (uncurry testProperty) pairs) -propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool-propEncodeDecodeIso f g a = g (f a) == Just a+propEncodeDecodeIso :: (Eq a, Show a, Show b)+  => (a -> b) -> (b -> Maybe a) -> a -> Result+propEncodeDecodeIso f g a =+  let fa = f a+      gfa = g fa+   in if gfa == Just a+        then succeeded+        else failure $ concat+          [ "x:       ", show a, "\n"+          , "f(x):    ", show fa, "\n"+          , "g(f(x)): ", show gfa, "\n"+          ]  propEncodeDecodeIsoSettings :: (Eq a,Show a,Show b,Show e)   => (e -> a -> b) -> (e -> b -> Maybe a) -> e -> a -> Result@@ -211,8 +244,8 @@           (BC8.pack str)         ) -testIPv6Parser :: Assertion-testIPv6Parser = do+testIPv6Parser :: (String -> Maybe HexIPv6) -> Assertion+testIPv6Parser decode = do   -- Basic test   go 0xABCD 0x1234 0xABCD 0x1234 0xDCBA 0x4321 0xFFFF 0xE0E0      "ABCD:1234:ABCD:1234:DCBA:4321:FFFF:E0E0"@@ -234,22 +267,19 @@      "AAAA:0000:0000:0000:BBBB::ABCD:1234"   where   go a b c d e f g h str =-    Right (HexIPv6 (IPv6.fromWord16s a b c d e f g h))-    @=? fmap HexIPv6-      (AT.parseOnly-        (IPv6.parser <* AT.endOfInput)-        (Text.pack str)-      )+    Just (HexIPv6 (IPv6.fromWord16s a b c d e f g h))+    @=?+    decode str -testIPv6ParserFailure :: Assertion-testIPv6ParserFailure = do+testIPv6ParserFailure :: (String -> Assertion) -> Assertion+testIPv6ParserFailure go = do   -- must not start or end in colon:   go ":::"   go "1::2:"-  go ":1::2"-  go "1:::"-  go ":1::"-  go "::1:"+  go ":1::3"+  go "a:::"+  go ":b::"+  go "::c:"   go "1:2:3:4:5:6:777:8:"   go ":1:2:3:4:5:6:7777:8" @@ -284,17 +314,26 @@   -- IPv4 decimal embedded, with too many parts:   go "1:2:3:4:5:6:7:127.0.0.1"   go "1:2:3:4:5:6:7:8:127.0.0.1"-  where-  go str =-    Left ()-    @=? bimap (\_ -> ()) HexIPv6-      (AT.parseOnly-        (IPv6.parser <* AT.endOfInput)-        (Text.pack str)) -testIPv6Encode :: Assertion-testIPv6Encode = do+expectIPv6ParserFailure :: String -> Assertion+expectIPv6ParserFailure str =+  Left ()+  @=?+  bimap (\_ -> ()) HexIPv6+    (AT.parseOnly+      (IPv6.parser <* AT.endOfInput)+      (Text.pack str)+    ) +expectIPv6BytesParserFailure :: String -> Assertion+expectIPv6BytesParserFailure s =+  Nothing+  @=?+  IPv6.decodeUtf8Bytes (Bytes.fromAsciiString s)++testIPv6Encode :: (IPv6 -> Text.Text) -> Assertion+testIPv6Encode enc = do+   -- degenerate cases:   "::" `roundTripsTo` "::"   "1234::" `roundTripsTo` "1234::"@@ -304,7 +343,7 @@   "1234:1234:0000:0000:0000:0000:3456:3434" `roundTripsTo` "1234:1234::3456:3434"    -- picks first case:-  "1234:0000:1234:0000:1234:0000:0123:1234" `roundTripsTo` "1234::1234:0:1234:0:123:1234"+  "1234:0000:1234:0000:1234:0000:0123:1234" `roundTripsTo` "1234:0:1234:0:1234:0:123:1234"    -- picks longest case:   "1234:0000:1234:0000:0:0000:0123:1234" `roundTripsTo` "1234:0:1234::123:1234"@@ -319,8 +358,8 @@   "1:2:3:4:5:6:7:8" `roundTripsTo` "1:2:3:4:5:6:7:8"    -- works with only first or last:-  "::2:3:4:5:6:7:8" `roundTripsTo` "::2:3:4:5:6:7:8"-  "1:2:3:4:5:6:7::" `roundTripsTo` "1:2:3:4:5:6:7::"+  "::2:3:4:5:6:7:8" `roundTripsTo` "0:2:3:4:5:6:7:8"+  "1:2:3:4:5:6:7::" `roundTripsTo` "1:2:3:4:5:6:7:0"    -- decimal notation in IPv6 addresses:   "1:2:3:4:5:6:0.7.0.8" `roundTripsTo` "1:2:3:4:5:6:7:8"@@ -335,7 +374,7 @@  where  roundTripsTo s sExpected =    case AT.parseOnly (IPv6.parser <* AT.endOfInput) (Text.pack s) of-      Right result -> IPv6.encode result @?= Text.pack sExpected+      Right result -> enc result @?= Text.pack sExpected       Left failMsg -> fail ("failed to parse '" ++ s ++ "': " ++ failMsg)  textBadIPv4 :: [String]@@ -350,7 +389,7 @@   , "1.9"   ] -testDecodeFailures :: [Test]+testDecodeFailures :: [TestTree] testDecodeFailures = flip map textBadIPv4 $ \str ->   PH.testCase ("Should fail to decode [" ++ str ++ "]") $ IPv4.decode (Text.pack str) @?= Nothing @@ -449,3 +488,5 @@ arbitraryMacSeparator :: Gen Char arbitraryMacSeparator = elements [':','-','.','_'] +byteStringToBytes :: BC8.ByteString -> Bytes+byteStringToBytes = Bytes.fromAsciiString . BC8.unpack