base64 0.3.1.0 → 0.3.1.1
raw patch · 6 files changed
+150/−62 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- base64.cabal +1/−1
- benchmarks/Base64Bench.hs +9/−8
- src/Data/ByteString/Base64.hs +1/−2
- src/Data/ByteString/Base64/Internal.hs +134/−49
- src/Data/ByteString/Base64/URL.hs +1/−2
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for base64 +## 0.3.1.1 -- 2020-01-15++* Make sure benchmark code builds+ ## 0.3.1.0 -- 2020-01-08 * Bug fix for `isBase64` and `isBase64Url` - wrong alphabet was used
base64.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: base64-version: 0.3.1.0+version: 0.3.1.1 synopsis: RFC 4648-compliant padded and unpadded base64 and base64url encodings description: RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding.
benchmarks/Base64Bench.hs view
@@ -33,18 +33,19 @@ main :: IO () main = defaultMain $ bench' stepwise random encode_- ++ bench' stepwise (fmap B64.encodeBase64' . random) decode_- ++ bench' stepwise (fmap B64.encodeBase64' . random) lenient_- bench' chonkers random mbPerSec+ ++ bench' stepwise encoded decode_+ ++ bench' stepwise encoded lenient_+ ++ bench' megabytes random mbPerSec where+ encoded = fmap B64.encodeBase64' . random bench' sz f b = fmap (benchN f b) sz stepwise = [25,100,1000,10000,100000]- chonkers = fmap (* 1000000) [1..5]+ megabytes = fmap (* 1000000) [1..5] benchN f bs n = env (f n) $ bgroup (show n) . bs encode_ e =- [ bgroup "base64 encode"+ [ bgroup "encode" [ encodeBench @'Mem e , encodeBench @'Bos e , encodeBench @'B64 e@@ -52,7 +53,7 @@ ] decode_ e =- [ bgroup "base64 decode"+ [ bgroup "decode" [ decodeBench @'Mem e , decodeBench @'Bos e , decodeBench @'B64 e@@ -60,14 +61,14 @@ ] lenient_ e =- [ bgroup "base64 decode-lenient"+ [ bgroup "decode-lenient" [ lenientBench @'Bos e , lenientBench @'B64 e ] ] mbPerSec e =- [ bgroup "base64 MB/s benches"+ [ bgroup "MB per second" [ encodeBench @'Mem e , encodeBench @'Bos e , encodeBench @'B64 e
src/Data/ByteString/Base64.hs view
@@ -27,7 +27,6 @@ import Data.ByteString (ByteString)-import qualified Data.ByteString as BS import Data.ByteString.Base64.Internal import Data.Either (isRight) import Data.Text (Text)@@ -89,7 +88,7 @@ -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> -- encodeBase64Unpadded' :: ByteString -> ByteString-encodeBase64Unpadded' = BS.takeWhile ((/=) 0x3d) . encodeBase64_ base64Table+encodeBase64Unpadded' = encodeBase64Nopad_ base64Table {-# INLINE encodeBase64Unpadded' #-} -- | Decode an unpadded Base64-encoded 'ByteString'.
src/Data/ByteString/Base64/Internal.hs view
@@ -18,6 +18,7 @@ module Data.ByteString.Base64.Internal ( -- * Base64 encoding encodeBase64_+, encodeBase64Nopad_ -- * Base64 decoding , decodeBase64_@@ -42,7 +43,6 @@ import Data.Bits-import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Internal import Data.Text (Text)@@ -131,6 +131,77 @@ -- -------------------------------------------------------------------------- -- -- Encode Base64 +-- | Read 'Word8' index off alphabet addr+--+aix :: Word8 -> Addr# -> Word8+aix (W8# i) alpha = W8# (indexWord8OffAddr# alpha (word2Int# i))+{-# INLINE aix #-}++w32 :: Word8 -> Word32+w32 = fromIntegral+{-# INLINE w32 #-}++-- | Encoding inner loop. Packs 3 bytes from src pointer into+-- the first 6 bytes of 4 'Word8''s (using the encoding table,+-- as 2 'Word12''s ), writing these to the dst pointer.+--+innerLoop+ :: Ptr Word16+ -> Ptr Word8+ -> Ptr Word16+ -> Ptr Word8+ -> (Ptr Word8 -> Ptr Word8 -> IO ())+ -> IO ()+innerLoop etable sptr dptr end finalize = go sptr dptr+ where+ go !src !dst+ | plusPtr src 2 >= end = finalize src (castPtr dst)+ | otherwise = do++ !i <- w32 <$> peek src+ !j <- w32 <$> peek (plusPtr src 1)+ !k <- w32 <$> peek (plusPtr src 2)++ let !w = (shiftL i 16) .|. (shiftL j 8) .|. k++ !x <- peekElemOff etable (fromIntegral (shiftR w 12))+ !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))++ poke dst x+ poke (plusPtr dst 2) y++ go (plusPtr src 3) (plusPtr dst 4)+{-# INLINE innerLoop #-}++-- | Unpadded encoding loop, finalized as a bytestring using the+-- resultant length count.+--+innerLoopNopad+ :: Ptr Word16+ -> Ptr Word8+ -> Ptr Word16+ -> Ptr Word8+ -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString)+ -> IO ByteString+innerLoopNopad etable sptr dptr end finalize = go sptr dptr 0+ where+ go !src !dst !n+ | plusPtr src 2 >= end = finalize src (castPtr dst) n+ | otherwise = do+ !i <- w32 <$> peek src+ !j <- w32 <$> peek (plusPtr src 1)+ !k <- w32 <$> peek (plusPtr src 2)++ let !w = (shiftL i 16) .|. (shiftL j 8) .|. k+ !x <- peekElemOff etable (fromIntegral (shiftR w 12))+ !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))++ poke dst x+ poke (plusPtr dst 2) y++ go (plusPtr src 3) (plusPtr dst 4) (n + 4)+{-# INLINE innerLoopNopad #-}+ encodeBase64_ :: EncodingTable -> ByteString -> ByteString encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeCreate dlen $ \dptr ->@@ -143,7 +214,6 @@ (castPtr dptr) (plusPtr sptr (soff + slen)) where- dlen :: Int !dlen = 4 * ((slen + 2) `div` 3) {-# INLINE encodeBase64_ #-} @@ -154,55 +224,79 @@ -> Ptr Word16 -> Ptr Word8 -> IO ()-encodeBase64_' (Ptr !alpha) !etable !sptr !dptr !end = go sptr dptr+encodeBase64_' (Ptr !alpha) !etable !sptr !dptr !end =+ innerLoop etable sptr dptr end finalize where- ix (W8# i) = W8# (indexWord8OffAddr# alpha (word2Int# i))- {-# INLINE ix #-}-- w32 :: Word8 -> Word32- w32 = fromIntegral- {-# INLINE w32 #-}-- go !src !dst- | plusPtr src 2 >= end = finalize src (castPtr dst)+ finalize !src !dst+ | src == end = return () | otherwise = do+ !k <- peekByteOff src 0 - -- ideally, we want to do single read @uint32_t w = src[0..3]@ and simply- -- discard the upper bits. TODO.- --- !i <- w32 <$> peek src- !j <- w32 <$> peek (plusPtr src 1)- !k <- w32 <$> peek (plusPtr src 2)+ let !a = shiftR (k .&. 0xfc) 2+ !b = shiftL (k .&. 0x03) 4 - -- pack 3 'Word8's into a the first 24 bits of a 'Word32'- --- let !w = (shiftL i 16) .|. (shiftL j 8) .|. k+ pokeByteOff dst 0 (aix a alpha) - -- ideally, we'd want to pack this is in a single read, then- -- a single write- --- !x <- peekElemOff etable (fromIntegral (shiftR w 12))- !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))+ if plusPtr src 2 /= end+ then do+ pokeByteOff dst 1 (aix b alpha)+ pokeByteOff @Word8 dst 2 0x3d+ pokeByteOff @Word8 dst 3 0x3d+ else do+ !k' <- peekByteOff src 1 - poke dst x- poke (plusPtr dst 2) y+ let !b' = shiftR (k' .&. 0xf0) 4 .|. b+ !c' = shiftL (k' .&. 0x0f) 2 - go (plusPtr src 3) (plusPtr dst 4)+ pokeByteOff dst 1 (aix b' alpha)+ pokeByteOff dst 2 (aix c' alpha)+ pokeByteOff @Word8 dst 3 0x3d+{-# INLINE encodeBase64_' #-} - finalize :: Ptr Word8 -> Ptr Word8 -> IO ()- finalize !src !dst- | src == end = return ()+encodeBase64Nopad_ :: EncodingTable -> ByteString -> ByteString+encodeBase64Nopad_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) =+ unsafeDupablePerformIO $ do+ dfp <- mallocPlainForeignPtrBytes dlen+ withForeignPtr dfp $ \dptr ->+ withForeignPtr efp $ \etable ->+ withForeignPtr sfp $ \sptr ->+ encodeBase64Nopad_'+ aptr+ etable+ (plusPtr sptr soff)+ (castPtr dptr)+ (plusPtr sptr (soff + slen))+ dfp+ where+ !dlen = 4 * ((slen + 2) `div` 3)++encodeBase64Nopad_'+ :: Ptr Word8+ -> Ptr Word16+ -> Ptr Word8+ -> Ptr Word16+ -> Ptr Word8+ -> ForeignPtr Word8+ -> IO ByteString+encodeBase64Nopad_' (Ptr !alpha) !etable !sptr !dptr !end !dfp =+ innerLoopNopad etable sptr dptr end finalize+ where+ finalize !src !dst !n+ | src == end = return (PS dfp 0 n) | otherwise = do !k <- peekByteOff src 0 let !a = shiftR (k .&. 0xfc) 2 !b = shiftL (k .&. 0x03) 4 - pokeByteOff dst 0 (ix a)+ pokeByteOff dst 0 (aix a alpha) - if plusPtr src 2 == end+ if plusPtr src 2 /= end then do+ pokeByteOff dst 1 (aix b alpha)+ return (PS dfp 0 (n + 2))+ else do !k' <- peekByteOff src 1 let !b' = shiftR (k' .&. 0xf0) 4 .|. b@@ -210,15 +304,10 @@ -- ideally, we'd want to pack these is in a single write --- pokeByteOff dst 1 (ix b')- pokeByteOff dst 2 (ix c')- pokeByteOff @Word8 dst 3 0x3d+ pokeByteOff dst 1 (aix b' alpha)+ pokeByteOff dst 2 (aix c' alpha)+ return (PS dfp 0 (n + 3)) - else do- pokeByteOff dst 1 (ix b)- pokeByteOff @Word8 dst 2 0x3d- pokeByteOff @Word8 dst 3 0x3d-{-# INLINE encodeBase64_' #-} -- -------------------------------------------------------------------------- -- -- Decoding Base64@@ -269,7 +358,7 @@ decodeBase64_ :: Bool -> ForeignPtr Word8 -> ByteString -> Either Text ByteString decodeBase64_ !padding !dtfp bs@(PS _ _ !slen)- | padding = go (BS.append bs (BS.replicate r 0x3d))+ | padding = go (BS.append bs (BS.replicate r 0x3d)) | r /= 0 && (not padding) = Left "invalid padding" | otherwise = go bs where@@ -347,6 +436,7 @@ go (plusPtr dst 3) (plusPtr src 4) (n + 3) {-# INLINE decodeBase64_' #-} + decodeBase64Lenient_ :: ForeignPtr Word8 -> ByteString -> ByteString decodeBase64Lenient_ !dtfp (PS !sfp !soff !slen) = unsafeDupablePerformIO $ withForeignPtr dtfp $ \dtable ->@@ -381,15 +471,10 @@ finalize !n = return (PS dfp 0 n) {-# INLINE finalize #-} - look- :: Bool- -> Ptr Word8- -> (Ptr Word8 -> Word32 -> IO ByteString)- -> IO ByteString look skip !p_ f = k p_ where k !p- | p >= end = f (plusPtr end (-1)) 0x63+ | p >= end = f (plusPtr end (-1)) (0x63 :: Word32) | otherwise = do !i <- peekByteOff @Word8 p 0 !v <- peekByteOff @Word8 dtable (fromIntegral i)
src/Data/ByteString/Base64/URL.hs view
@@ -26,7 +26,6 @@ ) where import Data.ByteString (ByteString)-import qualified Data.ByteString as BS import Data.ByteString.Base64.Internal import Data.Either (isRight) import Data.Text (Text)@@ -78,7 +77,7 @@ -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> -- encodeBase64Unpadded' :: ByteString -> ByteString-encodeBase64Unpadded' = BS.takeWhile ((/=) 0x3d) . encodeBase64_ base64UrlTable+encodeBase64Unpadded' = encodeBase64Nopad_ base64UrlTable {-# INLINE encodeBase64Unpadded' #-} -- | Decode a padded Base64url-encoded 'ByteString' value. If its length is not a multiple