base64 0.4.0 → 0.4.1
raw patch · 12 files changed
+543/−189 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- README.md +1/−1
- base64.cabal +9/−3
- benchmarks/Base64Bench.hs +5/−2
- src/Data/ByteString/Base64.hs +5/−5
- src/Data/ByteString/Base64/Internal.hs +35/−173
- src/Data/ByteString/Base64/Internal/Tail.hs +95/−0
- src/Data/ByteString/Base64/Internal/Utils.hs +58/−0
- src/Data/ByteString/Base64/Internal/W32/Loop.hs +93/−0
- src/Data/ByteString/Base64/Internal/W64/Loop.hs +143/−0
- src/Data/ByteString/Base64/Internal/W8/Loop.hs +88/−0
- src/Data/ByteString/Base64/URL.hs +5/−5
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for base64 +## 0.4.1 -- 2020-02-04++* Optimize loops for 32-bit and 64-bit architectures+* Restructure project to be more amenable to swapping head/tail/loops+* Fix module header alignment+ ## 0.4.0 -- 2020-01-26 * With this major version release, we remove the redundant `encodeBase64Unpadded` and `decodeBase64Unpadded` functions from `Base64.hs`. This is for two reasons:
README.md view
@@ -20,7 +20,7 @@ There are no dependencies aside from those bundled with GHC: -+ ### Motivation
base64.cabal view
@@ -1,10 +1,11 @@ cabal-version: 2.0 name: base64-version: 0.4.0-synopsis: RFC 4648-compliant padded and unpadded base64 and base64url encodings+version: 0.4.1+synopsis: Fast RFC 4648-compliant Base64 encoding description:- RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding.+ RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. This library provides+ performant encoding and decoding primitives, as well as support for textual values. homepage: https://github.com/emilypi/base64 bug-reports: https://github.com/emilypi/base64/issues license: BSD3@@ -32,6 +33,11 @@ , Data.Text.Encoding.Base64.URL other-modules: Data.ByteString.Base64.Internal+ Data.ByteString.Base64.Internal.Tail+ Data.ByteString.Base64.Internal.Utils+ Data.ByteString.Base64.Internal.W32.Loop+ Data.ByteString.Base64.Internal.W64.Loop+ Data.ByteString.Base64.Internal.W8.Loop build-depends: base >=4.10 && <5 , bytestring ^>=0.10
benchmarks/Base64Bench.hs view
@@ -29,7 +29,7 @@ main :: IO () main = defaultMain- [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k) ->+ [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) -> bgroup "encode" [ bgroup "memory" [ bench "25" $ whnf ctob bs25@@ -45,6 +45,7 @@ , bench "1000" $ whnf Bos.encode bs1k , bench "10000" $ whnf Bos.encode bs10k , bench "100000" $ whnf Bos.encode bs100k+ , bench "1000000" $ whnf Bos.encode bs1mm ] , bgroup "base64" [ bench "25" $ whnf B64.encodeBase64' bs25@@ -52,6 +53,7 @@ , bench "1000" $ whnf B64.encodeBase64' bs1k , bench "10000" $ whnf B64.encodeBase64' bs10k , bench "100000" $ whnf B64.encodeBase64' bs100k+ , bench "1000000" $ whnf B64.encodeBase64' bs1mm ] ] ]@@ -65,4 +67,5 @@ c <- random 1000 d <- random 10000 e <- random 100000- return (a,b,c,d,e)+ f <- random 1000000+ return (a,b,c,d,e,f)
src/Data/ByteString/Base64.hs view
@@ -2,12 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Data.ByteString.Base64--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2019 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable -- -- This module contains the combinators implementing the -- RFC 4648 specification for the Base64 encoding including
src/Data/ByteString/Base64/Internal.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2019 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable -- -- Internal module defining the encoding and decoding -- processes and tables.@@ -43,8 +44,20 @@ ) where +#include "MachDeps.h"+ import Data.Bits import qualified Data.ByteString as BS+import Data.ByteString.Base64.Internal.Tail+import Data.ByteString.Base64.Internal.Utils+#if WORD_SIZE_IN_BITS == 32+import Data.ByteString.Base64.Internal.W32.Loop+#elif WORD_SIZE_IN_BITS == 64+import Data.ByteString.Base64.Internal.W64.Loop+#else+import Data.ByteString.Base64.Internal.W8.Loop+#endif+ import Data.ByteString.Internal import Data.Text (Text) import qualified Data.Text as T@@ -78,23 +91,8 @@ -- ^ Do we not pad out the bytestring? deriving Eq --- | Allocate and fill @n@ bytes with some data+-- | Pack an 'Addr#' into an encoding table of 'Word16's ---writeNPlainForeignPtrBytes- :: ( Storable a- , Storable b- )- => Int- -> [a]- -> ForeignPtr b-writeNPlainForeignPtrBytes !n as = unsafeDupablePerformIO $ do- fp <- mallocPlainForeignPtrBytes n- withForeignPtr fp $ \p -> go p as- return (castForeignPtr fp)- where- go !_ [] = return ()- go !p (x:xs) = poke p x >> go (plusPtr p 1) xs- packTable :: Addr# -> EncodingTable packTable alphabet = etable where@@ -108,18 +106,23 @@ ] in EncodingTable (Ptr alphabet) (writeNPlainForeignPtrBytes 8192 bs) +-- | Base64url encoding table+-- base64UrlTable :: EncodingTable base64UrlTable = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"# {-# NOINLINE base64UrlTable #-} +-- | Base64 std encoding table+-- base64Table :: EncodingTable base64Table = packTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"# {-# NOINLINE base64Table #-} - -- -------------------------------------------------------------------------- -- -- Validating Base64 +-- | Given a bytestring, check to see that it conforms to a given alphabet+-- validateBase64 :: ByteString -> ByteString -> Bool validateBase64 !alphabet (PS fp off l) = accursedUnutterablePerformIO $ withForeignPtr fp $ \p ->@@ -142,178 +145,37 @@ -- -------------------------------------------------------------------------- -- -- 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)---- | 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)- encodeBase64_ :: EncodingTable -> ByteString -> ByteString encodeBase64_ (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeCreate dlen $ \dptr -> withForeignPtr sfp $ \sptr ->- withForeignPtr efp $ \eptr ->- encodeBase64_'- aptr+ withForeignPtr efp $ \eptr -> do+ let !end = plusPtr sptr (soff + slen)+ innerLoop eptr (plusPtr sptr soff) (castPtr dptr)- (plusPtr sptr (soff + slen))+ end+ (loopTail aptr end) where !dlen = 4 * ((slen + 2) `div` 3) -encodeBase64_'- :: Ptr Word8- -> Ptr Word16- -> Ptr Word8- -> Ptr Word16- -> Ptr Word8- -> IO ()-encodeBase64_' (Ptr !alpha) !etable !sptr !dptr !end =- innerLoop etable sptr dptr end finalize- where- finalize !src !dst- | src == end = return ()- | otherwise = do- !k <- peekByteOff src 0-- let !a = shiftR (k .&. 0xfc) 2- !b = shiftL (k .&. 0x03) 4-- pokeByteOff dst 0 (aix a alpha)-- 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-- let !b' = shiftR (k' .&. 0xf0) 4 .|. b- !c' = shiftL (k' .&. 0x0f) 2-- pokeByteOff dst 1 (aix b' alpha)- pokeByteOff dst 2 (aix c' alpha)- pokeByteOff @Word8 dst 3 0x3d-- 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+ withForeignPtr sfp $ \sptr -> do+ let !end = plusPtr sptr (soff + slen)+ innerLoopNopad etable (plusPtr sptr soff) (castPtr dptr)- (plusPtr sptr (soff + slen))- dfp+ end+ (loopTailNoPad dfp aptr end) 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 (aix a alpha)-- 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- !c' = shiftL (k' .&. 0x0f) 2-- -- ideally, we'd want to pack these is in a single write- --- pokeByteOff dst 1 (aix b' alpha)- pokeByteOff dst 2 (aix c' alpha)- return (PS dfp 0 (n + 3)) -- -------------------------------------------------------------------------- --
+ src/Data/ByteString/Base64/Internal/Tail.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module : Data.ByteString.Base64.Internal.W32.Loop+-- Copyright : (c) 2019 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- Finalizers for the encoding loop+--+module Data.ByteString.Base64.Internal.Tail+( loopTail+, loopTailNoPad+) where++import Data.Bits+import Data.ByteString.Internal+import Data.ByteString.Base64.Internal.Utils++import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable++import GHC.Exts+import GHC.Word++-- | Finalize an encoded bytestring by filling in the remaining+-- bytes and any padding+--+loopTail :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()+loopTail (Ptr !alpha) !end !src !dst+ | src == end = return ()+ | otherwise = do+ !k <- peekByteOff src 0++ let !a = shiftR (k .&. 0xfc) 2+ !b = shiftL (k .&. 0x03) 4++ pokeByteOff dst 0 (aix a alpha)++ 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++ let !b' = shiftR (k' .&. 0xf0) 4 .|. b+ !c' = shiftL (k' .&. 0x0f) 2++ pokeByteOff dst 1 (aix b' alpha)+ pokeByteOff dst 2 (aix c' alpha)+ pokeByteOff @Word8 dst 3 0x3d+{-# INLINE loopTail #-}+++-- | Finalize a bytestring by filling out the remaining bits+-- without padding.+--+loopTailNoPad+ :: ForeignPtr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Int+ -> IO ByteString+loopTailNoPad !dfp (Ptr !alpha) !end !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 (aix a alpha)++ 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+ !c' = shiftL (k' .&. 0x0f) 2++ pokeByteOff dst 1 (aix b' alpha)+ pokeByteOff dst 2 (aix c' alpha)+ return (PS dfp 0 (n + 3))+{-# INLINE loopTailNoPad #-}
+ src/Data/ByteString/Base64/Internal/Utils.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+-- |+-- Module : Data.ByteString.Base64.Internal+-- Copyright : (c) 2019 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- Shared internal utils+--+module Data.ByteString.Base64.Internal.Utils+( aix+, w32+, writeNPlainForeignPtrBytes+) where+++import System.IO.Unsafe++import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable++import GHC.Exts+import GHC.ForeignPtr+import GHC.Word++-- | Read 'Word8' index off alphabet addr+--+aix :: Word8 -> Addr# -> Word8+aix (W8# i) alpha = W8# (indexWord8OffAddr# alpha (word2Int# i))+{-# INLINE aix #-}++-- | Convert 'Word8''s into 'Word32''s+--+w32 :: Word8 -> Word32+w32 = fromIntegral+{-# INLINE w32 #-}++-- | Allocate and fill @n@ bytes with some data+--+writeNPlainForeignPtrBytes+ :: ( Storable a+ , Storable b+ )+ => Int+ -> [a]+ -> ForeignPtr b+writeNPlainForeignPtrBytes !n as = unsafeDupablePerformIO $ do+ fp <- mallocPlainForeignPtrBytes n+ withForeignPtr fp $ \p -> go p as+ return (castForeignPtr fp)+ where+ go !_ [] = return ()+ go !p (x:xs) = poke p x >> go (plusPtr p 1) xs
+ src/Data/ByteString/Base64/Internal/W32/Loop.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module : Data.ByteString.Base64.Internal.W32.Loop+-- Copyright : (c) 2019-2020 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- 'Word32'-optimized inner loop+--+module Data.ByteString.Base64.Internal.W32.Loop+( innerLoop+, innerLoopNopad+) where+++import Data.Bits+import Data.ByteString.Internal++import Foreign.Ptr+import Foreign.Storable++import GHC.Word+++-- | 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 finish = go (castPtr sptr) dptr+ where+ go !src !dst+ | plusPtr src 2 >= end = finish (castPtr src) (castPtr dst)+ | otherwise = do+#ifdef WORDS_BIGENDIAN+ !w <- peek @Word32 src+#else+ !w <- byteSwap32 <$> peek @Word32 src+#endif+ let !a = (unsafeShiftR w 20) .&. 0xfff+ !b = (unsafeShiftR w 8) .&. 0xfff++ !x <- peekElemOff etable (fromIntegral a)+ !y <- peekElemOff etable (fromIntegral b)++ 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 finish = go (castPtr sptr) dptr 0+ where+ go !src !dst !n+ | plusPtr src 2 >= end = finish (castPtr src) (castPtr dst) n+ | otherwise = do+#ifdef WORDS_BIGENDIAN+ w <- peek @Word32 src+#else+ w <- byteSwap32 <$> peek @Word32 src+#endif+ let !a = (unsafeShiftR w 20) .&. 0xfff+ !b = (unsafeShiftR w 8) .&. 0xfff++ !x <- peekElemOff etable (fromIntegral a)+ !y <- peekElemOff etable (fromIntegral b)++ poke dst x+ poke (plusPtr dst 2) y++ go (plusPtr src 3) (plusPtr dst 4) (n + 4)+{-# INLINE innerLoopNopad #-}
+ src/Data/ByteString/Base64/Internal/W64/Loop.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module : Data.ByteString.Base64.Internal.W64.Loop+-- Copyright : (c) 2019-2020 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- 'Word64'-optimized inner loops+--+module Data.ByteString.Base64.Internal.W64.Loop+( innerLoop+, innerLoopNopad+) where+++import Data.Bits+import Data.ByteString.Internal++import Foreign.Ptr+import Foreign.Storable++import GHC.Word+++-- | Encoding inner loop. Packs 6 bytes from src pointer into+-- the first 6 bits of 4 'Word12''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 finish = go (castPtr sptr) dptr+ where+ tailRound !src !dst+ | plusPtr src 2 >= end = finish src (castPtr dst)+ | otherwise = do+#ifdef WORDS_BIGENDIAN+ !w <- peek @Word32 (castPtr src)+#else+ !w <- byteSwap32 <$> peek @Word32 (castPtr src)+#endif+ let !a = (unsafeShiftR w 20) .&. 0xfff+ !b = (unsafeShiftR w 8) .&. 0xfff++ !x <- peekElemOff etable (fromIntegral a)+ !y <- peekElemOff etable (fromIntegral b)++ poke dst x+ poke (plusPtr dst 2) y++ finish (plusPtr src 3) (castPtr (plusPtr dst 4))++ go !src !dst+ | plusPtr src 5 >= end = tailRound (castPtr src) dst+ | otherwise = do+#ifdef WORDS_BIGENDIAN+ !t <- peek @Word64 src+#else+ !t <- byteSwap64 <$> peek @Word64 src+#endif+ let !a = (unsafeShiftR t 52) .&. 0xfff+ !b = (unsafeShiftR t 40) .&. 0xfff+ !c = (unsafeShiftR t 28) .&. 0xfff+ !d = (unsafeShiftR t 16) .&. 0xfff++ w <- peekElemOff etable (fromIntegral a)+ x <- peekElemOff etable (fromIntegral b)+ y <- peekElemOff etable (fromIntegral c)+ z <- peekElemOff etable (fromIntegral d)++ poke dst w+ poke (plusPtr dst 2) x+ poke (plusPtr dst 4) y+ poke (plusPtr dst 6) z++ go (plusPtr src 6) (plusPtr dst 8)+{-# 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 finish = go (castPtr sptr) dptr 0+ where+ tailRound !src !dst !n+ | plusPtr src 2 >= end = finish src (castPtr dst) n+ | otherwise = do+#ifdef WORDS_BIGENDIAN+ !w <- peek @Word32 (castPtr src)+#else+ !w <- byteSwap32 <$> peek @Word32 (castPtr src)+#endif+ let !a = (unsafeShiftR w 20) .&. 0xfff+ !b = (unsafeShiftR w 8) .&. 0xfff++ !x <- peekElemOff etable (fromIntegral a)+ !y <- peekElemOff etable (fromIntegral b)++ poke dst x+ poke (plusPtr dst 2) y++ finish (plusPtr src 3) (castPtr (plusPtr dst 4)) (n + 4)++ go !src !dst !n+ | plusPtr src 5 >= end = tailRound (castPtr src) dst n+ | otherwise = do+#ifdef WORDS_BIGENDIAN+ !t <- peek @Word64 src+#else+ !t <- byteSwap64 <$> peek @Word64 src+#endif+ let !a = (unsafeShiftR t 52) .&. 0xfff+ !b = (unsafeShiftR t 40) .&. 0xfff+ !c = (unsafeShiftR t 28) .&. 0xfff+ !d = (unsafeShiftR t 16) .&. 0xfff++ w <- peekElemOff etable (fromIntegral a)+ x <- peekElemOff etable (fromIntegral b)+ y <- peekElemOff etable (fromIntegral c)+ z <- peekElemOff etable (fromIntegral d)++ poke dst w+ poke (plusPtr dst 2) x+ poke (plusPtr dst 4) y+ poke (plusPtr dst 6) z++ go (plusPtr src 6) (plusPtr dst 8) (n + 8)+{-# INLINE innerLoopNopad #-}
+ src/Data/ByteString/Base64/Internal/W8/Loop.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module : Data.ByteString.Base64.Internal.W32.Loop+-- Copyright : (c) 2019-2020 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- 'Word8' fallback loop+--+module Data.ByteString.Base64.Internal.W8.Loop+( innerLoop+, innerLoopNopad+) where+++import Data.Bits+import Data.ByteString.Internal+import Data.ByteString.Base64.Internal.Utils++import Foreign.Ptr+import Foreign.Storable++import GHC.Word+++-- | 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 finish = go sptr dptr+ where+ go !src !dst+ | plusPtr src 2 >= end = finish 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)++-- | 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 finish = go sptr dptr 0+ where+ go !src !dst !n+ | plusPtr src 2 >= end = finish 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)
src/Data/ByteString/Base64/URL.hs view
@@ -2,12 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Data.ByteString.Base64.URL--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2019 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable -- -- This module contains the combinators implementing the -- RFC 4648 specification for the Base64-URL encoding including