ip 0.3 → 0.4
raw patch · 10 files changed
+362/−21 lines, 10 filesdep +QuickCheckdep +bytestringdep +criteriondep ~base
Dependencies added: QuickCheck, bytestring, criterion, ip, test-framework, test-framework-quickcheck2
Dependency ranges changed: base
Files
- ip.cabal +34/−1
- src/Net/IPv4.hs +127/−16
- src/Net/IPv4/ByteString/Char8.hs +24/−0
- src/Net/IPv4/Text.hs +27/−3
- src/Net/Internal.hs +4/−0
- src/Net/Mac.hs +7/−1
- src/Net/Mac/ByteString/Char8.hs +24/−0
- src/Net/Mac/Text.hs +29/−0
- test/Bench.hs +33/−0
- test/Test.hs +53/−0
ip.cabal view
@@ -1,5 +1,5 @@ name: ip-version: 0.3+version: 0.4 synopsis: Library for IP and MAC addresses description: Please see README.md homepage: https://github.com/andrewthad/ip#readme@@ -16,8 +16,11 @@ hs-source-dirs: src exposed-modules: Net.Mac+ Net.Mac.Text+ Net.Mac.ByteString.Char8 Net.IPv4 Net.IPv4.Text+ Net.IPv4.ByteString.Char8 Net.Internal build-depends: base >= 4.7 && < 5@@ -25,7 +28,37 @@ , aeson , hashable , text+ , bytestring+ ghc-options: -Wall -O2 default-language: Haskell2010++test-suite ip-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs+ build-depends: + base+ , ip+ , test-framework+ , test-framework-quickcheck2+ , QuickCheck+ , text+ , bytestring+ ghc-options: -Wall -O2+ default-language: Haskell2010++benchmark criterion+ type: exitcode-stdio-1.0+ build-depends:+ base+ , ip+ , criterion+ , text+ , bytestring+ ghc-options: -Wall -O2+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Bench.hs source-repository head type: git
src/Net/IPv4.hs view
@@ -1,9 +1,37 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Net.IPv4 where+{-| An IPv4 data type+ + This module provides the IPv4 data type and functions for working+ with it. There are also encoding and decoding functions provided+ in this module, but they should be imported from + @Net.IPv4.Text@ and @Net.IPv4.ByteString.Char8@ instead. They are+ defined here so that the 'FromJSON' and 'ToJSON' instances can+ use them. -import Data.Text (Text)+-}+ +module Net.IPv4 + ( -- * Types+ IPv4(..)+ , IPv4Range(..)+ -- * Conversion Functions+ , fromOctets+ , fromOctets'+ , toOctets+ -- * Encoding and Decoding Functions+ , fromDotDecimalText+ , fromDotDecimalText'+ , rangeFromDotDecimalText'+ , dotDecimalRangeParser+ , dotDecimalParser+ , toDotDecimalText+ , toDotDecimalBuilder+ , rangeToDotDecimalText+ , rangeToDotDecimalBuilder+ ) where+ import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder import Data.Text.Lazy.Builder.Int (decimal)@@ -17,7 +45,16 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Attoparsec.Text as AT-import Net.Internal (attoparsecParseJSON)+import Net.Internal (attoparsecParseJSON,rightToMaybe)+import Control.Monad+import Data.Text.Internal (Text(..))+import Control.Monad.ST+import Data.ByteString (ByteString)+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.Builder as TBuilder+import qualified Data.Text.Array as TArray newtype IPv4 = IPv4 { getIPv4 :: Word32 } deriving (Eq,Ord,Show,Read,Enum,Bounded,Hashable,Generic)@@ -43,9 +80,7 @@ case rangeFromDotDecimalText' t of Left err -> fail err Right res -> return res--rightToMaybe :: Either a b -> Maybe b-rightToMaybe = either (const Nothing) Just+ parseJSON _ = mzero -- mask :: Int -> IPv4 -- mask w = IPv4 $ complement $ 0xffffffff `shiftR` w@@ -106,22 +141,24 @@ .|. d ) +toOctets :: IPv4 -> (Word8,Word8,Word8,Word8)+toOctets (IPv4 w) =+ ( fromIntegral (shiftR w 24)+ , fromIntegral (shiftR w 16)+ , fromIntegral (shiftR w 8)+ , fromIntegral w+ )+ toDotDecimalText :: IPv4 -> Text-toDotDecimalText = LText.toStrict . TBuilder.toLazyText . toDotDecimalBuilder+toDotDecimalText = toTextPreAllocated+{-# INLINE toDotDecimalText #-} -- It should be possible to write a more efficient version that initially -- allocates a block of strict text of length 15 and then starts filling -- it in. toDotDecimalBuilder :: IPv4 -> TBuilder.Builder-toDotDecimalBuilder (IPv4 w) = - decimal (255 .&. shiftR w 24 )- <> dot- <> decimal (255 .&. shiftR w 16 )- <> dot- <> decimal (255 .&. shiftR w 8 )- <> dot- <> decimal (255 .&. w)- where dot = TBuilder.singleton '.'+toDotDecimalBuilder = TBuilder.fromText . toTextPreAllocated+{-# INLINE toDotDecimalBuilder #-} rangeToDotDecimalText :: IPv4Range -> Text rangeToDotDecimalText = LText.toStrict . TBuilder.toLazyText . rangeToDotDecimalBuilder@@ -132,5 +169,79 @@ <> TBuilder.singleton '/' <> decimal len +toTextPreAllocated :: IPv4 -> Text+toTextPreAllocated (IPv4 w) =+ let w1 = fromIntegral $ 255 .&. shiftR w 24+ w2 = fromIntegral $ 255 .&. shiftR w 16+ w3 = fromIntegral $ 255 .&. shiftR w 8+ w4 = fromIntegral $ 255 .&. w+ dot = 46+ (arr,len) = runST $ do+ marr <- TArray.new 15+ i1 <- putAndCount 0 w1 marr+ let n1 = i1+ n1' = i1 + 1+ TArray.unsafeWrite marr n1 dot+ i2 <- putAndCount n1' w2 marr+ let n2 = i2 + n1'+ n2' = n2 + 1+ TArray.unsafeWrite marr n2 dot+ i3 <- putAndCount n2' w3 marr+ let n3 = i3 + n2'+ n3' = n3 + 1+ TArray.unsafeWrite marr n3 dot+ i4 <- putAndCount n3' w4 marr+ theArr <- TArray.unsafeFreeze marr+ return (theArr,i4 + n3')+ in Text arr 0 len+ +putAndCount :: Int -> Word8 -> TArray.MArray s -> ST s Int+putAndCount pos w marr+ | w < 10 = TArray.unsafeWrite marr pos (i2w w) >> return 1+ | w < 100 = write2 pos w >> return 2+ | otherwise = write3 pos w >> return 3+ where+ write2 off i0 = do+ let i = fromIntegral i0; j = i + i+ TArray.unsafeWrite marr off $ get2 j+ TArray.unsafeWrite marr (off + 1) $ get2 (j + 1)+ write3 off i0 = do+ let i = fromIntegral i0; j = i + i + i+ TArray.unsafeWrite marr off $ get3 j+ TArray.unsafeWrite marr (off + 1) $ get3 (j + 1)+ TArray.unsafeWrite marr (off + 2) $ get3 (j + 2)+ get2 = fromIntegral . ByteString.unsafeIndex twoDigits+ get3 = fromIntegral . ByteString.unsafeIndex threeDigits +zero :: Word16+zero = 48+{-# INLINE zero #-}++i2w :: (Integral a) => a -> Word16+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"
+ src/Net/IPv4/ByteString/Char8.hs view
@@ -0,0 +1,24 @@+module Net.IPv4.ByteString.Char8+ ( encode+ , decode+ , builder+ , parser+ ) where++import Net.IPv4+import Data.ByteString (ByteString)+import Data.Attoparsec.Text (Parser)+import Data.ByteString.Lazy.Builder (Builder)++encode :: IPv4 -> ByteString+encode = error "write me"++decode :: ByteString -> Either String IPv4+decode = error "write me"++builder :: IPv4 -> Builder+builder = error "write me"++parser :: Parser IPv4+parser = error "write me"+
src/Net/IPv4/Text.hs view
@@ -1,5 +1,29 @@- {-# LANGUAGE DeriveGeneric #-}- {-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Net.IPv4.Text + ( encode+ , decode+ , decodeEither+ , builder+ , parser+ ) where -module Net.IPv4.Text where+import Net.IPv4+import Net.Internal (rightToMaybe)+import Data.Text (Text)+import qualified Data.Attoparsec.Text as AT+import qualified Data.Text.Lazy.Builder as TBuilder++encode :: IPv4 -> Text+encode = toDotDecimalText++decodeEither :: Text -> Either String IPv4+decodeEither = fromDotDecimalText'++decode :: Text -> Maybe IPv4+decode = rightToMaybe . decodeEither++builder :: IPv4 -> TBuilder.Builder+builder = toDotDecimalBuilder++parser :: AT.Parser IPv4+parser = dotDecimalParser
src/Net/Internal.hs view
@@ -11,3 +11,7 @@ Left err -> fail err Right res -> return res _ -> fail "expected a String"++rightToMaybe :: Either a b -> Maybe b+rightToMaybe = either (const Nothing) Just+
src/Net/Mac.hs view
@@ -11,7 +11,7 @@ import qualified Data.Attoparsec.Text as AT import qualified Data.Attoparsec.ByteString.Char8 as AB import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)-import Net.Internal (attoparsecParseJSON)+import Net.Internal (attoparsecParseJSON,rightToMaybe) import qualified Data.Text.Lazy.Builder as TBuilder import Data.Text.Lazy.Builder.Int (hexadecimal) import Data.Monoid ((<>))@@ -34,6 +34,12 @@ toText :: Mac -> Text toText = LText.toStrict . TBuilder.toLazyText . toTextBuilder++fromText :: Text -> Maybe Mac+fromText = rightToMaybe . fromText'++fromText' :: Text -> Either String Mac+fromText' t = AT.parseOnly (textParser <* AT.endOfInput) t toTextBuilder :: Mac -> TBuilder.Builder toTextBuilder (Mac a b) =
+ src/Net/Mac/ByteString/Char8.hs view
@@ -0,0 +1,24 @@+module Net.Mac.ByteString.Char8+ ( encode+ , decode+ , builder+ , parser+ ) where++import Net.Mac+import Data.ByteString (ByteString)+import Data.Attoparsec.Text (Parser)+import Data.ByteString.Lazy.Builder (Builder)++encode :: Mac -> ByteString+encode = error "write me"++decode :: ByteString -> Either String Mac+decode = error "write me"++builder :: Mac -> Builder+builder = error "write me"++parser :: Parser Mac+parser = error "write me"+
+ src/Net/Mac/Text.hs view
@@ -0,0 +1,29 @@+module Net.Mac.Text + ( encode+ , decode+ , decodeEither+ , builder+ , parser+ ) where++import Net.Mac+import Data.Text (Text)+import Net.Internal (rightToMaybe)+import qualified Data.Attoparsec.Text as AT+import qualified Data.Text.Lazy.Builder as TBuilder++encode :: Mac -> Text+encode = toText++decodeEither :: Text -> Either String Mac+decodeEither = fromText'++decode :: Text -> Maybe Mac+decode = rightToMaybe . decodeEither++builder :: Mac -> TBuilder.Builder+builder = toTextBuilder++parser :: AT.Parser Mac+parser = textParser+
+ test/Bench.hs view
@@ -0,0 +1,33 @@+module Main (main) where++import Naive+import Criterion.Main+import Net.IPv4 (IPv4(..))+import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)+import Data.Monoid ((<>))+import Data.Text.Lazy.Builder.Int (decimal)+import Data.Text.Internal (Text(..))+import Data.Word+import Data.ByteString (ByteString)+import Control.Monad.ST+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++main :: IO ()+main = do+ let ipAddr = IPv4 1000000009+ defaultMain + [ bgroup "IPv4 to Text" + [ bench "Naive" $ whnf ipv4ToTextNaive ipAddr+ , bench "Text Builder" $ whnf toDotDecimalText ipAddr+ , bench "Preallocated" $ whnf toTextPreAllocated ipAddr+ ]+ , bgroup "IPv4 to ByteString" + [ bench "Naive" $ whnf ipv4ToByteStringChar8Naive ipAddr+ ]+ ]
+ test/Test.hs view
@@ -0,0 +1,53 @@+ {-# LANGUAGE StandaloneDeriving #-}+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Main (main) where++import Naive+import Data.List (intercalate)+import Test.QuickCheck (Gen, Arbitrary(..), choose)+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Net.IPv4 (IPv4(..),IPv4Range(..))+import Net.Mac (Mac(..))+import qualified Net.IPv4 as IPv4+import qualified Net.IPv4.Text as IPv4_Text+import qualified Net.Mac as Mac+import qualified Net.Mac.Text as Mac_Text++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests =+ [ testGroup "Naive IPv4 encode/decode" + [ testProperty "Isomorphism" + $ propEncodeDecodeIso ipv4ToTextNaive ipv4FromTextNaive+ ]+ , testGroup "Text Builder IPv4 Text encode/decode"+ [ testProperty "Identical to Naive"+ $ propMatching toDotDecimalText ipv4ToTextNaive+ ]+ , testGroup "Raw byte array IPv4 Text encode/decode"+ [ testProperty "Identical to Naive"+ $ propMatching toTextPreAllocated ipv4ToTextNaive+ ]+ , testGroup "Performant MAC Text encode/decode"+ [ testProperty "Isomorphism" + $ propEncodeDecodeIso Mac_Text.encode Mac_Text.decode+ ]+ ]++deriving instance Arbitrary IPv4++instance Arbitrary Mac where+ arbitrary = fmap fromTuple arbitrary+ where fromTuple (a,b) = Mac a b++propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool+propEncodeDecodeIso f g a = g (f a) == Just a++propMatching :: Eq b => (a -> b) -> (a -> b) -> a -> Bool+propMatching f g a = f a == g a+