ppad-base64 0.1.0 → 0.1.1
raw patch · 6 files changed
+420/−244 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +8/−0
- bench/Main.hs +6/−2
- lib/Data/ByteString/Base64.hs +4/−211
- lib/Data/ByteString/Base64/Pure.hs +228/−0
- ppad-base64.cabal +3/−2
- test/Main.hs +171/−29
CHANGELOG view
@@ -1,4 +1,12 @@ # Changelog +- 0.1.1 (2026-10-10)+ * The portable implementation now lives in an internal+ 'Data.ByteString.Base64.Pure' module, and+ 'Data.ByteString.Base64.Arm' is no longer exposed. Both are hidden+ internal modules; the public API is unchanged.+ * Expands the test suite to exercise both the NEON and portable+ implementations, including on invalid and non-canonical inputs.+ - 0.1.0 (2026-05-16) * Initial release, supporting basic encoding/decoding.
bench/Main.hs view
@@ -15,6 +15,10 @@ main = defaultMain [ minimal_encode , minimal_decode+ , encode+ , decode+ , encode_various+ , decode_various ] minimal_encode :: Benchmark@@ -47,7 +51,7 @@ ] decode_various :: Benchmark-decode_various = bgroup "base64" [+decode_various = bgroup "decode (input size)" [ bench "1024B input" $ nf B64.decode (B64.encode (BS.replicate 768 0x00)) , bench "1028B input" $ nf B64.decode (B64.encode (BS.replicate 771 0x00)) , bench "1032B input" $ nf B64.decode (B64.encode (BS.replicate 774 0x00))@@ -59,7 +63,7 @@ ] encode_various :: Benchmark-encode_various = bgroup "base64" [+encode_various = bgroup "encode (input size)" [ bench "1024B input" $ nf B64.encode (BS.replicate 1024 0x00) , bench "1023B input" $ nf B64.encode (BS.replicate 1023 0x00) , bench "1022B input" $ nf B64.encode (BS.replicate 1022 0x00)
lib/Data/ByteString/Base64.hs view
@@ -1,6 +1,4 @@ {-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.ByteString.Base64@@ -8,71 +6,16 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Pure base64 encoding and decoding of strict bytestrings.+-- Base64 encoding and decoding of strict bytestrings. module Data.ByteString.Base64 ( encode , decode ) where -import qualified Data.Bits as B-import Data.Bits ((.&.), (.|.)) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.Arm as Arm-import qualified Data.ByteString.Internal as BI-import Data.Word (Word8)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (peekElemOff, pokeElemOff)-import System.IO.Unsafe (unsafeDupablePerformIO)--fi :: (Num a, Integral b) => b -> a-fi = fromIntegral-{-# INLINE fi #-}---- 64-byte table. Indexed by 6-bit value (0..63), yields the--- corresponding base64 alphabet character. All-ASCII content means--- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress'--- and the bytes live in static rodata.-enc_tab :: BS.ByteString-enc_tab =- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"-{-# NOINLINE enc_tab #-}---- 256-byte table. Index by an ASCII byte to obtain its 6-bit value;--- valid base64 chars ('A'..'Z', 'a'..'z', '0'..'9', '+', '/') map to--- 0x40..0x7f, every other byte (including '=') maps to 0x80.------ The encoding is chosen so the literal is strictly ASCII and contains--- no embedded NUL, which is what the bytestring 'IsString' rule needs--- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes--- end up in static rodata, with no CAF allocation.------ The 0x80 sentinel is distinguished by bit 7; no value 0x40..0x7f--- carries that bit, so 'decode' OR-folds every lookup into an--- accumulator and tests 'acc .&. 0x80 == 0' once at the end. The--- low 6 bits of each entry are the 6-bit value, possibly contaminated--- by the 0x40 flag bit; the b0/b1/b2 formulas mask each subexpression--- before combining so the flag never bleeds into the output bytes.-dec_tab :: BS.ByteString-dec_tab =- "\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x7E\x80\x80\x80\x7F\- \\x74\x75\x76\x77\x78\x79\x7A\x7B\x7C\x7D\x80\x80\x80\x80\x80\x80\- \\x80\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4A\x4B\x4C\x4D\x4E\- \\x4F\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x80\x80\x80\x80\x80\- \\x80\x5A\x5B\x5C\x5D\x5E\x5F\x60\x61\x62\x63\x64\x65\x66\x67\x68\- \\x69\x6A\x6B\x6C\x6D\x6E\x6F\x70\x71\x72\x73\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\- \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80"-{-# NOINLINE dec_tab #-}+import qualified Data.ByteString.Base64.Pure as Pure -- | Encode a base256 'ByteString' as base64. --@@ -84,7 +27,7 @@ encode :: BS.ByteString -> BS.ByteString encode bs | Arm.base64_arm_available = Arm.encode bs- | otherwise = encode_scalar bs+ | otherwise = Pure.encode bs {-# INLINABLE encode #-} -- | Decode a base64 'ByteString' to base256.@@ -100,155 +43,5 @@ decode :: BS.ByteString -> Maybe BS.ByteString decode bs | Arm.base64_arm_available = Arm.decode bs- | otherwise = decode_scalar bs+ | otherwise = Pure.decode bs {-# INLINABLE decode #-}--encode_scalar :: BS.ByteString -> BS.ByteString-encode_scalar (BI.PS sfp soff l) =- case enc_tab of- BI.PS tfp toff _ ->- BI.unsafeCreate ((l + 2) `quot` 3 * 4) $ \dst ->- withForeignPtr sfp $ \sp0 ->- withForeignPtr tfp $ \tp0 -> do- let !sp = sp0 `plusPtr` soff :: Ptr Word8- !tp = tp0 `plusPtr` toff :: Ptr Word8- !nfull = l `quot` 3- !rmn = l - nfull * 3- loop !i- | i == nfull = pure ()- | otherwise = do- let !ii = i * 3- !oo = i * 4- b0 <- peekElemOff sp ii- b1 <- peekElemOff sp (ii + 1)- b2 <- peekElemOff sp (ii + 2)- c0 <- peekElemOff tp (fi (b0 `B.shiftR` 2))- c1 <- peekElemOff tp (fi- (((b0 .&. 0x03) `B.shiftL` 4)- .|. (b1 `B.shiftR` 4)))- c2 <- peekElemOff tp (fi- (((b1 .&. 0x0F) `B.shiftL` 2)- .|. (b2 `B.shiftR` 6)))- c3 <- peekElemOff tp (fi (b2 .&. 0x3F))- pokeElemOff dst oo (c0 :: Word8)- pokeElemOff dst (oo + 1) c1- pokeElemOff dst (oo + 2) c2- pokeElemOff dst (oo + 3) c3- loop (i + 1)- loop 0- case rmn of- 0 -> pure ()- 1 -> do- let !ii = nfull * 3- !oo = nfull * 4- b0 <- peekElemOff sp ii- c0 <- peekElemOff tp (fi (b0 `B.shiftR` 2))- c1 <- peekElemOff tp (fi ((b0 .&. 0x03) `B.shiftL` 4))- pokeElemOff dst oo (c0 :: Word8)- pokeElemOff dst (oo + 1) c1- pokeElemOff dst (oo + 2) 0x3D- pokeElemOff dst (oo + 3) 0x3D- _ -> do- let !ii = nfull * 3- !oo = nfull * 4- b0 <- peekElemOff sp ii- b1 <- peekElemOff sp (ii + 1)- c0 <- peekElemOff tp (fi (b0 `B.shiftR` 2))- c1 <- peekElemOff tp (fi- (((b0 .&. 0x03) `B.shiftL` 4)- .|. (b1 `B.shiftR` 4)))- c2 <- peekElemOff tp (fi ((b1 .&. 0x0F) `B.shiftL` 2))- pokeElemOff dst oo (c0 :: Word8)- pokeElemOff dst (oo + 1) c1- pokeElemOff dst (oo + 2) c2- pokeElemOff dst (oo + 3) 0x3D--decode_scalar :: BS.ByteString -> Maybe BS.ByteString-decode_scalar (BI.PS sfp soff l)- | l == 0 = Just BS.empty- | l .&. 0x03 /= 0 = Nothing- | otherwise = case dec_tab of- BI.PS tfp toff _ -> unsafeDupablePerformIO $- withForeignPtr sfp $ \sp0 ->- withForeignPtr tfp $ \tp0 -> do- let !sp = sp0 `plusPtr` soff :: Ptr Word8- !tp = tp0 `plusPtr` toff :: Ptr Word8- c_pre <- peekElemOff sp (l - 2)- c_end <- peekElemOff sp (l - 1)- let !pad_pre = c_pre == 0x3D- !pad_end = c_end == 0x3D- if pad_pre && not pad_end- then pure Nothing- else do- let !pad = (if pad_pre then 2 else if pad_end then 1 else 0)- :: Int- !nfull = l `B.shiftR` 2- !nbody = if pad > 0 then nfull - 1 else nfull- !outlen = nfull * 3 - pad- fp <- BI.mallocByteString outlen- ok <- withForeignPtr fp $ \dst -> do- let body_loop !acc !i- | i == nbody = pure acc- | otherwise = do- let !ii = i `B.shiftL` 2- !oo = i * 3- c0 <- peekElemOff sp ii- c1 <- peekElemOff sp (ii + 1)- c2 <- peekElemOff sp (ii + 2)- c3 <- peekElemOff sp (ii + 3)- v0 <- peekElemOff tp (fi c0)- v1 <- peekElemOff tp (fi c1)- v2 <- peekElemOff tp (fi c2)- v3 <- peekElemOff tp (fi c3)- let !b0 = (v0 `B.shiftL` 2)- .|. ((v1 `B.shiftR` 4) .&. 0x03)- !b1 = ((v1 .&. 0x0F) `B.shiftL` 4)- .|. ((v2 `B.shiftR` 2) .&. 0x0F)- !b2 = ((v2 .&. 0x03) `B.shiftL` 6)- .|. (v3 .&. 0x3F)- pokeElemOff dst oo b0- pokeElemOff dst (oo + 1) b1- pokeElemOff dst (oo + 2) b2- body_loop- (acc .|. v0 .|. v1 .|. v2 .|. v3) (i + 1)- acc <- body_loop 0 0- if acc .&. 0x80 /= 0- then pure False- else case pad of- 0 -> pure True- 1 -> do- let !ii = nbody `B.shiftL` 2- !oo = nbody * 3- c0 <- peekElemOff sp ii- c1 <- peekElemOff sp (ii + 1)- c2 <- peekElemOff sp (ii + 2)- v0 <- peekElemOff tp (fi c0)- v1 <- peekElemOff tp (fi c1)- v2 <- peekElemOff tp (fi c2)- let !tail_acc = v0 .|. v1 .|. v2- if tail_acc .&. 0x80 /= 0 || v2 .&. 0x03 /= 0- then pure False- else do- let !b0 = (v0 `B.shiftL` 2)- .|. ((v1 `B.shiftR` 4) .&. 0x03)- !b1 = ((v1 .&. 0x0F) `B.shiftL` 4)- .|. ((v2 `B.shiftR` 2) .&. 0x0F)- pokeElemOff dst oo b0- pokeElemOff dst (oo + 1) b1- pure True- _ -> do- let !ii = nbody `B.shiftL` 2- !oo = nbody * 3- c0 <- peekElemOff sp ii- c1 <- peekElemOff sp (ii + 1)- v0 <- peekElemOff tp (fi c0)- v1 <- peekElemOff tp (fi c1)- let !tail_acc = v0 .|. v1- if tail_acc .&. 0x80 /= 0 || v1 .&. 0x0F /= 0- then pure False- else do- let !b0 = (v0 `B.shiftL` 2)- .|. ((v1 `B.shiftR` 4) .&. 0x03)- pokeElemOff dst oo b0- pure True- pure $! if ok then Just (BI.PS fp 0 outlen) else Nothing
+ lib/Data/ByteString/Base64/Pure.hs view
@@ -0,0 +1,228 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Data.ByteString.Base64.Pure+-- Copyright: (c) 2026 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Pure Haskell base64 encoding and decoding of strict bytestrings.++module Data.ByteString.Base64.Pure (+ encode+ , decode+ ) where++import qualified Data.Bits as B+import Data.Bits ((.&.), (.|.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BI+import Data.Word (Word8)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (peekElemOff, pokeElemOff)+import System.IO.Unsafe (unsafeDupablePerformIO)++fi :: (Num a, Integral b) => b -> a+fi = fromIntegral+{-# INLINE fi #-}++-- 64-byte table. Indexed by 6-bit value (0..63), yields the+-- corresponding base64 alphabet character. All-ASCII content means+-- the bytestring 'IsString' rule rewrites this to 'unsafePackAddress'+-- and the bytes live in static rodata.+enc_tab :: BS.ByteString+enc_tab =+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"+{-# NOINLINE enc_tab #-}++-- 256-byte table. Index by an ASCII byte to obtain its 6-bit value;+-- valid base64 chars ('A'..'Z', 'a'..'z', '0'..'9', '+', '/') map to+-- 0x40..0x7f, every other byte (including '=') maps to 0x80.+--+-- The encoding is chosen so the literal is strictly ASCII and contains+-- no embedded NUL, which is what the bytestring 'IsString' rule needs+-- to rewrite it into 'unsafePackAddress' (cf. 'enc_tab') — the bytes+-- end up in static rodata, with no CAF allocation.+--+-- The 0x80 sentinel is distinguished by bit 7; no value 0x40..0x7f+-- carries that bit, so 'decode' OR-folds every lookup into an+-- accumulator and tests 'acc .&. 0x80 == 0' once at the end. The+-- low 6 bits of each entry are the 6-bit value, possibly contaminated+-- by the 0x40 flag bit; the b0/b1/b2 formulas mask each subexpression+-- before combining so the flag never bleeds into the output bytes.+dec_tab :: BS.ByteString+dec_tab =+ "\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x7E\x80\x80\x80\x7F\+ \\x74\x75\x76\x77\x78\x79\x7A\x7B\x7C\x7D\x80\x80\x80\x80\x80\x80\+ \\x80\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4A\x4B\x4C\x4D\x4E\+ \\x4F\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x80\x80\x80\x80\x80\+ \\x80\x5A\x5B\x5C\x5D\x5E\x5F\x60\x61\x62\x63\x64\x65\x66\x67\x68\+ \\x69\x6A\x6B\x6C\x6D\x6E\x6F\x70\x71\x72\x73\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\+ \\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80"+{-# NOINLINE dec_tab #-}++-- | Encode a base256 'ByteString' as base64.+encode :: BS.ByteString -> BS.ByteString+encode (BI.PS sfp soff l) =+ case enc_tab of+ BI.PS tfp toff _ ->+ BI.unsafeCreate ((l + 2) `quot` 3 * 4) $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ withForeignPtr tfp $ \tp0 -> do+ let !sp = sp0 `plusPtr` soff :: Ptr Word8+ !tp = tp0 `plusPtr` toff :: Ptr Word8+ !nfull = l `quot` 3+ !rmn = l - nfull * 3+ loop !i+ | i == nfull = pure ()+ | otherwise = do+ let !ii = i * 3+ !oo = i * 4+ b0 <- peekElemOff sp ii+ b1 <- peekElemOff sp (ii + 1)+ b2 <- peekElemOff sp (ii + 2)+ c0 <- peekElemOff tp (fi (b0 `B.shiftR` 2))+ c1 <- peekElemOff tp (fi+ (((b0 .&. 0x03) `B.shiftL` 4)+ .|. (b1 `B.shiftR` 4)))+ c2 <- peekElemOff tp (fi+ (((b1 .&. 0x0F) `B.shiftL` 2)+ .|. (b2 `B.shiftR` 6)))+ c3 <- peekElemOff tp (fi (b2 .&. 0x3F))+ pokeElemOff dst oo (c0 :: Word8)+ pokeElemOff dst (oo + 1) c1+ pokeElemOff dst (oo + 2) c2+ pokeElemOff dst (oo + 3) c3+ loop (i + 1)+ loop 0+ case rmn of+ 0 -> pure ()+ 1 -> do+ let !ii = nfull * 3+ !oo = nfull * 4+ b0 <- peekElemOff sp ii+ c0 <- peekElemOff tp (fi (b0 `B.shiftR` 2))+ c1 <- peekElemOff tp (fi ((b0 .&. 0x03) `B.shiftL` 4))+ pokeElemOff dst oo (c0 :: Word8)+ pokeElemOff dst (oo + 1) c1+ pokeElemOff dst (oo + 2) 0x3D+ pokeElemOff dst (oo + 3) 0x3D+ _ -> do+ let !ii = nfull * 3+ !oo = nfull * 4+ b0 <- peekElemOff sp ii+ b1 <- peekElemOff sp (ii + 1)+ c0 <- peekElemOff tp (fi (b0 `B.shiftR` 2))+ c1 <- peekElemOff tp (fi+ (((b0 .&. 0x03) `B.shiftL` 4)+ .|. (b1 `B.shiftR` 4)))+ c2 <- peekElemOff tp (fi ((b1 .&. 0x0F) `B.shiftL` 2))+ pokeElemOff dst oo (c0 :: Word8)+ pokeElemOff dst (oo + 1) c1+ pokeElemOff dst (oo + 2) c2+ pokeElemOff dst (oo + 3) 0x3D++-- | Decode a base64 'ByteString' to base256. Invalid inputs+-- (including incorrectly-padded or non-canonical inputs) will+-- produce 'Nothing'.+decode :: BS.ByteString -> Maybe BS.ByteString+decode (BI.PS sfp soff l)+ | l == 0 = Just BS.empty+ | l .&. 0x03 /= 0 = Nothing+ | otherwise = case dec_tab of+ BI.PS tfp toff _ -> unsafeDupablePerformIO $+ withForeignPtr sfp $ \sp0 ->+ withForeignPtr tfp $ \tp0 -> do+ let !sp = sp0 `plusPtr` soff :: Ptr Word8+ !tp = tp0 `plusPtr` toff :: Ptr Word8+ c_pre <- peekElemOff sp (l - 2)+ c_end <- peekElemOff sp (l - 1)+ let !pad_pre = c_pre == 0x3D+ !pad_end = c_end == 0x3D+ if pad_pre && not pad_end+ then pure Nothing+ else do+ let !pad = (if pad_pre then 2 else if pad_end then 1 else 0)+ :: Int+ !nfull = l `B.shiftR` 2+ !nbody = if pad > 0 then nfull - 1 else nfull+ !outlen = nfull * 3 - pad+ fp <- BI.mallocByteString outlen+ ok <- withForeignPtr fp $ \dst -> do+ let body_loop !acc !i+ | i == nbody = pure acc+ | otherwise = do+ let !ii = i `B.shiftL` 2+ !oo = i * 3+ c0 <- peekElemOff sp ii+ c1 <- peekElemOff sp (ii + 1)+ c2 <- peekElemOff sp (ii + 2)+ c3 <- peekElemOff sp (ii + 3)+ v0 <- peekElemOff tp (fi c0)+ v1 <- peekElemOff tp (fi c1)+ v2 <- peekElemOff tp (fi c2)+ v3 <- peekElemOff tp (fi c3)+ let !b0 = (v0 `B.shiftL` 2)+ .|. ((v1 `B.shiftR` 4) .&. 0x03)+ !b1 = ((v1 .&. 0x0F) `B.shiftL` 4)+ .|. ((v2 `B.shiftR` 2) .&. 0x0F)+ !b2 = ((v2 .&. 0x03) `B.shiftL` 6)+ .|. (v3 .&. 0x3F)+ pokeElemOff dst oo b0+ pokeElemOff dst (oo + 1) b1+ pokeElemOff dst (oo + 2) b2+ body_loop+ (acc .|. v0 .|. v1 .|. v2 .|. v3) (i + 1)+ acc <- body_loop 0 0+ if acc .&. 0x80 /= 0+ then pure False+ else case pad of+ 0 -> pure True+ 1 -> do+ let !ii = nbody `B.shiftL` 2+ !oo = nbody * 3+ c0 <- peekElemOff sp ii+ c1 <- peekElemOff sp (ii + 1)+ c2 <- peekElemOff sp (ii + 2)+ v0 <- peekElemOff tp (fi c0)+ v1 <- peekElemOff tp (fi c1)+ v2 <- peekElemOff tp (fi c2)+ let !tail_acc = v0 .|. v1 .|. v2+ if tail_acc .&. 0x80 /= 0 || v2 .&. 0x03 /= 0+ then pure False+ else do+ let !b0 = (v0 `B.shiftL` 2)+ .|. ((v1 `B.shiftR` 4) .&. 0x03)+ !b1 = ((v1 .&. 0x0F) `B.shiftL` 4)+ .|. ((v2 `B.shiftR` 2) .&. 0x0F)+ pokeElemOff dst oo b0+ pokeElemOff dst (oo + 1) b1+ pure True+ _ -> do+ let !ii = nbody `B.shiftL` 2+ !oo = nbody * 3+ c0 <- peekElemOff sp ii+ c1 <- peekElemOff sp (ii + 1)+ v0 <- peekElemOff tp (fi c0)+ v1 <- peekElemOff tp (fi c1)+ let !tail_acc = v0 .|. v1+ if tail_acc .&. 0x80 /= 0 || v1 .&. 0x0F /= 0+ then pure False+ else do+ let !b0 = (v0 `B.shiftL` 2)+ .|. ((v1 `B.shiftR` 4) .&. 0x03)+ pokeElemOff dst oo b0+ pure True+ pure $! if ok then Just (BI.PS fp 0 outlen) else Nothing
ppad-base64.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-base64-version: 0.1.0+version: 0.1.1 synopsis: Fast base64 encoding and decoding on bytestrings. license: MIT license-file: LICENSE@@ -36,6 +36,8 @@ ghc-options: -fllvm -O2 exposed-modules: Data.ByteString.Base64+ Data.ByteString.Base64.Pure+ other-modules: Data.ByteString.Base64.Arm build-depends: base >= 4.9 && < 5@@ -99,6 +101,5 @@ , base64 , base64-bytestring , bytestring- , criterion , ppad-base64 , weigh
test/Main.hs view
@@ -4,51 +4,107 @@ module Main where +import Control.Monad (forM_, when) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8 import qualified "ppad-base64" Data.ByteString.Base64 as B64+import qualified "ppad-base64" Data.ByteString.Base64.Pure as Pure import qualified "base64-bytestring" Data.ByteString.Base64 as R0+import Data.Word (Word8) import Test.Tasty import qualified Test.Tasty.QuickCheck as Q import qualified Test.Tasty.HUnit as H -newtype BS = BS BS.ByteString- deriving (Eq, Show)+-- generators ----------------------------------------------------------------- +-- random bytes, as a slice at a random offset into a larger buffer, so+-- that inputs with a non-zero 'ByteString' offset are exercised bytes :: Int -> Q.Gen BS.ByteString bytes k = do l <- Q.chooseInt (0, k)- v <- Q.vectorOf l Q.arbitrary- pure (BS.pack v)+ o <- Q.chooseInt (0, 32)+ v <- Q.vectorOf (o + l) Q.arbitrary+ pure (BS.drop o (BS.pack v)) +newtype BS = BS BS.ByteString+ deriving (Eq, Show)+ instance Q.Arbitrary BS where arbitrary = do b <- bytes 1024 pure (BS b) -decode_inverts_encode :: BS -> Bool-decode_inverts_encode (BS bs) = case B64.decode (B64.encode bs) of- Nothing -> False- Just b -> b == bs+alphabet :: BS.ByteString+alphabet =+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" +-- valid encodings subjected to a few random mutations: substitution+-- (by an alphabet char, '=', or an arbitrary byte), deletion, or+-- insertion, with positions biased toward the final quartet+newtype Base64ish = Base64ish BS.ByteString+ deriving (Eq, Show)++instance Q.Arbitrary Base64ish where+ arbitrary = do+ b <- Q.frequency [(3, bytes 64), (1, bytes 384)]+ k <- Q.chooseInt (0, 3)+ s <- go k (B64.encode b)+ o <- Q.chooseInt (0, 32)+ p <- Q.vectorOf o (Q.elements (BS.unpack alphabet))+ pure (Base64ish (BS.drop o (BS.pack p <> s)))+ where+ go :: Int -> BS.ByteString -> Q.Gen BS.ByteString+ go 0 s = pure s+ go j s = mutate s >>= go (j - 1)++ mutate s = do+ let l = BS.length s+ i <- Q.oneof [+ Q.chooseInt (0, l)+ , Q.chooseInt (max 0 (l - 4), l)+ ]+ c <- Q.frequency [+ (6, Q.elements (BS.unpack alphabet))+ , (2, pure 0x3d)+ , (1, Q.arbitrary)+ ]+ Q.elements [+ BS.take i s <> BS.singleton c <> BS.drop (i + 1) s+ , BS.take i s <> BS.drop (i + 1) s+ , BS.take i s <> BS.singleton c <> BS.drop i s+ ]++-- decoders under test --------------------------------------------------------++decoders :: [(String, BS.ByteString -> Maybe BS.ByteString)]+decoders = [("public", B64.decode), ("pure", Pure.decode)]++ref_decode :: BS.ByteString -> Maybe BS.ByteString+ref_decode bs = case R0.decode bs of+ Left _ -> Nothing+ Right d -> Just d++-- properties -----------------------------------------------------------------+ encode_matches_reference :: BS -> Bool encode_matches_reference (BS bs) =- let us = B64.encode bs- r0 = R0.encode bs- in us == r0+ let r0 = R0.encode bs+ in B64.encode bs == r0 && Pure.encode bs == r0 -decode_matches_reference :: BS -> Bool-decode_matches_reference (BS bs) =- let enc = R0.encode bs- us = B64.decode enc- r0 = R0.decode enc- in case us of- Nothing -> case r0 of- Left _ -> True- _ -> False- Just du -> case r0 of- Left _ -> False- Right d0 -> du == d0+decode_inverts_encode :: BS -> Bool+decode_inverts_encode (BS bs) =+ let enc = B64.encode bs+ in all (\(_, dec) -> dec enc == Just bs) decoders +-- base64-bytestring's 'decode' is likewise strict (RFC 4648): it+-- rejects missing or misplaced padding and non-canonical final quartets+decode_matches_reference :: Base64ish -> Bool+decode_matches_reference (Base64ish bs) =+ let r0 = ref_decode bs+ in B64.decode bs == r0 && Pure.decode bs == r0++-- unit tests -----------------------------------------------------------------+ case_rfc_vectors :: TestTree case_rfc_vectors = H.testCase "RFC 4648 \167 10 vectors" $ do let vectors = [@@ -63,22 +119,108 @@ check (input, expected) = do H.assertEqual ("encode " <> show input) expected (B64.encode input)- H.assertEqual ("decode " <> show expected)- (Just input) (B64.decode expected)+ H.assertEqual ("pure encode " <> show input)+ expected (Pure.encode input)+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> " decode " <> show expected)+ (Just input) (dec expected) mapM_ check vectors +-- malformed final quartets, alone and after a body long enough to+-- take the NEON path+malformed :: TestTree+malformed = H.testCase "malformed padding and non-canonical tails" $ do+ let bad = [+ "Zh==" -- non-canonical: nonzero trailing bits+ , "Zm9=" -- non-canonical: nonzero trailing bits+ , "Zm=v" -- '=' before a data char+ , "===="+ , "Z==="+ , "=Zg="+ , "Zg=a"+ , "Zg=", "Zg", "Z"+ , "Zm9vY"+ , "Zm=vYmFy" -- '=' in the body+ , "Zg==Zg==" -- padding mid-stream+ , "Zm9v\n"+ ]+ good = [("Zg==", "f"), ("Zm8=", "fo"), ("Zm9v", "foo")]+ body = B64.encode (BS.replicate 72 0xa5)+ forM_ decoders $ \(nam, dec) -> do+ forM_ bad $ \s -> do+ H.assertEqual (nam <> " " <> show s) Nothing (dec s)+ H.assertEqual (nam <> " body <> " <> show s) Nothing (dec (body <> s))+ forM_ good $ \(s, d) ->+ H.assertEqual (nam <> " body <> " <> show s)+ (Just (BS.replicate 72 0xa5 <> d)) (dec (body <> s))++-- every byte value, at every position of encodings that span the NEON+-- body loop, the scalar body tail, and each kind of final quartet,+-- decodes exactly as the reference does; in the body, a byte is+-- accepted iff it is an alphabet char+every_byte_every_position :: TestTree+every_byte_every_position =+ H.testCase "every byte at every position" $+ forM_ [28, 29, 30 :: Int] $ \n -> do+ let base = B64.encode (BS.replicate n 0x00)+ l = BS.length base+ forM_ [0 .. 255 :: Int] $ \c ->+ forM_ [0 .. l - 1] $ \i -> do+ let w = fromIntegral c :: Word8+ inp = BS.take i base <> BS.singleton w <> BS.drop (i + 1) base+ pec = ref_decode inp+ msg = "n = " <> show n <> ", byte " <> show c+ <> ", position " <> show i+ when (i < l - 4) $+ H.assertEqual ("reference, " <> msg)+ (BS.elem w alphabet) (pec /= Nothing)+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", " <> msg) pec (dec inp)++-- for every length spanning several NEON iterations and each final+-- quartet shape, a single invalid byte at any position (or '=' anywhere+-- in the body) causes decoding to fail+single_corruption :: TestTree+single_corruption = H.testCase "single invalid byte anywhere" $ do+ let bad = BS.pack [0x00, 0x20, 0x7f, 0x80, 0xff] <> "-_.:@[`{"+ forM_ [1 .. 100 :: Int] $ \n -> do+ let raw = BS.pack (fmap fromIntegral [7 * j + 3 | j <- [1 .. n]])+ enc = B64.encode raw+ l = BS.length enc+ put i w = BS.take i enc <> BS.singleton w <> BS.drop (i + 1) enc+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", intact, n = " <> show n) (Just raw) (dec enc)+ forM_ [0 .. l - 1] $ \i -> do+ let ws = BS.unpack bad <> (if i < l - 4 then [0x3d] else [])+ forM_ ws $ \w -> do+ let msg = "n = " <> show n <> ", position " <> show i+ <> ", byte " <> show w+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", " <> msg) Nothing (dec (put i w))++bad_lengths :: TestTree+bad_lengths = H.testCase "lengths not a multiple of 4" $+ forM_ (filter (\l -> l `rem` 4 /= 0) [1 .. 99 :: Int]) $ \l ->+ forM_ decoders $ \(nam, dec) ->+ H.assertEqual (nam <> ", length " <> show l) Nothing+ (dec (B8.replicate l 'A'))+ main :: IO () main = defaultMain $ testGroup "ppad-base64" [ testGroup "property tests" [- Q.testProperty "decode . encode ~ id" $- Q.withMaxSuccess 5000 decode_inverts_encode- , Q.testProperty "encode matches reference" $+ Q.testProperty "encode matches reference" $ Q.withMaxSuccess 5000 encode_matches_reference+ , Q.testProperty "decode . encode ~ id" $+ Q.withMaxSuccess 5000 decode_inverts_encode , Q.testProperty "decode matches reference" $- Q.withMaxSuccess 5000 decode_matches_reference+ Q.withMaxSuccess 10000 decode_matches_reference ] , testGroup "unit tests" [ case_rfc_vectors+ , malformed+ , every_byte_every_position+ , single_corruption+ , bad_lengths ] ]