ip 0.5 → 0.6.0
raw patch · 6 files changed
+153/−13 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ip.cabal +7/−1
- src/Net/IPv4/ByteString/Char8.hs +78/−6
- test/Bench.hs +5/−0
- test/IPv4ByteString1.hs +43/−0
- test/Naive.hs +2/−2
- test/Test.hs +18/−4
ip.cabal view
@@ -1,5 +1,5 @@ name: ip-version: 0.5+version: 0.6.0 synopsis: Library for IP and MAC addresses description: Please see README.md homepage: https://github.com/andrewthad/ip#readme@@ -44,6 +44,11 @@ , QuickCheck , text , bytestring+ other-modules:+ Naive+ IPv4Text1+ IPv4Text2+ IPv4ByteString1 ghc-options: -Wall -O2 default-language: Haskell2010 @@ -59,6 +64,7 @@ Naive IPv4Text1 IPv4Text2+ IPv4ByteString1 ghc-options: -Wall -O2 default-language: Haskell2010 hs-source-dirs: test
src/Net/IPv4/ByteString/Char8.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} module Net.IPv4.ByteString.Char8 ( encode , decode@@ -12,15 +13,87 @@ import qualified Data.ByteString.Builder as Builder import Net.Internal (rightToMaybe) import Data.Text.Encoding (encodeUtf8, decodeUtf8')-import Data.ByteString (ByteString)+import Data.ByteString (ByteString,replicate) import Data.Attoparsec.ByteString.Char8 (Parser) import Data.ByteString.Builder (Builder)+import Data.ByteString.Char8 as BC8 --- | This should be rewritten to not create 'Text' as an +import Data.ByteString.Internal as I+import Data.Bits+import Foreign.Ptr+import Foreign.Storable+import Data.Word+import Data.ByteString.Unsafe as BSU+import Data.Monoid++-- | This should be rewritten to not create 'Text' as an -- intermediate step. encode :: IPv4 -> ByteString-encode = encodeUtf8 . IPv4Text.encode+encode = toBSPreAllocated +toBSPreAllocated :: IPv4 -> ByteString+toBSPreAllocated (IPv4 !w) = I.unsafeCreateUptoN 15 (\ptr1 ->+ do len1 <- writeWord ptr1 w1+ let ptr2 = ptr1 `plusPtr` len1+ poke ptr2 dot+ len2 <- writeWord (ptr2 `plusPtr` 1) w2+ let ptr3 = ptr2 `plusPtr` len2 `plusPtr` 1+ poke ptr3 dot+ len3 <- writeWord (ptr3 `plusPtr` 1) w3+ let ptr4 = ptr3 `plusPtr` len3 `plusPtr` 1+ poke ptr4 dot+ len4 <- writeWord (ptr4 `plusPtr` 1) w4+ return (3 + len1 + len2 + len3 + len4))+ where w1 = fromIntegral $ shiftR w 24+ w2 = fromIntegral $ shiftR w 16+ w3 = fromIntegral $ shiftR w 8+ w4 = fromIntegral w+ dot = 46 :: Word8+ writeWord :: Ptr Word8 -> Word8 -> IO Int+ writeWord !ptr !word+ | word >= 100 = do+ let int = fromIntegral word+ indx = int + int + int+ get3 = fromIntegral . BSU.unsafeIndex threeDigits+ poke ptr (get3 indx)+ poke (ptr `plusPtr` 1) (get3 (indx + 1))+ poke (ptr `plusPtr` 2) (get3 (indx + 2))+ return 3+ | word >= 10 = do+ let int = fromIntegral word+ indx = int + int+ get2 = fromIntegral . BSU.unsafeIndex twoDigits+ poke ptr (get2 indx)+ poke (ptr `plusPtr` 1) (get2 (indx + 1))+ return 2+ | otherwise = do+ poke ptr (word + 48)+ return 1++twoDigits :: ByteString+twoDigits = BC8.pack+ "0001020304050607080910111213141516171819\+ \2021222324252627282930313233343536373839\+ \4041424344454647484950515253545556575859\+ \6061626364656667686970717273747576777879\+ \8081828384858687888990919293949596979899"++threeDigits :: ByteString+threeDigits = + Data.ByteString.replicate 300 0 <> BC8.pack+ "100101102103104105106107108109110111112\+ \113114115116117118119120121122123124125\+ \126127128129130131132133134135136137138\+ \139140141142143144145146147148149150151\+ \152153154155156157158159160161162163164\+ \165166167168169170171172173174175176177\+ \178179180181182183184185186187188189190\+ \191192193194195196197198199200201202203\+ \204205206207208209210211212213214215216\+ \217218219220221222223224225226227228229\+ \230231232233234235236237238239240241242\+ \243244245246247248249250251252253254255"+ -- | This should also be rewritten decode :: ByteString -> Maybe IPv4 decode = IPv4Text.decode <=< rightToMaybe . decodeUtf8'@@ -38,8 +111,7 @@ <* AB.char '.' <*> (AB.decimal >>= limitSize) where- limitSize i = - if i > 255 + limitSize i =+ if i > 255 then fail "All octets in an ip address must be between 0 and 255" else return i-
test/Bench.hs view
@@ -20,7 +20,10 @@ import qualified Naive import qualified IPv4Text1 import qualified IPv4Text2+import qualified IPv4ByteString1 +import qualified Net.IPv4.ByteString.Char8 as NIPBS+ main :: IO () main = do let ipAddr = IPv4 1000000009@@ -32,5 +35,7 @@ ] , bgroup "IPv4 to ByteString" [ bench "Naive" $ whnf Naive.encodeByteString ipAddr+ , bench "Preallocated: No Lookup Tables" $ whnf IPv4ByteString1.encode ipAddr+ , bench "Preallocated" $ whnf NIPBS.encode ipAddr ] ]
+ test/IPv4ByteString1.hs view
@@ -0,0 +1,43 @@+module IPv4ByteString1 where++import Net.IPv4++import Data.ByteString.Internal as I+import Data.Bits+import Foreign.Ptr+import Foreign.Storable+import Data.Word++encode :: IPv4 -> ByteString+encode (IPv4 w) = I.unsafeCreateUptoN 15 (\ptr1 ->+ do (len1,ptr2) <- writeWord ptr1 w1+ poke ptr2 dot+ (len2,ptr3) <- writeWord (ptr2 `plusPtr` 1) w2+ poke ptr3 dot+ (len3,ptr4) <- writeWord (ptr3 `plusPtr` 1) w3+ poke ptr4 dot+ (len4,_) <- writeWord (ptr4 `plusPtr` 1) w4+ return (3 + len1 + len2 + len3 + len4))+ where w1 = fromIntegral $ shiftR w 24+ w2 = fromIntegral $ shiftR w 16+ w3 = fromIntegral $ shiftR w 8+ w4 = fromIntegral w+ dot = 46+ writeWord :: Ptr Word8 -> Word8 -> IO (Int,Ptr Word8)+ writeWord ptr word+ | word >= 100 = do+ let (word1,char3) = word `quotRem` 10+ (char1,char2) = word1 `quotRem` 10+ poke ptr (char1 + 48)+ poke (ptr `plusPtr` 1) (char2 + 48)+ poke (ptr `plusPtr` 2) (char3 + 48)+ return (3,ptr `plusPtr` 3)+ | word >= 10 = do+ let (char1,char2) = word `quotRem` 10+ poke ptr (char1 + 48)+ poke (ptr `plusPtr` 1) (char2 + 48)+ return (2,ptr `plusPtr` 2)+ | otherwise = do+ poke ptr (word + 48)+ return (1,ptr `plusPtr` 1)+
test/Naive.hs view
@@ -36,8 +36,8 @@ ] where (a,b,c,d) = IPv4.toOctets i -ipv4FromTextNaive :: Text -> Maybe IPv4-ipv4FromTextNaive t = +decodeText :: Text -> Maybe IPv4+decodeText t = case mapM (readMaybe . Text.unpack) (Text.splitOn (Text.pack ".") t) of Just [a,b,c,d] -> Just (IPv4.fromOctets a b c d) _ -> Nothing
test/Test.hs view
@@ -13,9 +13,15 @@ import Net.Mac (Mac(..)) import qualified Net.IPv4 as IPv4 import qualified Net.IPv4.Text as IPv4_Text+import qualified Net.IPv4.ByteString.Char8 as IPv4_ByteString import qualified Net.Mac as Mac import qualified Net.Mac.Text as Mac_Text +import qualified Naive+import qualified IPv4Text1+import qualified IPv4Text2+import qualified IPv4ByteString1+ main :: IO () main = defaultMain tests @@ -23,17 +29,25 @@ tests = [ testGroup "Naive IPv4 encode/decode" [ testProperty "Isomorphism" - $ propEncodeDecodeIso ipv4ToTextNaive ipv4FromTextNaive+ $ propEncodeDecodeIso Naive.encodeText Naive.decodeText ] , testGroup "Text Builder IPv4 Text encode/decode" [ testProperty "Identical to Naive"- $ propMatching toDotDecimalText ipv4ToTextNaive+ $ propMatching IPv4Text2.encode Naive.encodeText ] , testGroup "Raw byte array IPv4 Text encode/decode" [ testProperty "Identical to Naive"- $ propMatching toTextPreAllocated ipv4ToTextNaive+ $ propMatching IPv4Text1.encode Naive.encodeText ]- , testGroup "Performant MAC Text encode/decode"+ , testGroup "Raw byte array (without lookup table) IPv4 ByteString encode/decode"+ [ testProperty "Identical to Naive"+ $ propMatching IPv4ByteString1.encode Naive.encodeByteString+ ]+ , 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 ]