diff --git a/ip.cabal b/ip.cabal --- a/ip.cabal +++ b/ip.cabal @@ -1,5 +1,5 @@ name: ip -version: 0.4 +version: 0.5 synopsis: Library for IP and MAC addresses description: Please see README.md homepage: https://github.com/andrewthad/ip#readme @@ -55,6 +55,10 @@ , criterion , text , bytestring + other-modules: + Naive + IPv4Text1 + IPv4Text2 ghc-options: -Wall -O2 default-language: Haskell2010 hs-source-dirs: test diff --git a/src/Net/IPv4.hs b/src/Net/IPv4.hs --- a/src/Net/IPv4.hs +++ b/src/Net/IPv4.hs @@ -9,7 +9,10 @@ @Net.IPv4.Text@ and @Net.IPv4.ByteString.Char8@ instead. They are defined here so that the 'FromJSON' and 'ToJSON' instances can use them. - + + At some point, a highly efficient IPv4-to-ByteString function needs + to be added to this module to take advantage of @aeson@'s new + @toEncoding@ method. -} module Net.IPv4 @@ -153,9 +156,6 @@ 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 = TBuilder.fromText . toTextPreAllocated {-# INLINE toDotDecimalBuilder #-} @@ -169,6 +169,10 @@ <> TBuilder.singleton '/' <> decimal len +-- | I think that this function can be improved. Right now, it +-- always allocates enough space for a fifteen-character text +-- rendering of an IP address. I think that it should be possible +-- to do more of the math upfront and allocate less space. toTextPreAllocated :: IPv4 -> Text toTextPreAllocated (IPv4 w) = let w1 = fromIntegral $ 255 .&. shiftR w 24 diff --git a/src/Net/IPv4/ByteString/Char8.hs b/src/Net/IPv4/ByteString/Char8.hs --- a/src/Net/IPv4/ByteString/Char8.hs +++ b/src/Net/IPv4/ByteString/Char8.hs @@ -6,19 +6,40 @@ ) where import Net.IPv4 +import Control.Monad +import qualified Net.IPv4.Text as IPv4Text +import qualified Data.Attoparsec.ByteString.Char8 as AB +import qualified Data.ByteString.Builder as Builder +import Net.Internal (rightToMaybe) +import Data.Text.Encoding (encodeUtf8, decodeUtf8') import Data.ByteString (ByteString) -import Data.Attoparsec.Text (Parser) -import Data.ByteString.Lazy.Builder (Builder) +import Data.Attoparsec.ByteString.Char8 (Parser) +import Data.ByteString.Builder (Builder) +-- | This should be rewritten to not create 'Text' as an +-- intermediate step. encode :: IPv4 -> ByteString -encode = error "write me" +encode = encodeUtf8 . IPv4Text.encode -decode :: ByteString -> Either String IPv4 -decode = error "write me" +-- | This should also be rewritten +decode :: ByteString -> Maybe IPv4 +decode = IPv4Text.decode <=< rightToMaybe . decodeUtf8' builder :: IPv4 -> Builder -builder = error "write me" +builder = Builder.byteString . encode parser :: Parser IPv4 -parser = error "write me" +parser = fromOctets' + <$> (AB.decimal >>= limitSize) + <* AB.char '.' + <*> (AB.decimal >>= limitSize) + <* AB.char '.' + <*> (AB.decimal >>= limitSize) + <* AB.char '.' + <*> (AB.decimal >>= limitSize) + where + limitSize i = + if i > 255 + then fail "All octets in an ip address must be between 0 and 255" + else return i diff --git a/src/Net/Mac/ByteString/Char8.hs b/src/Net/Mac/ByteString/Char8.hs --- a/src/Net/Mac/ByteString/Char8.hs +++ b/src/Net/Mac/ByteString/Char8.hs @@ -7,18 +7,42 @@ import Net.Mac import Data.ByteString (ByteString) -import Data.Attoparsec.Text (Parser) +import Data.Attoparsec.ByteString.Char8 (Parser) import Data.ByteString.Lazy.Builder (Builder) +import Net.Internal (rightToMaybe) +import Data.Text.Encoding (encodeUtf8, decodeUtf8') +import Control.Monad +import qualified Data.ByteString.Builder as Builder +import qualified Data.Attoparsec.ByteString.Char8 as AB +import qualified Net.Mac.Text as MacText +-- | This is a bad implementation that should be rewritten encode :: Mac -> ByteString -encode = error "write me" +encode = encodeUtf8 . MacText.encode -decode :: ByteString -> Either String Mac -decode = error "write me" +-- | This is a bad implementation that should be rewritten +decode :: ByteString -> Maybe Mac +decode = MacText.decode <=< rightToMaybe . decodeUtf8' builder :: Mac -> Builder -builder = error "write me" +builder = Builder.byteString . encode parser :: Parser Mac -parser = error "write me" +parser = fromOctets' + <$> (AB.hexadecimal >>= limitSize) + <* AB.char ':' + <*> (AB.hexadecimal >>= limitSize) + <* AB.char ':' + <*> (AB.hexadecimal >>= limitSize) + <* AB.char ':' + <*> (AB.hexadecimal >>= limitSize) + <* AB.char ':' + <*> (AB.hexadecimal >>= limitSize) + <* AB.char ':' + <*> (AB.hexadecimal >>= limitSize) + where + limitSize i = + if i > 255 + then fail "All octets in a mac address must be between 00 and FF" + else return i diff --git a/test/Bench.hs b/test/Bench.hs --- a/test/Bench.hs +++ b/test/Bench.hs @@ -1,6 +1,5 @@ module Main (main) where -import Naive import Criterion.Main import Net.IPv4 (IPv4(..)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) @@ -18,16 +17,20 @@ import qualified Data.Text.Array as TArray import qualified Net.IPv4.Text as IPv4_Text +import qualified Naive +import qualified IPv4Text1 +import qualified IPv4Text2 + 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 + [ bench "Naive" $ whnf Naive.encodeText ipAddr + , bench "Text Builder" $ whnf IPv4Text2.encode ipAddr + , bench "Preallocated" $ whnf IPv4Text1.encode ipAddr ] , bgroup "IPv4 to ByteString" - [ bench "Naive" $ whnf ipv4ToByteStringChar8Naive ipAddr + [ bench "Naive" $ whnf Naive.encodeByteString ipAddr ] ] diff --git a/test/IPv4Text1.hs b/test/IPv4Text1.hs new file mode 100644 --- /dev/null +++ b/test/IPv4Text1.hs @@ -0,0 +1,109 @@ +module IPv4Text1 where + +import Net.IPv4 (IPv4(..)) +import Data.Text (Text) +import qualified Net.IPv4 as IPv4 +import qualified Data.Text as Text +import Text.Read (readMaybe) +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 Data.Text.Encoding (encodeUtf8) +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 + +------------------------ +-- This implementation operates directly on +-- a mutable array. It is the fastest one so far. +-- On a 2012 laptop, it can serialize an IPv4 +-- address to Text in 35ns. It is somewhat wasteful +-- of space. It allocates a full 30 bytes in case it +-- needs it, but it may need as few as 14 bytes. +------------------------ +encode :: IPv4 -> Text +encode (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,dot :: Word16 +zero = 48 +{-# INLINE zero #-} +dot = 46 +{-# INLINE dot #-} + +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" + diff --git a/test/IPv4Text2.hs b/test/IPv4Text2.hs new file mode 100644 --- /dev/null +++ b/test/IPv4Text2.hs @@ -0,0 +1,43 @@ +module IPv4Text2 where + +import Net.IPv4 (IPv4(..)) +import Data.Text (Text) +import qualified Net.IPv4 as IPv4 +import qualified Data.Text as Text +import Text.Read (readMaybe) +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 Data.Text.Encoding (encodeUtf8) +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 + +----------------------------------------- +-- Text Builder implementation. This ends +-- up performing worse than the naive +-- implementation. +----------------------------------------- +encode :: IPv4 -> Text +encode = LText.toStrict . TBuilder.toLazyText . toDotDecimalBuilder + +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 '.' +{-# INLINE toDotDecimalBuilder #-} + diff --git a/test/Naive.hs b/test/Naive.hs new file mode 100644 --- /dev/null +++ b/test/Naive.hs @@ -0,0 +1,44 @@ +module Naive where + +import Net.IPv4 (IPv4(..)) +import Data.Text (Text) +import qualified Net.IPv4 as IPv4 +import qualified Data.Text as Text +import Text.Read (readMaybe) +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 Data.Text.Encoding (encodeUtf8) +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 + +encodeByteString :: IPv4 -> ByteString +encodeByteString = encodeUtf8 . encodeText + +encodeText :: IPv4 -> Text +encodeText i = Text.pack $ concat + [ show a + , "." + , show b + , "." + , show c + , "." + , show d + ] + where (a,b,c,d) = IPv4.toOctets i + +ipv4FromTextNaive :: Text -> Maybe IPv4 +ipv4FromTextNaive 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 +