diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/base64-bytes.cabal b/base64-bytes.cabal --- a/base64-bytes.cabal +++ b/base64-bytes.cabal @@ -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 diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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 #-} diff --git a/src/Data/Bytes/Base64.hs b/src/Data/Bytes/Base64.hs --- a/src/Data/Bytes/Base64.hs +++ b/src/Data/Bytes/Base64.hs @@ -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"# diff --git a/src/Data/Bytes/Base64/Url.hs b/src/Data/Bytes/Base64/Url.hs --- a/src/Data/Bytes/Base64/Url.hs +++ b/src/Data/Bytes/Base64/Url.hs @@ -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"# diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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