ip 0.8.1 → 0.8.3

raw patch · 12 files changed

+603/−63 lines, 12 filesdep +HUnitdep +test-framework-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, test-framework-hunit

API changes (from Hackage documentation)

Files

• ip.cabal +8/−2
• src/Net/IPv4/Range.hs +1/−0
• src/Net/IPv4/Range/Text.hs +42/−0
• src/Net/IPv4/Text.hs +6/−1
• src/Net/Internal.hs +136/−24
• src/Net/Mac/Text.hs +7/−2
• src/Net/Types.hs +246/−20
• test/ArbitraryInstances.hs +1/−2
• test/Bench.hs +10/−1
• test/IPv4DecodeText1.hs +55/−0
• test/IPv4DecodeText2.hs +48/−0
• test/Test.hs +43/−11

@@ -1,5 +1,5 @@ name:                ip-version:             0.8.1+version:             0.8.3 synopsis:            Library for IP and MAC addresses description:         Please see README.md homepage:            https://github.com/andrewthad/haskell-ip#readme@@ -20,6 +20,7 @@     Net.Mac.ByteString.Char8     Net.IPv4     Net.IPv4.Range+    Net.IPv4.Range.Text     Net.IPv4.String     Net.IPv4.Text     Net.IPv4.ByteString.Char8@@ -34,7 +35,7 @@     , bytestring  >= 0.10 && < 0.11     , vector      >= 0.11 && < 0.12     , primitive-  ghc-options:         -Wall+  ghc-options:         -Wall -O2   default-language:    Haskell2010  test-suite test@@ -49,6 +50,8 @@     , QuickCheck     , text     , bytestring+    , HUnit+    , test-framework-hunit   other-modules:     ArbitraryInstances     Naive@@ -77,10 +80,13 @@     , criterion     , text     , bytestring+    , attoparsec   other-modules:     Naive     IPv4Text1     IPv4Text2+    IPv4DecodeText1+    IPv4DecodeText2     IPv4ByteString1   ghc-options:         -Wall -O2   default-language:    Haskell2010

@@ -1,6 +1,7 @@ module Net.IPv4.Range   ( -- * Range functions     normalize+  , contains   , member   , lowerInclusive   , upperInclusive

@@ -0,0 +1,42 @@+module Net.IPv4.Range.Text+  ( encode+  , decode+  , decodeEither+  , builder+  , parser+  , print+  ) where++import Prelude hiding (print)+import Net.Types (IPv4Range(..),IPv4(..))+import Data.Text (Text)+import Data.Word (Word8, Word32)+import qualified Data.Text.IO           as Text+import qualified Data.Attoparsec.Text   as AT+import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Net.Internal           as Internal++encode :: IPv4Range -> Text+encode (IPv4Range (IPv4 w) r) = Internal.rangeToDotDecimalText w r++decodeEither :: Text -> Either String IPv4Range+decodeEither = Internal.rangeFromDotDecimalText' mkIPv4Range++decode :: Text -> Maybe IPv4Range+decode = Internal.rightToMaybe . decodeEither++builder :: IPv4Range -> TBuilder.Builder+builder (IPv4Range (IPv4 w) r) = Internal.rangeToDotDecimalBuilder w r++parser :: AT.Parser IPv4Range+parser = Internal.dotDecimalRangeParser mkIPv4Range++-- | This exists mostly for testing purposes.+print :: IPv4Range -> IO ()+print = Text.putStrLn . encode++-- internal function+mkIPv4Range :: Word32 -> Word8 -> IPv4Range+mkIPv4Range w = IPv4Range (IPv4 w)+{-# INLINE mkIPv4Range #-}+

@@ -3,6 +3,7 @@   , decode   , decodeEither   , builder+  , reader   , parser   , print   ) where@@ -12,6 +13,7 @@ import Net.IPv4 import Data.Text (Text) import Data.Coerce (coerce)+import qualified Data.Text.Read         as Text (Reader) import qualified Data.Text.IO           as Text import qualified Data.Attoparsec.Text   as AT import qualified Data.Text.Lazy.Builder as TBuilder@@ -21,13 +23,16 @@ encode = Internal.toDotDecimalText . getIPv4  decodeEither :: Text -> Either String IPv4-decodeEither = coerce . Internal.fromDotDecimalText'+decodeEither = coerce . Internal.decodeIPv4TextEither  decode :: Text -> Maybe IPv4 decode = Internal.rightToMaybe . decodeEither  builder :: IPv4 -> TBuilder.Builder builder = Internal.toDotDecimalBuilder . getIPv4++reader :: Text.Reader IPv4+reader = coerce Internal.decodeIPv4TextReader  parser :: AT.Parser IPv4 parser = coerce Internal.dotDecimalParser

@@ -7,6 +7,8 @@ import Data.Text.Internal (Text(..)) import Data.ByteString (ByteString) import Data.Text.Lazy.Builder.Int (decimal)+import Control.Monad+import qualified Data.Text              as Text import qualified Data.Text.Lazy         as LText import qualified Data.Attoparsec.Text   as AT import qualified Data.Aeson.Types       as Aeson@@ -15,8 +17,14 @@ import qualified Data.ByteString        as ByteString import qualified Data.ByteString.Unsafe as ByteString import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Data.Text.Read         as TextRead import qualified Data.Text.Lazy.Builder.Int as TBuilder +eitherToAesonParser :: Either String a -> Aeson.Parser a+eitherToAesonParser x = case x of+  Left err -> fail err+  Right a -> return a+ attoparsecParseJSON :: AT.Parser a -> Aeson.Value -> Aeson.Parser a attoparsecParseJSON p v =   case v of@@ -26,6 +34,38 @@         Right res -> return res     _ -> fail "expected a String" +stripDecimal :: Text -> Either String Text+stripDecimal t = case Text.uncons t of+  Nothing -> Left "expected a dot but input ended instead"+  Just (c,tnext) -> if c == '.'+    then Right tnext+    else Left "expected a dot but found a different character"+{-# INLINE stripDecimal #-}++decodeIPv4TextReader :: TextRead.Reader Word32+decodeIPv4TextReader t1' = do+  (a,t2) <- TextRead.decimal t1'+  t2' <- stripDecimal t2+  (b,t3) <- TextRead.decimal t2'+  t3' <- stripDecimal t3+  (c,t4) <- TextRead.decimal t3'+  t4' <- stripDecimal t4+  (d,t5) <- TextRead.decimal t4'+  if a > 255 || b > 255 || c > 255 || d > 255+    then Left ipOctetSizeErrorMsg+    else Right (fromOctets' a b c d,t5)+{-# INLINE decodeIPv4TextReader #-}++decodeIPv4TextEither :: Text -> Either String Word32+decodeIPv4TextEither t = case decodeIPv4TextReader t of+  Left err -> Left err+  Right (w,t') -> if Text.null t'+    then Right w+    else Left "expected end of text but it continued instead"++ipOctetSizeErrorMsg :: String+ipOctetSizeErrorMsg = "All octets in an IPv4 address must be between 0 and 255"+ rightToMaybe :: Either a b -> Maybe b rightToMaybe = either (const Nothing) Just @@ -95,6 +135,40 @@   get2 = fromIntegral . ByteString.unsafeIndex twoDigits   get3 = fromIntegral . ByteString.unsafeIndex threeDigits +putMac :: ByteString -> Int -> Int -> TArray.MArray s -> ST s ()+putMac hexPairs pos w marr = do+  let i = w + w+  TArray.unsafeWrite marr pos $ fromIntegral $ ByteString.unsafeIndex hexPairs i+  TArray.unsafeWrite marr (pos + 1) $ fromIntegral $ ByteString.unsafeIndex hexPairs (i + 1)+{-# INLINE putMac #-}++macToTextPreAllocated :: Word8 -> Bool -> Word16 -> Word32 -> Text+macToTextPreAllocated separator' isUpperCase wa wb =+  let w1 = fromIntegral $ 255 .&. shiftR wa 8+      w2 = fromIntegral $ 255 .&. wa+      w3 = fromIntegral $ 255 .&. shiftR wb 24+      w4 = fromIntegral $ 255 .&. shiftR wb 16+      w5 = fromIntegral $ 255 .&. shiftR wb 8+      w6 = fromIntegral $ 255 .&. wb+      hexPairs = if isUpperCase then twoHexDigits else twoHexDigitsLower+      separator = fromIntegral separator' :: Word16+      arr = runST $ do+        marr <- TArray.new 17+        putMac hexPairs 0 w1 marr+        TArray.unsafeWrite marr 2 separator+        putMac hexPairs 3 w2 marr+        TArray.unsafeWrite marr 5 separator+        putMac hexPairs 6 w3 marr+        TArray.unsafeWrite marr 8 separator+        putMac hexPairs 9 w4 marr+        TArray.unsafeWrite marr 11 separator+        putMac hexPairs 12 w5 marr+        TArray.unsafeWrite marr 14 separator+        putMac hexPairs 15 w6 marr+        TArray.unsafeFreeze marr+  in Text arr 0 17+{-# INLINE macToTextPreAllocated #-}+ zero :: Word16 zero = 48 {-# INLINE zero #-}@@ -103,30 +177,7 @@ i2w v = zero + fromIntegral v {-# INLINE i2w #-} -twoDigits :: ByteString-twoDigits = BC8.pack-  "0001020304050607080910111213141516171819\-  \2021222324252627282930313233343536373839\-  \4041424344454647484950515253545556575859\-  \6061626364656667686970717273747576777879\-  \8081828384858687888990919293949596979899" -threeDigits :: ByteString-threeDigits =-  ByteString.replicate 300 0 <> BC8.pack-  "100101102103104105106107108109110111112\-  \113114115116117118119120121122123124125\-  \126127128129130131132133134135136137138\-  \139140141142143144145146147148149150151\-  \152153154155156157158159160161162163164\-  \165166167168169170171172173174175176177\-  \178179180181182183184185186187188189190\-  \191192193194195196197198199200201202203\-  \204205206207208209210211212213214215216\-  \217218219220221222223224225226227228229\-  \230231232233234235236237238239240241242\-  \243244245246247248249250251252253254255"- fromDotDecimalText' :: Text -> Either String Word32 fromDotDecimalText' t =   AT.parseOnly (dotDecimalParser <* AT.endOfInput) t@@ -167,7 +218,7 @@   where   limitSize i =     if i > 255-      then fail "All octets in an ip address must be between 0 and 255"+      then fail ipOctetSizeErrorMsg       else return i  -- | This is sort of a misnomer. It takes Word32 to make@@ -253,3 +304,64 @@ macFromText' f = AT.parseOnly (macTextParser f <* AT.endOfInput) {-# INLINE macFromText' #-} +twoDigits :: ByteString+twoDigits = BC8.pack+  "0001020304050607080910111213141516171819\+  \2021222324252627282930313233343536373839\+  \4041424344454647484950515253545556575859\+  \6061626364656667686970717273747576777879\+  \8081828384858687888990919293949596979899"++threeDigits :: ByteString+threeDigits =+  ByteString.replicate 300 0 <> BC8.pack+  "100101102103104105106107108109110111112\+  \113114115116117118119120121122123124125\+  \126127128129130131132133134135136137138\+  \139140141142143144145146147148149150151\+  \152153154155156157158159160161162163164\+  \165166167168169170171172173174175176177\+  \178179180181182183184185186187188189190\+  \191192193194195196197198199200201202203\+  \204205206207208209210211212213214215216\+  \217218219220221222223224225226227228229\+  \230231232233234235236237238239240241242\+  \243244245246247248249250251252253254255"++twoHexDigits :: ByteString+twoHexDigits = BC8.pack+  "000102030405060708090A0B0C0D0E0F\+  \101112131415161718191A1B1C1D1E1F\+  \202122232425262728292A2B2C2D2E2F\+  \303132333435363738393A3B3C3D3E3F\+  \404142434445464748494A4B4C4D4E4F\+  \505152535455565758595A5B5C5D5E5F\+  \606162636465666768696A6B6C6D6E6F\+  \707172737475767778797A7B7C7D7E7F\+  \808182838485868788898A8B8C8D8E8F\+  \909192939495969798999A9B9C9D9E9F\+  \A0A1A2A3A4A5A6A7A8A9AAABACADAEAF\+  \B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF\+  \C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF\+  \D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF\+  \E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF\+  \F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF"++twoHexDigitsLower :: ByteString+twoHexDigitsLower = BC8.pack+  "000102030405060708090a0b0c0d0e0f\+  \101112131415161718191a1b1c1d1e1f\+  \202122232425262728292a2b2c2d2e2f\+  \303132333435363738393a3b3c3d3e3f\+  \404142434445464748494a4b4c4d4e4f\+  \505152535455565758595a5b5c5d5e5f\+  \606162636465666768696a6b6c6d6e6f\+  \707172737475767778797a7b7c7d7e7f\+  \808182838485868788898a8b8c8d8e8f\+  \909192939495969798999a9b9c9d9e9f\+  \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\+  \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\+  \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\+  \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\+  \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\+  \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"

@@ -4,9 +4,10 @@   , decodeEither   , builder   , parser+  , encodeWith   ) where -import Net.Types (Mac(..))+import Net.Types (Mac(..),MacEncoding(..)) import Net.Mac (fromOctetsNoCast) import Data.Text (Text) import qualified Net.Internal as Internal@@ -14,7 +15,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder  encode :: Mac -> Text-encode (Mac a b) = Internal.macToText a b+encode (Mac a b) = Internal.macToTextPreAllocated 58 False a b  decodeEither :: Text -> Either String Mac decodeEither = Internal.macFromText' fromOctetsNoCast@@ -27,4 +28,8 @@  parser :: AT.Parser Mac parser = Internal.macTextParser fromOctetsNoCast++encodeWith :: MacEncoding -> Mac -> Text+encodeWith (MacEncoding separator isUpperCase) (Mac a b) =+  Internal.macToTextPreAllocated separator isUpperCase a b 

@@ -11,12 +11,15 @@   ( IPv4(..)   , IPv4Range(..)   , Mac(..)+  , MacEncoding(..)   ) where  import qualified Net.Internal         as Internal import qualified Data.Aeson           as Aeson import qualified Data.Aeson.Types     as Aeson import qualified Data.Attoparsec.Text as AT+-- import qualified Data.Vector.Generic            as G+-- import qualified Data.Vector.Generic.Mutable    as M import qualified Data.Vector.Generic            as GVector import qualified Data.Vector.Unboxed            as UVector import qualified Data.Vector.Primitive          as PVector@@ -46,14 +49,40 @@   , ipv4RangeLength :: {-# UNPACK #-} !Word8   } deriving (Eq,Ord,Show,Read,Generic) +-- | A 48-bit MAC address.+data Mac = Mac+  { macA :: {-# UNPACK #-} !Word16+  , macB :: {-# UNPACK #-} !Word32+  }+  deriving (Eq,Ord,Show,Read,Generic)++data MacEncoding = MacEncoding+  { macEncodingSeparator :: {-# UNPACK #-} !Word8 -- ^ ASCII value of the separator+  , macEncodingUpperCase :: {-# UNPACK #-} !Bool+  } deriving (Eq,Ord,Show,Read,Generic)++instance Hashable Mac++instance ToJSON Mac where+  toJSON (Mac a b) = Aeson.String (Internal.macToText a b)++instance FromJSON Mac where+  parseJSON = Internal.attoparsecParseJSON+    (Internal.macTextParser macFromOctets' <* AT.endOfInput)++macFromOctets' :: Word16 -> Word16 -> Word32 -> Word32 -> Word32 -> Word32 -> Mac+macFromOctets' a b c d e f = Mac+    ( shiftL a 8 .|. b )+    ( shiftL c 24 .|. shiftL d 16 .|. shiftL e 8 .|. f )+{-# INLINE macFromOctets' #-}+ instance Hashable IPv4Range  instance ToJSON IPv4 where   toJSON (IPv4 addr) = Aeson.String (Internal.toDotDecimalText addr)  instance FromJSON IPv4 where-  parseJSON = Internal.attoparsecParseJSON-    (coerce (Internal.dotDecimalParser <* AT.endOfInput))+  parseJSON = Aeson.withText "IPv4" (Internal.eitherToAesonParser . coerce Internal.decodeIPv4TextEither)  instance ToJSON IPv4Range where   toJSON (IPv4Range (IPv4 addr) range) = Aeson.String (Internal.rangeToDotDecimalText addr range)@@ -116,23 +145,220 @@   basicUnsafeCopy (MV_IPv4 mv) (V_IPv4 v) = GVector.basicUnsafeCopy mv v   elemseq _ = seq -data Mac = Mac-  { macA :: {-# UNPACK #-} !Word16-  , macB :: {-# UNPACK #-} !Word32-  }-  deriving (Eq,Ord,Show,Read,Generic)+data instance MUVector.MVector s IPv4Range+    = MV_IPv4Range {-# UNPACK #-} !Int !(MUVector.MVector s IPv4)+                                       !(MUVector.MVector s Word8)+data instance UVector.Vector IPv4Range+    = V_IPv4Range {-# UNPACK #-} !Int !(UVector.Vector IPv4)+                                      !(UVector.Vector Word8)+instance UVector.Unbox IPv4Range+instance MGVector.MVector MUVector.MVector IPv4Range where+  {-# INLINE basicLength  #-}+  basicLength (MV_IPv4Range n_ as bs) = n_+  {-# INLINE basicUnsafeSlice  #-}+  basicUnsafeSlice i_ m_ (MV_IPv4Range n_ as bs)+      = MV_IPv4Range m_ (MGVector.basicUnsafeSlice i_ m_ as)+                        (MGVector.basicUnsafeSlice i_ m_ bs)+  {-# INLINE basicOverlaps  #-}+  basicOverlaps (MV_IPv4Range n_1 as1 bs1) (MV_IPv4Range n_2 as2 bs2)+      = MGVector.basicOverlaps as1 as2+        || MGVector.basicOverlaps bs1 bs2+  {-# INLINE basicUnsafeNew  #-}+  basicUnsafeNew n_+      = do+          as <- MGVector.basicUnsafeNew n_+          bs <- MGVector.basicUnsafeNew n_+          return $ MV_IPv4Range n_ as bs+  {-# INLINE basicInitialize  #-}+  basicInitialize (MV_IPv4Range _ as bs)+      = do+          MGVector.basicInitialize as+          MGVector.basicInitialize bs+  {-# INLINE basicUnsafeReplicate  #-}+  basicUnsafeReplicate n_ (IPv4Range a b)+      = do+          as <- MGVector.basicUnsafeReplicate n_ a+          bs <- MGVector.basicUnsafeReplicate n_ b+          return $ MV_IPv4Range n_ as bs+  {-# INLINE basicUnsafeRead  #-}+  basicUnsafeRead (MV_IPv4Range n_ as bs) i_+      = do+          a <- MGVector.basicUnsafeRead as i_+          b <- MGVector.basicUnsafeRead bs i_+          return (IPv4Range a b)+  {-# INLINE basicUnsafeWrite  #-}+  basicUnsafeWrite (MV_IPv4Range n_ as bs) i_ (IPv4Range a b)+      = do+          MGVector.basicUnsafeWrite as i_ a+          MGVector.basicUnsafeWrite bs i_ b+  {-# INLINE basicClear  #-}+  basicClear (MV_IPv4Range n_ as bs)+      = do+          MGVector.basicClear as+          MGVector.basicClear bs+  {-# INLINE basicSet  #-}+  basicSet (MV_IPv4Range n_ as bs) (IPv4Range a b)+      = do+          MGVector.basicSet as a+          MGVector.basicSet bs b+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_IPv4Range n_1 as1 bs1) (MV_IPv4Range n_2 as2+                                                               bs2)+      = do+          MGVector.basicUnsafeCopy as1 as2+          MGVector.basicUnsafeCopy bs1 bs2+  {-# INLINE basicUnsafeMove  #-}+  basicUnsafeMove (MV_IPv4Range n_1 as1 bs1) (MV_IPv4Range n_2 as2+                                                               bs2)+      = do+          MGVector.basicUnsafeMove as1 as2+          MGVector.basicUnsafeMove bs1 bs2+  {-# INLINE basicUnsafeGrow  #-}+  basicUnsafeGrow (MV_IPv4Range n_ as bs) m_+      = do+          as' <- MGVector.basicUnsafeGrow as m_+          bs' <- MGVector.basicUnsafeGrow bs m_+          return $ MV_IPv4Range (m_+n_) as' bs'+instance GVector.Vector UVector.Vector IPv4Range where+  {-# INLINE basicUnsafeFreeze  #-}+  basicUnsafeFreeze (MV_IPv4Range n_ as bs)+      = do+          as' <- GVector.basicUnsafeFreeze as+          bs' <- GVector.basicUnsafeFreeze bs+          return $ V_IPv4Range n_ as' bs'+  {-# INLINE basicUnsafeThaw  #-}+  basicUnsafeThaw (V_IPv4Range n_ as bs)+      = do+          as' <- GVector.basicUnsafeThaw as+          bs' <- GVector.basicUnsafeThaw bs+          return $ MV_IPv4Range n_ as' bs'+  {-# INLINE basicLength  #-}+  basicLength (V_IPv4Range n_ as bs) = n_+  {-# INLINE basicUnsafeSlice  #-}+  basicUnsafeSlice i_ m_ (V_IPv4Range n_ as bs)+      = V_IPv4Range m_ (GVector.basicUnsafeSlice i_ m_ as)+                       (GVector.basicUnsafeSlice i_ m_ bs)+  {-# INLINE basicUnsafeIndexM  #-}+  basicUnsafeIndexM (V_IPv4Range n_ as bs) i_+      = do+          a <- GVector.basicUnsafeIndexM as i_+          b <- GVector.basicUnsafeIndexM bs i_+          return (IPv4Range a b)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_IPv4Range n_1 as1 bs1) (V_IPv4Range n_2 as2+                                                              bs2)+      = do+          GVector.basicUnsafeCopy as1 as2+          GVector.basicUnsafeCopy bs1 bs2+  {-# INLINE elemseq  #-}+  elemseq _ (IPv4Range a b)+      = GVector.elemseq (undefined :: UVector.Vector a) a+        . GVector.elemseq (undefined :: UVector.Vector b) b -instance Hashable Mac -instance ToJSON Mac where-  toJSON (Mac a b) = Aeson.String (Internal.macToText a b)--instance FromJSON Mac where-  parseJSON = Internal.attoparsecParseJSON-    (Internal.macTextParser macFromOctets' <* AT.endOfInput)--macFromOctets' :: Word16 -> Word16 -> Word32 -> Word32 -> Word32 -> Word32 -> Mac-macFromOctets' a b c d e f = Mac-    ( shiftL a 8 .|. b )-    ( shiftL c 24 .|. shiftL d 16 .|. shiftL e 8 .|. f )-{-# INLINE macFromOctets' #-}+data instance MUVector.MVector s Mac+    = MV_Mac {-# UNPACK #-} !Int !(MUVector.MVector s Word16)+                                 !(MUVector.MVector s Word32)+data instance UVector.Vector Mac+    = V_Mac {-# UNPACK #-} !Int !(UVector.Vector Word16)+                                !(UVector.Vector Word32)+instance UVector.Unbox Mac+instance MGVector.MVector MUVector.MVector Mac where+  {-# INLINE basicLength  #-}+  basicLength (MV_Mac n_ as bs) = n_+  {-# INLINE basicUnsafeSlice  #-}+  basicUnsafeSlice i_ m_ (MV_Mac n_ as bs)+      = MV_Mac m_ (MGVector.basicUnsafeSlice i_ m_ as)+                  (MGVector.basicUnsafeSlice i_ m_ bs)+  {-# INLINE basicOverlaps  #-}+  basicOverlaps (MV_Mac n_1 as1 bs1) (MV_Mac n_2 as2 bs2)+      = MGVector.basicOverlaps as1 as2+        || MGVector.basicOverlaps bs1 bs2+  {-# INLINE basicUnsafeNew  #-}+  basicUnsafeNew n_+      = do+          as <- MGVector.basicUnsafeNew n_+          bs <- MGVector.basicUnsafeNew n_+          return $ MV_Mac n_ as bs+  {-# INLINE basicInitialize  #-}+  basicInitialize (MV_Mac _ as bs)+      = do+          MGVector.basicInitialize as+          MGVector.basicInitialize bs+  {-# INLINE basicUnsafeReplicate  #-}+  basicUnsafeReplicate n_ (Mac a b)+      = do+          as <- MGVector.basicUnsafeReplicate n_ a+          bs <- MGVector.basicUnsafeReplicate n_ b+          return $ MV_Mac n_ as bs+  {-# INLINE basicUnsafeRead  #-}+  basicUnsafeRead (MV_Mac n_ as bs) i_+      = do+          a <- MGVector.basicUnsafeRead as i_+          b <- MGVector.basicUnsafeRead bs i_+          return (Mac a b)+  {-# INLINE basicUnsafeWrite  #-}+  basicUnsafeWrite (MV_Mac n_ as bs) i_ (Mac a b)+      = do+          MGVector.basicUnsafeWrite as i_ a+          MGVector.basicUnsafeWrite bs i_ b+  {-# INLINE basicClear  #-}+  basicClear (MV_Mac n_ as bs)+      = do+          MGVector.basicClear as+          MGVector.basicClear bs+  {-# INLINE basicSet  #-}+  basicSet (MV_Mac n_ as bs) (Mac a b)+      = do+          MGVector.basicSet as a+          MGVector.basicSet bs b+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_Mac n_1 as1 bs1) (MV_Mac n_2 as2 bs2)+      = do+          MGVector.basicUnsafeCopy as1 as2+          MGVector.basicUnsafeCopy bs1 bs2+  {-# INLINE basicUnsafeMove  #-}+  basicUnsafeMove (MV_Mac n_1 as1 bs1) (MV_Mac n_2 as2 bs2)+      = do+          MGVector.basicUnsafeMove as1 as2+          MGVector.basicUnsafeMove bs1 bs2+  {-# INLINE basicUnsafeGrow  #-}+  basicUnsafeGrow (MV_Mac n_ as bs) m_+      = do+          as' <- MGVector.basicUnsafeGrow as m_+          bs' <- MGVector.basicUnsafeGrow bs m_+          return $ MV_Mac (m_+n_) as' bs'+instance GVector.Vector UVector.Vector Mac where+  {-# INLINE basicUnsafeFreeze  #-}+  basicUnsafeFreeze (MV_Mac n_ as bs)+      = do+          as' <- GVector.basicUnsafeFreeze as+          bs' <- GVector.basicUnsafeFreeze bs+          return $ V_Mac n_ as' bs'+  {-# INLINE basicUnsafeThaw  #-}+  basicUnsafeThaw (V_Mac n_ as bs)+      = do+          as' <- GVector.basicUnsafeThaw as+          bs' <- GVector.basicUnsafeThaw bs+          return $ MV_Mac n_ as' bs'+  {-# INLINE basicLength  #-}+  basicLength (V_Mac n_ as bs) = n_+  {-# INLINE basicUnsafeSlice  #-}+  basicUnsafeSlice i_ m_ (V_Mac n_ as bs)+      = V_Mac m_ (GVector.basicUnsafeSlice i_ m_ as)+                 (GVector.basicUnsafeSlice i_ m_ bs)+  {-# INLINE basicUnsafeIndexM  #-}+  basicUnsafeIndexM (V_Mac n_ as bs) i_+      = do+          a <- GVector.basicUnsafeIndexM as i_+          b <- GVector.basicUnsafeIndexM bs i_+          return (Mac a b)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_Mac n_1 as1 bs1) (V_Mac n_2 as2 bs2)+      = do+          GVector.basicUnsafeCopy as1 as2+          GVector.basicUnsafeCopy bs1 bs2+  {-# INLINE elemseq  #-}+  elemseq _ (Mac a b)+      = GVector.elemseq (undefined :: UVector.Vector a) a+        . GVector.elemseq (undefined :: UVector.Vector b) b

@@ -5,8 +5,7 @@  -- Orphan instances that are needed to make QuickCheck work. -import Net.Types (IPv4(..),IPv4Range(..))-import Net.Mac (Mac(..))+import Net.Types (IPv4(..),IPv4Range(..),Mac(..)) import Test.QuickCheck (Arbitrary(..))  deriving instance Arbitrary IPv4

@@ -9,29 +9,38 @@ import Data.Word import Data.ByteString (ByteString) import Control.Monad.ST+import qualified Data.Text              as Text import qualified Data.ByteString.Char8  as BC8 import qualified Data.ByteString        as ByteString import qualified Data.ByteString.Unsafe as ByteString import qualified Data.Text.Lazy         as LText import qualified Data.Text.Lazy.Builder as TBuilder import qualified Data.Text.Array        as TArray-import qualified Net.IPv4.Text as IPv4_Text+import qualified Net.IPv4.Text          as IPv4_Text  import qualified Naive import qualified IPv4Text1 import qualified IPv4Text2 import qualified IPv4ByteString1+import qualified IPv4DecodeText1+import qualified IPv4DecodeText2  import qualified Net.IPv4.ByteString.Char8 as NIPBS  main :: IO () main = do   let ipAddr = IPv4 1000000009+      ipText = Text.pack "192.168.5.99"   defaultMain     [ bgroup "IPv4 to Text"       [ bench "Naive" $ whnf Naive.encodeText ipAddr       , bench "Text Builder" $ whnf IPv4Text2.encode ipAddr       , bench "Preallocated" $ whnf IPv4Text1.encode ipAddr+      ]+    , bgroup "IPv4 from Text"+      [ bench "Naive" $ whnf Naive.decodeText ipText+      , bench "Attoparsec" $ whnf IPv4DecodeText2.decodeText ipText+      , bench "Text Reader" $ whnf IPv4DecodeText1.decodeText ipText       ]     , bgroup "IPv4 to ByteString"       [ bench "Naive" $ whnf Naive.encodeByteString ipAddr

@@ -0,0 +1,55 @@+module IPv4DecodeText1 where++import Net.Types+import Data.Monoid ((<>))+import Data.Word+import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)+import Control.Monad.ST+import Data.Text.Internal (Text(..))+import Data.Text.Lazy.Builder.Int (decimal)+import Control.Monad+import qualified Data.Text              as Text+import qualified Data.Text.Lazy         as LText+import qualified Data.Attoparsec.Text   as AT+import qualified Data.Text.Array        as TArray+import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Data.Text.Read         as TextRead+import qualified Data.Text.Lazy.Builder.Int as TBuilder++stripDecimal :: Text -> Either String Text+stripDecimal t = case Text.uncons t of+  Nothing -> Left "expected a dot but input ended instead"+  Just (c,tnext) -> if c == '.'+    then Right tnext+    else Left "expected a dot but found a different character"+{-# INLINE stripDecimal #-}++decodeIPv4TextEither :: Text -> Either String Word32+decodeIPv4TextEither t1' = do+  (a,t2) <- TextRead.decimal t1'+  t2' <- stripDecimal t2+  (b,t3) <- TextRead.decimal t2'+  t3' <- stripDecimal t3+  (c,t4) <- TextRead.decimal t3'+  t4' <- stripDecimal t4+  (d,t5) <- TextRead.decimal t4'+  when (not (Text.null t5)) (Left "expected end of text but it continued instead")+  if a > 255 || b > 255 || c > 255 || d > 255+    then Left ipOctetSizeErrorMsg+    else Right (fromOctets' a b c d)++decodeText :: Text -> Maybe IPv4+decodeText t = case decodeIPv4TextEither t of+  Left _ -> Nothing+  Right w -> Just (IPv4 w)++ipOctetSizeErrorMsg :: String+ipOctetSizeErrorMsg = "All octets in an IPv4 address must be between 0 and 255"++fromOctets' :: Word32 -> Word32 -> Word32 -> Word32 -> Word32+fromOctets' a b c d =+    ( shiftL a 24+  .|. shiftL b 16+  .|. shiftL c 8+  .|. d+    )

@@ -0,0 +1,48 @@+module IPv4DecodeText2 where++import Net.Types+import Data.Monoid ((<>))+import Data.Word+import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)+import Control.Monad.ST+import Data.Text.Internal (Text(..))+import Data.Text.Lazy.Builder.Int (decimal)+import Control.Monad+import qualified Data.Text              as Text+import qualified Data.Text.Lazy         as LText+import qualified Data.Attoparsec.Text   as AT+import qualified Data.Text.Array        as TArray+import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Data.Text.Read         as TextRead+import qualified Data.Text.Lazy.Builder.Int as TBuilder++dotDecimalParser :: AT.Parser Word32+dotDecimalParser = fromOctets'+  <$> (AT.decimal >>= limitSize)+  <*  AT.char '.'+  <*> (AT.decimal >>= limitSize)+  <*  AT.char '.'+  <*> (AT.decimal >>= limitSize)+  <*  AT.char '.'+  <*> (AT.decimal >>= limitSize)+  where+  limitSize i =+    if i > 255+      then fail ipOctetSizeErrorMsg+      else return i++decodeText :: Text -> Maybe IPv4+decodeText t = case AT.parseOnly (dotDecimalParser <* AT.endOfInput) t of+  Left _ -> Nothing+  Right w -> Just (IPv4 w)++ipOctetSizeErrorMsg :: String+ipOctetSizeErrorMsg = "All octets in an IPv4 address must be between 0 and 255"++fromOctets' :: Word32 -> Word32 -> Word32 -> Word32 -> Word32+fromOctets' a b c d =+    ( shiftL a 24+  .|. shiftL b 16+  .|. shiftL c 8+  .|. d+    )

@@ -5,15 +5,17 @@ import Test.QuickCheck                      (Gen, Arbitrary(..), choose) import Test.Framework                       (defaultMain, testGroup, Test) import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit       (testCase)+import Test.HUnit                           (Assertion,(@?=)) -import Net.Types (IPv4(..),IPv4Range(..))-import Net.Mac (Mac(..))+import Net.Types (IPv4(..),IPv4Range(..),Mac(..))+import qualified Data.Text as Text import qualified Net.IPv4 as IPv4 import qualified Net.IPv4.Range as IPv4Range-import qualified Net.IPv4.Text as IPv4_Text-import qualified Net.IPv4.ByteString.Char8 as IPv4_ByteString+import qualified Net.IPv4.Text as IPv4Text+import qualified Net.IPv4.ByteString.Char8 as IPv4ByteString import qualified Net.Mac as Mac-import qualified Net.Mac.Text as Mac_Text+import qualified Net.Mac.Text as MacText  import ArbitraryInstances () import qualified Naive@@ -27,8 +29,18 @@ tests :: [Test] tests =   [ testGroup "Encoding and Decoding"-    [ testGroup "Naive IPv4 encode/decode"+    [ testGroup "Currently used IPv4 encode/decode" $       [ testProperty "Isomorphism"+          $ propEncodeDecodeIso IPv4Text.encode IPv4Text.decode+      , testCase "Decode an IP" testIPv4Decode+      ] ++ testDecodeFailures+    , testGroup "Currently used MAC Text encode/decode"+      [ testProperty "Isomorphism"+          $ propEncodeDecodeIso MacText.encode MacText.decode+      , testCase "Encode a MAC Address" testMacEncode+      ]+    , testGroup "Naive IPv4 encode/decode"+      [ testProperty "Isomorphism"           $ propEncodeDecodeIso Naive.encodeText Naive.decodeText       ]     , testGroup "Text Builder IPv4 Text encode/decode"@@ -45,11 +57,7 @@       ]     , testGroup "Raw byte array (with lookup table) IPv4 ByteString encode/decode"       [ testProperty "Identical to Naive"-          $ propMatching IPv4_ByteString.encode Naive.encodeByteString-      ]-    , testGroup "Raw byte array MAC Text encode/decode"-      [ testProperty "Isomorphism"-          $ propEncodeDecodeIso Mac_Text.encode Mac_Text.decode+          $ propMatching IPv4ByteString.encode Naive.encodeByteString       ]     ]   , testGroup "IP Range Operations"@@ -79,4 +87,28 @@  propRangeSelf :: IPv4Range -> Bool propRangeSelf r = IPv4Range.member (ipv4RangeBase r) r == True++testIPv4Decode :: Assertion+testIPv4Decode = IPv4Text.decode (Text.pack "124.222.255.0")+             @?= Just (IPv4.fromOctets 124 222 255 0)++textBadIPv4 :: [String]+textBadIPv4 =+  [ "122.256.0.0"+  , "1.1.1."+  , ".1.1.1."+  , ".1.1.1"+  , "1.1..1.1"+  , "1.9.x.2"+  , "1.9.3"+  , "1.9"+  ]++testDecodeFailures :: [Test]+testDecodeFailures = flip map textBadIPv4 $ \str ->+  testCase ("Should fail to decode [" ++ str ++ "]") $ IPv4Text.decode (Text.pack str) @?= Nothing++testMacEncode :: Assertion+testMacEncode = MacText.encode (Mac.fromOctets 0xFF 0x00 0xAB 0x12 0x99 0x0F)+            @?= Text.pack "ff:00:ab:12:99:0f"