base32-bytestring (empty) → 0.1.0.0
raw patch · 9 files changed
+541/−0 lines, 9 filesdep +QuickCheckdep +basedep +base32-bytestringsetup-changed
Dependencies added: QuickCheck, base, base32-bytestring, bits-extras, bytestring, cpu, criterion, hspec
Files
- LICENSE +30/−0
- README.md +24/−0
- Setup.hs +2/−0
- base32-bytestring.cabal +72/−0
- bench/Main.hs +39/−0
- src/Data/ByteString/Base32.hs +82/−0
- src/Data/ByteString/Base32/Hex.hs +61/−0
- src/Data/ByteString/Base32/Internal.hs +230/−0
- tests/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Sam Truzjan++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Sam Truzjan nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,24 @@+`base32-bytestring` is efficient [base32 and base32hex][rfc] codec for+bytestrings. The API is similar to [base16-bytestring][base16-pkg] and+[base64-bytestring][base64-pkg] packages.++### Performance++| function | MB/sec |+|:---------------:|:---------------:|+|encoding | 400 |+|decoding | 400 |+|lenient decoding | N/A |++### Build Status [![Build Status][travis-img]][travis-log]++### Maintainer <pxqr.sta@gmail.com>++You can report any issues at [Issue tracker][issues].++[base16-pkg]: http://hackage.haskell.org/package/base16-bytestring+[base64-pkg]: http://hackage.haskell.org/package/base64-bytestring-1.0.0.1+[rfc]: http://tools.ietf.org/html/rfc4648+[travis-img]: https://travis-ci.org/cobit/base32-bytestring.png+[travis-log]: https://travis-ci.org/cobit/base32-bytestring+[issues]: https://github.com/cobit/base32-bytestring/issues
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ base32-bytestring.cabal view
@@ -0,0 +1,72 @@+name: base32-bytestring+version: 0.1.0.0+license: BSD3+license-file: LICENSE+author: Sam Truzjan+maintainer: Sam Truzjan <pxqr.sta@gmail.com>+copyright: (c) 2013 Sam Truzjan+category: Codec, Data+build-type: Simple+cabal-version: >= 1.10+homepage: https://github.com/cobit/base32-bytestring+bug-reports: https://github.com/cobit/base32-bytestring/issues+synopsis: Fast base32 and base32hex codec for ByteStrings+description:+ base32 and base32hex codec according to RFC4648+ <http://tools.ietf.org/html/rfc4648>+ .+ The package API is similar to base64-bytestring.+ .+ [/Release notes/]+ .+ * /0.1.0.0:/ Initial version.++extra-source-files: README.md++source-repository head+ type: git+ location: git://github.com/cobit/base32-bytestring.git+ branch: master++source-repository this+ type: git+ location: git://github.com/cobit/base32-bytestring.git+ branch: master+ tag: v0.1.0.0++library+ default-language: Haskell2010+ default-extensions:+ hs-source-dirs: src+ exposed-modules: Data.ByteString.Base32+ , Data.ByteString.Base32.Hex+ other-modules: Data.ByteString.Base32.Internal+ build-depends: base == 4.*+ , bytestring >= 0.9+ , cpu == 0.1.*+ , bits-extras == 0.1.*+ ghc-options: -O2 -Wall++test-suite spec+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Spec.hs+ build-depends: base == 4.*+ , base32-bytestring+ , bytestring+ , hspec+ , QuickCheck+ ghc-options: -Wall++benchmark bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs+ build-depends: base == 4.*+ , base32-bytestring+ , bytestring+ , criterion+ ghc-options: -O2 -Wall -fno-warn-orphans
+ bench/Main.hs view
@@ -0,0 +1,39 @@+module Main (main) where++import Criterion.Main+import Data.ByteString as BS+import Data.ByteString.Base32 as Base32+import Data.ByteString.Base32.Hex as Base32Hex++main :: IO ()+main = defaultMain+ [ bench "base32/encode/1M" $ nf Base32.encode+ $ BS.replicate 1000000 0x8e+ , bench "base32/encode/5M" $ nf Base32.encode+ $ BS.replicate 5000000 0x8e++ , bench "base32/decode/regular/1M" $ nf Base32.decode+ $ BS.replicate 1000000 0x41+ , bench "base32/decode/regular/5M" $ nf Base32.decode+ $ BS.replicate 5000000 0x41++-- , bench "base32/decode/lenient/1M" $ nf Base32.decodeLenient+-- $ BS.replicate 1000000 0x41+-- , bench "base32/decode/lenient/5M" $ nf Base32.decodeLenient+-- $ BS.replicate 5000000 0x41++ , bench "base32hex/encode/1M" $ nf Base32Hex.encode+ $ BS.replicate 1000000 0x8e+ , bench "base32hex/encode/5M" $ nf Base32Hex.encode+ $ BS.replicate 5000000 0x8e++ , bench "base32hex/decode/regular/1M" $ nf Base32Hex.decode+ $ BS.replicate 1000000 0x41+ , bench "base32hex/decode/regular/5M" $ nf Base32Hex.decode+ $ BS.replicate 5000000 0x41++-- , bench "base32hex/decode/lenient/1M" $ nf Base32Hex.decodeLenient+-- $ BS.replicate 1000000 0x41+-- , bench "base32hex/decode/lenient/5M" $ nf Base32Hex.decodeLenient+-- $ BS.replicate 5000000 0x41+ ]
+ src/Data/ByteString/Base32.hs view
@@ -0,0 +1,82 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : stable+-- Portability : portable+--+-- Efficient encoding and decoding of base32 encoded bytestring+-- according to RFC 4648. <http://tools.ietf.org/html/rfc4648>+--+-- This module recommended to be imported as+-- @import Data.ByteString.Base32 as Base32@ to avoid name clashes+-- with @Data.Binary@ or @Data.ByteString.Base64@ modules.+--+{-# LANGUAGE BangPatterns #-}+module Data.ByteString.Base32+ ( Base32+ , encode+ , decode+-- , decodeLenient+ ) where++import Data.ByteString as BS+import Data.ByteString.Internal as BS+import Data.ByteString.Base32.Internal+import Data.List as L+++-- | Base32 encoded bytestring.+type Base32 = ByteString++encW5 :: Word5 -> Word8+encW5 !x+ | x <= 25 = 65 + x+ | otherwise = 24 + x+{-# INLINE encW5 #-}++encTable :: EncTable+encTable = BS.pack $ L.map encW5 [0..31]++-- | Encode a bytestring into base32 form.+encode :: ByteString -> Base32+encode = unpack5 encTable++decW5 :: Word8 -> Word5+decW5 !x+ | x < 50 {- c2w '2' -} = invIx+ | x <= 55 {- c2w '7' -} = x - 24 {- c2w '2' - 26 -}+ | x < 65 {- c2w 'A' -} = invIx+ | x <= 90 {- c2w 'Z' -} = x - 65 {- c2w 'A' -}+ | x < 97 {- c2w 'a' -} = invIx+ | x <= 122 {- c2w 'z' -} = x - 97 {- c2w 'a' -}+ | otherwise = invIx+{-# INLINE decW5 #-}++decTable :: ByteString+decTable = BS.pack $ L.map decW5 [minBound .. maxBound]++-- | Decode a base32 encoded bytestring.+decode :: Base32 -> ByteString+decode = pack5 decTable++decCharLenient :: Char -> Word5+decCharLenient x+ | x < '2' = err+ | x <= '7' = 26 + fromIntegral (fromEnum x) - fromIntegral (fromEnum '2')+ | x < 'A' = err+ | x <= 'Z' = fromIntegral (fromEnum x) - fromIntegral (fromEnum 'A')+ | x < 'a' = err+ | x <= 'z' = fromIntegral (fromEnum x) - fromIntegral (fromEnum 'a')+ | otherwise = err+ where+ err = error "base32: decodeChar: out of range"++decW5Lenient :: Word8 -> Word5+decW5Lenient = decCharLenient . w2c+{-# INLINE decW5Lenient #-}++-- TODO padding leniency+-- | Case-insensitive counterpart of the 'decode'.+decodeLenient :: Base32 -> ByteString+decodeLenient = id -- pack5 nullPtr decW5Lenient
+ src/Data/ByteString/Base32/Hex.hs view
@@ -0,0 +1,61 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : stable+-- Portability : portable+--+-- Efficient encoding and decoding of base32hex encoded bytestring+-- according to RFC 4648. <http://tools.ietf.org/html/rfc4648>+--+-- This module recommended to be imported as @import+-- Data.ByteString.Base32.Hex as Base32Hex@ to avoid name clashes+-- with @Data.ByteString.Base32@.+--+{-# LANGUAGE BangPatterns #-}+module Data.ByteString.Base32.Hex+ ( Base32Hex+ , encode+ , decode+-- , decodeLenient+ ) where++import Data.ByteString as BS+import Data.ByteString.Base32.Internal+import Data.List as L+++-- | Base32Hex encoded bytestring.+type Base32Hex = ByteString++encW5 :: Word5 -> Word8+encW5 !x+ | x <= 9 = 48 {- c2w '0' -} + x+ | otherwise = 55 {- c2w 'A' - 10 -} + x++encTable :: EncTable+encTable = BS.pack $ L.map encW5 [0..31]++-- | Encode a bytestring into base32hex form.+encode :: ByteString -> Base32Hex+encode = unpack5 encTable++decW5 :: Word8 -> Word5+decW5 !x+ | x < 48 {- c2w '0' -} = invIx+ | x <= 57 {- c2w '9' -} = x - 48 {- c2w '0' -}+ | x < 65 {- c2w 'A' -} = invIx+ | x <= 86 {- c2w 'V' -} = x - 55 {- c2w 'A' + 10 -}+ | x < 97 {- c2w 'a' -} = invIx+ | x <= 118 {- c2w 'v' -} = x - 87 {- c2w 'a' + 10 -}+ | otherwise = invIx++decTable :: DecTable+decTable = BS.pack $ L.map decW5 [minBound .. maxBound]++-- | Decode a base32hex encoded bytestring.+decode :: Base32Hex -> ByteString+decode = pack5 decTable++decodeLenient :: Base32Hex -> ByteString+decodeLenient = id
+ src/Data/ByteString/Base32/Internal.hs view
@@ -0,0 +1,230 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : stable+-- Portability : portable+--+-- (Word5 <-> Word8) and (Word8 -> Word5) bytestring packers using+-- lookup table.+--+{-# LANGUAGE BangPatterns #-}+module Data.ByteString.Base32.Internal+ ( Word5+ , Word8++ , EncTable+ , unpack5++ , DecTable+ , pack5+ , invIx+ ) where++import Data.Bits.Extras+import Data.ByteString as BS+import Data.ByteString.Internal as BS+import Data.Word+import Foreign hiding (unsafePerformIO)+import System.IO.Unsafe (unsafePerformIO)+import System.Endian+++{-----------------------------------------------------------------------+-- Utils+-----------------------------------------------------------------------}++type Word5 = Word8++-- System.Endian.toBE32 is slower because toBE32 implemented using+-- cbits shuffle functions while toBE32' implemented used gcc+-- intrinsics+--+toBE64' :: Word64 -> Word64+toBE64' = if getSystemEndianness == BigEndian then id else byteSwap+{-# INLINE toBE64' #-}++toBE32' :: Word32 -> Word32+toBE32' = if getSystemEndianness == BigEndian then id else byteSwap+{-# INLINE toBE32' #-}++fromBE32' :: Word32 -> Word32+fromBE32' = toBE32'+{-# INLINE fromBE32' #-}++-- n = 2 ^ d+padCeilN :: Int -> Int -> Int+padCeilN !n !x+ | remd == 0 = x+ | otherwise = (x - remd) + n+ where mask = n - 1+ remd = x .&. mask++{-----------------------------------------------------------------------+-- Encoding+-----------------------------------------------------------------------}++unpack5Ptr :: Ptr Word8 -> ByteString -> ByteString+unpack5Ptr !tbl bs @ (PS fptr off sz) =+ unsafePerformIO $ do+ let unpackedSize = dstSize $ BS.length bs+ BS.create unpackedSize $ \ dst -> do+ withForeignPtr fptr $ \ ptr -> do+ dst_end <- bigStep dst (advancePtr ptr off) sz+ _ <- fillPadding dst_end (unpackedSize - (dst_end `minusPtr` dst))+ return ()+ where+ dstSize x = padCeilN 8 (d + if m == 0 then 0 else 1)+ where (d, m) = (x * 8) `quotRem` 5++ fillPadding dst s = memset dst (c2w '=') (fromIntegral s)++ bigStep !dst !src !s+ | s >= 5 = do+ unpack5_40 dst src+ bigStep (dst `advancePtr` 8) (src `advancePtr` 5) (s - 5)+ | otherwise = smallStep dst src s 0 0++ unpack5_40 !dst !src = do+ w32he <- peek (castPtr src) :: IO Word32+ let w32 = toBE32' w32he+ fill8_32 0 (w32 `unsafeShiftR` 27)+ fill8_32 1 (w32 `unsafeShiftR` 22)+ fill8_32 2 (w32 `unsafeShiftR` 17)+ fill8_32 3 (w32 `unsafeShiftR` 12)+ fill8_32 4 (w32 `unsafeShiftR` 7)+ fill8_32 5 (w32 `unsafeShiftR` 2)++ w8 <- peekElemOff src 4+ fill8_32 6 ( (w32 `unsafeShiftL` 3)+ .|. fromIntegral (w8 `unsafeShiftR` 5))+ fill8_32 7 (fromIntegral w8)+ where+ fill8_32 :: Int -> Word32 -> IO ()+ fill8_32 !i !w32 = do+ w8 <- peekByteOff tbl (fromIntegral w32 .&. 0x1f)+ poke (dst `advancePtr` i) w8++ smallStep !dst !src !s !unused !un_cnt+ | un_cnt >= 5 = do+ let ix = unused `unsafeShiftR` 3+ peekByteOff tbl (fromIntegral ix) >>= poke dst+ smallStep (advancePtr dst 1)+ src s+ (unused `unsafeShiftL` 5)+ (un_cnt - 5)++ | s == 0 = do+ if un_cnt == 0+ then return dst+ else do+ let ix = unused `unsafeShiftR` 3+ peekByteOff tbl (fromIntegral ix) >>= poke dst+ return (dst `advancePtr` 1)++ | otherwise = do+ w8 <- peek src+ let usd_cnt = 5 - un_cnt+ let bits = w8 .&. complement (bit (8 - usd_cnt) - 1)+ let ix = (unused .|. bits `shiftR` un_cnt) `unsafeShiftR` 3+ peekByteOff tbl (fromIntegral ix) >>= poke dst+ smallStep (advancePtr dst 1)+ (advancePtr src 1) (pred s)+ (w8 `shiftL` usd_cnt) (8 - usd_cnt)++type EncTable = ByteString++unpack5 :: EncTable -> ByteString -> ByteString+unpack5 (PS fptr off len) bs+ | len /= 32+ = error $ "base32: unpack5: invalid lookup table size " ++ show len+ | otherwise =+ unsafePerformIO $ do+ withForeignPtr fptr $ \ptr -> do+ return $ unpack5Ptr (ptr `advancePtr` off) bs++{-----------------------------------------------------------------------+-- Decoding+-----------------------------------------------------------------------}++invIx :: Word5+invIx = 255++pack5Ptr :: Ptr Word5 -> ByteString -> ByteString+pack5Ptr !tbl bs @ (PS fptr off sz) =+ unsafePerformIO $ do+ let packedSize = dstSize $ BS.length bs+ BS.createAndTrim packedSize $ \ dst -> do+ withForeignPtr fptr $ \ ptr -> do+ dst_end <- bigStep dst (advancePtr ptr off) sz+ return (dst_end `minusPtr` dst)+ where+ lookupTable :: Word8 -> Word5+ lookupTable ix+ | x == invIx = error $ "base32: decode: invalid character" ++ show ix+ | otherwise = x+ where x = inlinePerformIO (peekByteOff tbl (fromIntegral ix))+ {-# INLINE lookupTable #-}++ dstSize x = d + if m == 0 then 0 else 1+ where (d, m) = (x * 5) `quotRem` 8++ bigStep !dst !src !s+ | s > 8 = do+ pack5_40 dst src+ bigStep (dst `advancePtr` 5) (src `advancePtr` 8) (s - 8)+ | otherwise = smallStep dst src s (0 :: Word64) 0++ pack5_40 !dst !src = do+ w64he <- peek (castPtr src) :: IO Word64+ let w64 = toBE64' w64he+ let w40 = putAsW5 (w64 `unsafeShiftR` 00) $+ putAsW5 (w64 `unsafeShiftR` 08) $+ putAsW5 (w64 `unsafeShiftR` 16) $+ putAsW5 (w64 `unsafeShiftR` 24) $+ putAsW5 (w64 `unsafeShiftR` 32) $+ putAsW5 (w64 `unsafeShiftR` 40) $+ putAsW5 (w64 `unsafeShiftR` 48) $+ putAsW5 (w64 `unsafeShiftR` 56) 0+ pokeW40 w40+ where+ putAsW5 :: Word64 -> Word64 -> Word64+ {-# INLINE putAsW5 #-}+ putAsW5 !w8 !acc = (acc `unsafeShiftL` 5)+ .|. fromIntegral (lookupTable (fromIntegral w8))++ pokeW40 :: Word64 -> IO ()+ {-# INLINE pokeW40 #-}+ pokeW40 !w40 = do+ poke dst (fromIntegral (w40 `unsafeShiftR` 32) :: Word8)+ poke (castPtr (dst `advancePtr` 1))+ (fromBE32' (fromIntegral w40 :: Word32))++ smallStep !dst !src !s !unused !un_cnt+ | un_cnt >= 8 = do+ poke dst $ fromIntegral (unused `unsafeShiftR` (un_cnt - 8))+ smallStep (dst `advancePtr` 1) src s unused (un_cnt - 8)++ | s == 0 = return dst+ | otherwise = do+ w8 <- peek src+ if w2c w8 == '='+ then if (bit un_cnt - 1) .&. unused == 0+ then smallStep dst src 0 0 0+ else smallStep dst src 0 (unused `shiftL` (8 - un_cnt)) 8+ else smallStep dst+ (src `advancePtr` 1) (pred s)+ ((unused `unsafeShiftL` 5)+ .|. fromIntegral (lookupTable (fromIntegral w8)))+ (un_cnt + 5)++type DecTable = ByteString++pack5 :: DecTable -> ByteString -> ByteString+pack5 (PS fptr off len) bs+ | len /= 256+ = error $ "base32: pack5: invalid lookup table size " ++ show len+ | otherwise =+ unsafePerformIO $ do+ withForeignPtr fptr $ \ptr ->+ return $ pack5Ptr (ptr `advancePtr` off) bs
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}