base64-bytes 0.1.1.0 → 0.1.1.1
raw patch · 7 files changed
+288/−230 lines, 7 filesdep ~natural-arithmeticdep ~word-compatsetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: natural-arithmetic, word-compat
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- Setup.hs +0/−2
- base64-bytes.cabal +47/−38
- bench/Main.hs +46/−41
- src/Data/Bytes/Base64.hs +101/−93
- src/Data/Bytes/Base64/Url.hs +34/−30
- test/Main.hs +56/−26
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for base64-bytes +## 0.1.1.1 -- 2024-02-01++* Update package metadata.+ ## 0.1.1.0 -- 2022-12-07 * Support GHC 9.2
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
base64-bytes.cabal view
@@ -1,62 +1,71 @@-cabal-version: 2.2-name: base64-bytes-version: 0.1.1.0-synopsis: Base64 encoding of byte sequences-homepage: https://github.com/andrewthad/base64-bytes-bug-reports: https://github.com/andrewthad/base64-bytes/issues-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2019 Andrew Martin-category: Data-build-type: Simple-extra-source-files: CHANGELOG.md+cabal-version: 2.2+name: base64-bytes+version: 0.1.1.1+synopsis: Base64 encoding of byte sequences+description: Base64 encoding of byte sequences.+homepage: https://github.com/byteverse/base64-bytes+bug-reports: https://github.com/byteverse/base64-bytes/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: amartin@layer3com.com+copyright: 2019 Andrew Martin+category: Data+build-type: Simple+extra-doc-files: CHANGELOG.md library exposed-modules: Data.Bytes.Base64 Data.Bytes.Base64.Url+ build-depends:- , base >=4.12 && <5- , primitive >=0.7 && <0.8- , byte-order >=0.1.1 && <0.2- , byteslice >=0.1.4 && <0.3- , run-st >=0.1 && <0.2- , bytebuild >=0.3.4 && <0.4- , natural-arithmetic >=0.1.1 && <0.2- , word-compat >=0.0.4- hs-source-dirs: src+ , base >=4.12 && <5+ , byte-order >=0.1.1 && <0.2+ , bytebuild >=0.3.4 && <0.4+ , byteslice >=0.1.4 && <0.3+ , natural-arithmetic >=0.1.1 && <0.2+ , primitive >=0.7 && <0.10+ , run-st >=0.1 && <0.2+ , word-compat >=0.0.4 && <0.1++ hs-source-dirs: src default-language: Haskell2010- ghc-options: -Wall -O2+ ghc-options: -Wall -O2 test-suite test- Default-Language: Haskell2010- hs-source-dirs: test- main-is: Main.hs- type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs+ type: exitcode-stdio-1.0 build-depends: , base , base64-bytes- , natural-arithmetic >=0.1.1 , bytebuild+ , byteslice >=0.1.4.0+ , natural-arithmetic >=0.1.1 , primitive- , byteslice >=0.1.4.0- ghc-options: -O2 -Wall + ghc-options: -O2 -Wall+ benchmark bench- type: exitcode-stdio-1.0+ type: exitcode-stdio-1.0 build-depends: , base+ , base64 >=0.3 , base64-bytes+ , base64-bytestring , byteslice , bytestring , gauge , primitive- , base64-bytestring- , base64 >=0.3- , random >=1.1- ghc-options: -Wall -O2+ , random >=1.1++ ghc-options: -Wall -O2 default-language: Haskell2010- hs-source-dirs: bench- main-is: Main.hs+ hs-source-dirs: bench+ main-is: Main.hs++source-repository head+ type: git+ location: git://github.com/byteverse/base64-bytes.git
bench/Main.hs view
@@ -1,15 +1,12 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE PackageImports #-} import Control.Monad.ST (runST)-import System.Random (mkStdGen,randoms)-import Data.Primitive (ByteArray(ByteArray),unsafeFreezeByteArray)-import Data.Primitive (copyByteArray,newPinnedByteArray)-import Gauge.Main (defaultMain,bgroup,bench,whnf)-import Data.ByteString.Internal (ByteString(PS))+import Data.ByteString.Internal (ByteString (PS))+import Data.Primitive (ByteArray (ByteArray), copyByteArray, newPinnedByteArray, unsafeFreezeByteArray)+import Gauge.Main (bench, bgroup, defaultMain, whnf)+import System.Random (mkStdGen, randoms) import qualified Data.Bytes as Bytes import qualified Data.Bytes.Base64 as Base64@@ -17,46 +14,54 @@ import qualified GHC.Exts as Exts import qualified GHC.ForeignPtr as Exts -import qualified "base64-bytestring" Data.ByteString.Base64 as BS import qualified "base64" Data.ByteString.Base64 as B64+import qualified "base64-bytestring" Data.ByteString.Base64 as BS main :: IO ()-main = defaultMain- [ bgroup "encode"- [ bgroup "base64-bytes"- [ bench "100" $- whnf (\x -> Base64.encode (Bytes.fromByteArray x)) str100- , bench "1000" $- whnf (\x -> Base64.encode (Bytes.fromByteArray x)) str1000- , bench "10000" $- whnf (\x -> Base64.encode (Bytes.fromByteArray x)) str10000- ]- , bgroup "base64-bytestring"- [ bench "100" $- whnf (\x -> BS.encode (byteArrayToByteString 100 x)) str100- , bench "1000" $- whnf (\x -> BS.encode (byteArrayToByteString 1000 x)) str1000- , bench "10000" $- whnf (\x -> BS.encode (byteArrayToByteString 10000 x)) str10000- ]- , bgroup "base64"- [ bench "100" $- whnf (\x -> B64.encodeBase64' (byteArrayToByteString 100 x)) str100- , bench "1000" $- whnf (\x -> B64.encodeBase64' (byteArrayToByteString 1000 x)) str1000- , bench "10000" $- whnf (\x -> B64.encodeBase64' (byteArrayToByteString 10000 x)) str10000- ]+main =+ defaultMain+ [ bgroup+ "encode"+ [ bgroup+ "base64-bytes"+ [ bench "100" $+ whnf (\x -> Base64.encode (Bytes.fromByteArray x)) str100+ , bench "1000" $+ whnf (\x -> Base64.encode (Bytes.fromByteArray x)) str1000+ , bench "10000" $+ whnf (\x -> Base64.encode (Bytes.fromByteArray x)) str10000+ ]+ , bgroup+ "base64-bytestring"+ [ bench "100" $+ whnf (\x -> BS.encode (byteArrayToByteString 100 x)) str100+ , bench "1000" $+ whnf (\x -> BS.encode (byteArrayToByteString 1000 x)) str1000+ , bench "10000" $+ whnf (\x -> BS.encode (byteArrayToByteString 10000 x)) str10000+ ]+ , bgroup+ "base64"+ [ bench "100" $+ whnf (\x -> B64.encodeBase64' (byteArrayToByteString 100 x)) str100+ , bench "1000" $+ whnf (\x -> B64.encodeBase64' (byteArrayToByteString 1000 x)) str1000+ , bench "10000" $+ whnf (\x -> B64.encodeBase64' (byteArrayToByteString 10000 x)) str10000+ ]+ ] ]- ] byteArrayToByteString :: Int -> ByteArray -> ByteString-{-# inline byteArrayToByteString #-}-byteArrayToByteString len (ByteArray x) = PS- ( Exts.ForeignPtr- (Exts.byteArrayContents# x)- (Exts.PlainPtr (Exts.unsafeCoerce# x))- ) 0 len+{-# INLINE byteArrayToByteString #-}+byteArrayToByteString len (ByteArray x) =+ PS+ ( Exts.ForeignPtr+ (Exts.byteArrayContents# x)+ (Exts.PlainPtr (Exts.unsafeCoerce# x))+ )+ 0+ len str100 :: ByteArray {-# NOINLINE str100 #-}
src/Data/Bytes/Base64.hs view
@@ -1,15 +1,14 @@-{-# language BangPatterns #-}-{-# language BinaryLiterals #-}-{-# language BlockArguments #-}-{-# language DataKinds #-}-{-# language ExplicitNamespaces #-}-{-# language MagicHash #-}-{-# language NoStarIsType #-}-{-# language PatternSynonyms #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}-{-# language TypeOperators #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE NoStarIsType #-} module Data.Bytes.Base64 ( encode@@ -18,25 +17,24 @@ , decode64 ) where -import GHC.TypeNats (type (+),type (*),Div) import Control.Monad.ST.Run (runByteArrayST)+import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.))+import Data.Bytes.Types (Bytes (Bytes)) import Data.Char (ord)-import Data.Bits (unsafeShiftR,unsafeShiftL,(.|.),(.&.))-import Data.Bytes.Types (Bytes(Bytes))-import Data.Primitive (ByteArray(..),MutableByteArray(..))-import Data.Primitive (newByteArray,unsafeFreezeByteArray,readByteArray)+import Data.Primitive (ByteArray (..), MutableByteArray (..), newByteArray, readByteArray, unsafeFreezeByteArray) import Data.Primitive.Ptr (indexOffPtr)-import Data.Word (Word8,Word64)-import GHC.Exts (Ptr(Ptr),Int(I#),State#,(+#),(-#))-import GHC.ST (ST(ST))-import GHC.Word (Word(W#),Word32)+import Data.Word (Word64, Word8)+import GHC.Exts (Int (I#), Ptr (Ptr), State#, (+#), (-#))+import GHC.ST (ST (ST))+import GHC.TypeNats (Div, type (*), type (+))+import GHC.Word (Word (W#), Word32) import GHC.Word.Compat (pattern W32#) import qualified Arithmetic.Nat as Nat import qualified Arithmetic.Types as Arithmetic import qualified Data.Bytes as Bytes-import qualified Data.Bytes.Builder.Unsafe as BU import qualified Data.Bytes.Builder.Bounded.Unsafe as BBU+import qualified Data.Bytes.Builder.Unsafe as BU import qualified Data.Primitive.ByteArray.BigEndian as BE import qualified Data.Primitive.ByteArray.LittleEndian as LE import qualified Data.Primitive.Ptr as PM@@ -55,38 +53,41 @@ builder (Bytes src soff slen) = BU.fromEffect dlen \dst doff -> do performEncodeImmutable dst doff src soff slen pure (doff + dlen)- where+ where dlen = calculatePaddedLength slen --- | Encode a byte sequence with base64. This augments a builder--- by first playing the original builder to paste the byte sequence--- and then performing the base64 encoding in-place on the buffer--- that had been pasted into.+{- | Encode a byte sequence with base64. This augments a builder+by first playing the original builder to paste the byte sequence+and then performing the base64 encoding in-place on the buffer+that had been pasted into.+-} recodeBoundedBuilder ::- Arithmetic.Nat n- -> BBU.Builder n- -> BBU.Builder (4 * (Div (n + 2) 3))-recodeBoundedBuilder !n (BBU.Builder f) = BBU.Builder- (\arr off0 s0 -> let !off1 = (off0 +# maxEncLen) -# maxRawLen in- case f arr off1 s0 of- (# s1, off2 #) ->- let !actualLen = off2 -# off1 in- case unST (performEncode (MutableByteArray arr) (I# off0) (MutableByteArray arr) (I# off1) (W# (Exts.int2Word# actualLen))) s1 of- (# s2, (_ :: ()) #) ->- let !(I# actualEncLen) = calculatePaddedLength (I# actualLen) in- (# s2, actualEncLen #)- )- where+ Arithmetic.Nat n ->+ BBU.Builder n ->+ BBU.Builder (4 * (Div (n + 2) 3))+recodeBoundedBuilder !n (BBU.Builder f) =+ BBU.Builder+ ( \arr off0 s0 ->+ let !off1 = (off0 +# maxEncLen) -# maxRawLen+ in case f arr off1 s0 of+ (# s1, off2 #) ->+ let !actualLen = off2 -# off1+ in case unST (performEncode (MutableByteArray arr) (I# off0) (MutableByteArray arr) (I# off1) (W# (Exts.int2Word# actualLen))) s1 of+ (# s2, (_ :: ()) #) ->+ let !(I# actualEncLen) = calculatePaddedLength (I# actualLen)+ in (# s2, actualEncLen #)+ )+ where !(I# maxRawLen) = Nat.demote n !(I# maxEncLen) = calculatePaddedLength (I# maxRawLen) performEncodeImmutable ::- MutableByteArray s -- dest- -> Int -- dest off- -> ByteArray- -> Int -- src off- -> Int -- source length- -> ST s ()+ MutableByteArray s -> -- dest+ Int -> -- dest off+ ByteArray ->+ Int -> -- src off+ Int -> -- source length+ ST s () performEncodeImmutable dst doff (ByteArray src) soff slen = performEncode dst doff (MutableByteArray (Exts.unsafeCoerce# src)) soff (fromIntegral @Int @Word slen) @@ -122,18 +123,18 @@ -- an unsigned number helps GHC realize that it does not need -- to test for n<0, although it still must test for n>3. performEncode ::- MutableByteArray s -- dest- -> Int -- dest off- -> MutableByteArray s -- src- -> Int -- src off- -> Word -- source length- -> ST s ()+ MutableByteArray s -> -- dest+ Int -> -- dest off+ MutableByteArray s -> -- src+ Int -> -- src off+ Word -> -- source length+ ST s () performEncode !dst !doff !src !soff !slen = case slen of 3 -> do x1 <- readByteArray src soff x2 <- readByteArray src (soff + 1) x3 <- readByteArray src (soff + 2)- let (w1,w2,w3,w4) = disassembleBE (assembleBE x1 x2 x3 0)+ let (w1, w2, w3, w4) = disassembleBE (assembleBE x1 x2 x3 0) c1 = indexOffPtr table (fromIntegral @Word @Int w1) c2 = indexOffPtr table (fromIntegral @Word @Int w2) c3 = indexOffPtr table (fromIntegral @Word @Int w3)@@ -142,7 +143,7 @@ 2 -> do x1 <- readByteArray src soff x2 <- readByteArray src (soff + 1)- let (w1,w2,w3,_) = disassembleBE (assembleBE x1 x2 0 0)+ let (w1, w2, w3, _) = disassembleBE (assembleBE x1 x2 0 0) c1 = indexOffPtr table (fromIntegral @Word @Int w1) c2 = indexOffPtr table (fromIntegral @Word @Int w2) c3 = indexOffPtr table (fromIntegral @Word @Int w3)@@ -150,16 +151,17 @@ LE.writeUnalignedByteArray dst doff (assembleLE c1 c2 c3 c4) 1 -> do x1 <- readByteArray src soff- let (w1,w2,_,_) = disassembleBE (assembleBE x1 0 0 0)+ let (w1, w2, _, _) = disassembleBE (assembleBE x1 0 0 0) c1 = indexOffPtr table (fromIntegral @Word @Int w1) c2 = indexOffPtr table (fromIntegral @Word @Int w2) c3 = c2w '=' c4 = c2w '=' LE.writeUnalignedByteArray dst doff (assembleLE c1 c2 c3 c4) 0 -> pure ()- _ -> do -- This last case is always slen > 3+ _ -> do+ -- This last case is always slen > 3 w :: Word32 <- BE.readUnalignedByteArray src soff- let (w1,w2,w3,w4) = disassembleBE w+ let (w1, w2, w3, w4) = disassembleBE w c1 = indexOffPtr table (fromIntegral @Word @Int w1) c2 = indexOffPtr table (fromIntegral @Word @Int w2) c3 = indexOffPtr table (fromIntegral @Word @Int w3)@@ -170,22 +172,24 @@ -- Argument bytes are hi to lo. The first argument becomes -- the least significant component of the result. assembleLE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-assembleLE a b c d = unsafeW32- (unsafeShiftL (fromIntegral @Word8 @Word d) 24 .|.- unsafeShiftL (fromIntegral @Word8 @Word c) 16 .|.- unsafeShiftL (fromIntegral @Word8 @Word b) 8 .|.- (fromIntegral @Word8 @Word a)- )+assembleLE a b c d =+ unsafeW32+ ( unsafeShiftL (fromIntegral @Word8 @Word d) 24+ .|. unsafeShiftL (fromIntegral @Word8 @Word c) 16+ .|. unsafeShiftL (fromIntegral @Word8 @Word b) 8+ .|. (fromIntegral @Word8 @Word a)+ ) -- Argument bytes are hi to lo. The first argument becomes -- the most significant component of the result. assembleBE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-assembleBE a b c d = unsafeW32- (unsafeShiftL (fromIntegral @Word8 @Word a) 24 .|.- unsafeShiftL (fromIntegral @Word8 @Word b) 16 .|.- unsafeShiftL (fromIntegral @Word8 @Word c) 8 .|.- (fromIntegral @Word8 @Word d)- )+assembleBE a b c d =+ unsafeW32+ ( unsafeShiftL (fromIntegral @Word8 @Word a) 24+ .|. unsafeShiftL (fromIntegral @Word8 @Word b) 16+ .|. unsafeShiftL (fromIntegral @Word8 @Word c) 8+ .|. (fromIntegral @Word8 @Word d)+ ) -- Create a 32-bit word from a machine word that we know -- is not too large.@@ -194,7 +198,7 @@ -- We only care about the upper 24 bits of the argument. -- This gets broken into four 6-bit words.-disassembleBE :: Word32 -> (Word,Word,Word,Word)+disassembleBE :: Word32 -> (Word, Word, Word, Word) disassembleBE !w = ( unsafeShiftR (fromIntegral @Word32 @Word w) 26 , unsafeShiftR (fromIntegral @Word32 @Word w) 20 .&. 0b00111111@@ -223,27 +227,31 @@ decode64 :: Bytes -> Maybe Word64 decode64 bs | Bytes.length bs > 10 = Nothing- | otherwise = Bytes.foldlM- (\ !(acc :: Word64) b -> case PM.indexOffPtr decodeTable (fromIntegral @Word8 @Int b) of- 0xFF -> Nothing- w -> pure $! (unsafeShiftL acc 6 .|. fromIntegral @Word8 @Word64 w)- ) 0 bs+ | otherwise =+ Bytes.foldlM+ ( \ !(acc :: Word64) b -> case PM.indexOffPtr decodeTable (fromIntegral @Word8 @Int b) of+ 0xFF -> Nothing+ w -> pure $! (unsafeShiftL acc 6 .|. fromIntegral @Word8 @Word64 w)+ )+ 0+ bs decodeTable :: Ptr Word8-decodeTable = Ptr- "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\xff\x3f\- \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\x63\xff\xff\- \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\- \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\xff\- \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\- \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#+decodeTable =+ Ptr+ "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\xff\x3f\+ \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\x63\xff\xff\+ \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\+ \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\xff\+ \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\+ \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
src/Data/Bytes/Base64/Url.hs view
@@ -1,47 +1,51 @@-{-# language BangPatterns #-}-{-# language MagicHash #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Data.Bytes.Base64.Url ( decode64 ) where +import Data.Bits (unsafeShiftL, (.|.)) import Data.Bytes (Bytes)-import GHC.Exts (Ptr(Ptr))-import Data.Word (Word8,Word64)-import Data.Bits (unsafeShiftL,(.|.))+import Data.Word (Word64, Word8)+import GHC.Exts (Ptr (Ptr)) import qualified Data.Bytes as Bytes import qualified Data.Primitive.Ptr as PM -- Decode a base64-url-encoded 64-bit word. Rejects encoded numbers -- greater than or equal to @2^64@. This maps the rightmost byte to--- the 6 least significant bits of the word. +-- the 6 least significant bits of the word. decode64 :: Bytes -> Maybe Word64 decode64 bs | Bytes.length bs > 10 = Nothing- | otherwise = Bytes.foldlM- (\ !(acc :: Word64) b -> case PM.indexOffPtr table (fromIntegral @Word8 @Int b) of- 0xFF -> Nothing- w -> pure $! (unsafeShiftL acc 6 .|. fromIntegral @Word8 @Word64 w)- ) 0 bs+ | otherwise =+ Bytes.foldlM+ ( \ !(acc :: Word64) b -> case PM.indexOffPtr table (fromIntegral @Word8 @Int b) of+ 0xFF -> Nothing+ w -> pure $! (unsafeShiftL acc 6 .|. fromIntegral @Word8 @Word64 w)+ )+ 0+ bs table :: Ptr Word8-table = Ptr- "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\- \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\x63\xff\xff\- \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\- \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\x3f\- \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\- \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\- \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#+table =+ Ptr+ "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\+ \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\x63\xff\xff\+ \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\+ \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\x3f\+ \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\+ \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
test/Main.hs view
@@ -1,5 +1,4 @@-{-# language BangPatterns #-}-{-# language LambdaCase #-}+{-# LANGUAGE BangPatterns #-} import Control.Monad (when) import Data.Char (ord)@@ -8,13 +7,13 @@ import Numeric (showHex) import qualified Arithmetic.Nat as Nat-import qualified Data.Bytes.Builder.Bounded as BB import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Base64 as Base64+import qualified Data.Bytes.Base64.Url as Base64Url+import qualified Data.Bytes.Builder.Bounded as BB import qualified Data.Bytes.Text.Latin1 as Latin1 import qualified Data.Primitive as PM import qualified GHC.Exts as Exts-import qualified Data.Bytes.Base64 as Base64-import qualified Data.Bytes.Base64.Url as Base64Url main :: IO () main = do@@ -61,13 +60,16 @@ putStr "\nAll tests succeeded!\n" printHex :: ByteArray -> IO ()-printHex !b = putStr (go 0) where- go !ix = if ix < PM.sizeofByteArray b- then let val = PM.indexByteArray b ix :: Word8 in- if val < 16- then '0' : showHex val (go (ix + 1))- else showHex val (go (ix + 1))- else "\n"+printHex !b = putStr (go 0)+ where+ go !ix =+ if ix < PM.sizeofByteArray b+ then+ let val = PM.indexByteArray b ix :: Word8+ in if val < 16+ then '0' : showHex val (go (ix + 1))+ else showHex val (go (ix + 1))+ else "\n" actualFoobar :: ByteArray actualFoobar = Base64.encode (Latin1.fromString "foobar")@@ -79,29 +81,57 @@ actualCamel = Base64.encode (Latin1.fromString "camel") actualNumbers :: ByteArray-actualNumbers = BB.run Nat.constant- ( Base64.recodeBoundedBuilder+actualNumbers =+ BB.run Nat.constant- (BB.wordDec 123 `BB.append` BB.ascii '.' `BB.append` BB.wordDec 6789)- )+ ( Base64.recodeBoundedBuilder+ Nat.constant+ (BB.wordDec 123 `BB.append` BB.ascii '.' `BB.append` BB.wordDec 6789)+ ) expectedFoobar :: ByteArray-expectedFoobar = Exts.fromList [0x5a,0x6d,0x39,0x76,0x59,0x6d,0x46,0x79]+expectedFoobar = Exts.fromList [0x5a, 0x6d, 0x39, 0x76, 0x59, 0x6d, 0x46, 0x79] expectedHelloworld :: ByteArray-expectedHelloworld = Exts.fromList- [0x61,0x47,0x56,0x73,0x62,0x47,0x39,0x33- ,0x62,0x33,0x4a,0x73,0x5a,0x41,0x3d,0x3d- ]+expectedHelloworld =+ Exts.fromList+ [ 0x61+ , 0x47+ , 0x56+ , 0x73+ , 0x62+ , 0x47+ , 0x39+ , 0x33+ , 0x62+ , 0x33+ , 0x4a+ , 0x73+ , 0x5a+ , 0x41+ , 0x3d+ , 0x3d+ ] expectedCamel :: ByteArray-expectedCamel = Exts.fromList [0x59,0x32,0x46,0x74,0x5a,0x57,0x77,0x3d]+expectedCamel = Exts.fromList [0x59, 0x32, 0x46, 0x74, 0x5a, 0x57, 0x77, 0x3d] expectedNumbers :: ByteArray-expectedNumbers = Exts.fromList- [0x4d,0x54,0x49,0x7a,0x4c,0x6a- ,0x59,0x33,0x4f,0x44,0x6b,0x3d- ]+expectedNumbers =+ Exts.fromList+ [ 0x4d+ , 0x54+ , 0x49+ , 0x7a+ , 0x4c+ , 0x6a+ , 0x59+ , 0x33+ , 0x4f+ , 0x44+ , 0x6b+ , 0x3d+ ] c2w :: Char -> Word8 c2w = fromIntegral . ord