ppad-base64 (empty) → 0.1.0
raw patch · 9 files changed
+951/−0 lines, 9 filesdep +basedep +base64dep +base64-bytestring
Dependencies added: base, base64, base64-bytestring, bytestring, criterion, ppad-base64, tasty, tasty-hunit, tasty-quickcheck, weigh
Files
- CHANGELOG +4/−0
- LICENSE +20/−0
- bench/Main.hs +66/−0
- bench/Weight.hs +26/−0
- cbits/base64_arm.c +307/−0
- lib/Data/ByteString/Base64.hs +254/−0
- lib/Data/ByteString/Base64/Arm.hs +86/−0
- ppad-base64.cabal +104/−0
- test/Main.hs +84/−0
+ CHANGELOG view
@@ -0,0 +1,4 @@+# Changelog++- 0.1.0 (2026-05-16)+ * Initial release, supporting basic encoding/decoding.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,66 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}++module Main where++import Criterion.Main+import qualified Data.ByteString as BS+import qualified "ppad-base64" Data.ByteString.Base64 as B64+import qualified "base64-bytestring" Data.ByteString.Base64 as R0+import qualified "base64" Data.ByteString.Base64 as R1++main :: IO ()+main = defaultMain [+ minimal_encode+ , minimal_decode+ ]++minimal_encode :: Benchmark+minimal_encode =+ let !a = BS.replicate 1024 0x00+ in bench "ppad-base64/encode" $+ nf B64.encode a++minimal_decode :: Benchmark+minimal_decode =+ let !a = B64.encode (BS.replicate 768 0x00)+ in bench "ppad-base64/decode" $+ nf B64.decode a++encode :: Benchmark+encode = bgroup "encode" [+ bench "ppad-base64" $ nf B64.encode (BS.replicate 1024 0x00)+ , bench "base64-bytestring" $ nf R0.encode (BS.replicate 1024 0x00)+ , bench "base64" $ nf R1.encodeBase64' (BS.replicate 1024 0x00)+ ]++decode :: Benchmark+decode = bgroup "decode" [+ bench "ppad-base64" $ nf B64.decode+ (B64.encode (BS.replicate 768 0x00))+ , bench "base64-bytestring" $ nf R0.decode+ (B64.encode (BS.replicate 768 0x00))+ , bench "base64" $ nf R1.decodeBase64Untyped+ (B64.encode (BS.replicate 768 0x00))+ ]++decode_various :: Benchmark+decode_various = bgroup "base64" [+ 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))+ , bench "1036B input" $ nf B64.decode (B64.encode (BS.replicate 777 0x00))+ , bench "1040B input" $ nf B64.decode (B64.encode (BS.replicate 780 0x00))+ , bench "1044B input" $ nf B64.decode (B64.encode (BS.replicate 783 0x00))+ , bench "1048B input" $ nf B64.decode (B64.encode (BS.replicate 786 0x00))+ , bench "1052B input" $ nf B64.decode (B64.encode (BS.replicate 789 0x00))+ ]++encode_various :: Benchmark+encode_various = bgroup "base64" [+ 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)+ ]
+ bench/Weight.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}++module Main where++import qualified Data.ByteString as BS+import qualified "base64-bytestring" Data.ByteString.Base64 as R0+import qualified "base64" Data.ByteString.Base64 as R1+import qualified "ppad-base64" Data.ByteString.Base64 as B64+import qualified Weigh as W++inp :: BS.ByteString+inp = "jtobin was here benching stuffjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin was here benching stufjtobin w"++binp :: BS.ByteString+binp = B64.encode inp++main :: IO ()+main = W.mainWith $ do+ W.func "ppad-base64 (encode)" B64.encode inp+ W.func "base64-bytestring (encode)" R0.encode inp+ W.func "base64 (encode)" R1.encodeBase64' inp++ W.func "ppad-base64 (decode)" B64.decode binp+ W.func "base64-bytestring (decode)" R0.decode binp+ W.func "base64 (decode)" R1.decodeBase64Untyped binp
+ cbits/base64_arm.c view
@@ -0,0 +1,307 @@+#include <stddef.h>+#include <stdint.h>++#if defined(__aarch64__)++#include <arm_neon.h>++static const uint8_t b64_alphabet[64] =+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";++/*+ * Encode 'l' input bytes at 'src' into ((l+2)/3)*4 ASCII chars at 'dst'.+ *+ * NEON kernel processes 12 input bytes per iteration:+ * - vld1q_u8 loads 16 bytes (we use the first 12; reading 4 ahead is+ * safe as long as l - i >= 16)+ * - vqtbl1q_u8 with a shuffle mask gathers each 4-byte output lane as+ * [b1, b0, b2, b1], the order that lets a single shift+mask extract+ * each 6-bit index+ * - 4 vshrq_n_u32 + vandq_u32 pull out indices i0..i3 (one per lane+ * byte); see comments below for the bit math+ * - vqtbl4q_u8 looks up each index in the 64-byte alphabet+ * - vst1q_u8 stores 16 output chars+ *+ * A scalar loop finishes any full triplet that didn't make the NEON+ * cut-off, and a final branch emits the 0/1/2-byte padded tail.+ */+void base64_encode_arm(const uint8_t *src, uint8_t *dst, size_t l) {+ uint8x16x4_t lut;+ lut.val[0] = vld1q_u8(b64_alphabet);+ lut.val[1] = vld1q_u8(b64_alphabet + 16);+ lut.val[2] = vld1q_u8(b64_alphabet + 32);+ lut.val[3] = vld1q_u8(b64_alphabet + 48);++ /* For each 4-byte lane of output of vqtbl1q_u8, we want+ * [b1, b0, b2, b1] in memory order — viewed as a little-endian u32+ * lane that is (b1) | (b0 << 8) | (b2 << 16) | (b1 << 24). */+ static const uint8_t shuf_enc[16] = {+ 1, 0, 2, 1,+ 4, 3, 5, 4,+ 7, 6, 8, 7,+ 10, 9,11,10,+ };+ uint8x16_t shuf = vld1q_u8(shuf_enc);++ size_t i = 0, o = 0;+ while (i + 16 <= l) {+ uint8x16_t in = vld1q_u8(src + i);+ uint8x16_t shuffled = vqtbl1q_u8(in, shuf);+ uint32x4_t lane = vreinterpretq_u32_u8(shuffled);+ uint32x4_t mask6 = vdupq_n_u32(0x3F);++ /* lane (LE) = b1 | (b0 << 8) | (b2 << 16) | (b1 << 24)+ * i0 (top 6 of b0) = (lane >> 10) & 0x3F+ * i1 (lo 2 of b0|hi 4 of b1)= (lane >> 4) & 0x3F+ * i2 (lo 4 of b1|hi 2 of b2)= (lane >> 22) & 0x3F [uses b1 copy at byte 3]+ * i3 (lo 6 of b2) = (lane >> 16) & 0x3F */+ uint32x4_t i0 = vandq_u32(vshrq_n_u32(lane, 10), mask6);+ uint32x4_t i1 = vandq_u32(vshrq_n_u32(lane, 4), mask6);+ uint32x4_t i2 = vandq_u32(vshrq_n_u32(lane, 22), mask6);+ uint32x4_t i3 = vandq_u32(vshrq_n_u32(lane, 16), mask6);++ /* assemble per-lane u32 = i0 | (i1 << 8) | (i2 << 16) | (i3 << 24) */+ uint32x4_t idx_u32 = vorrq_u32(+ vorrq_u32(i0, vshlq_n_u32(i1, 8)),+ vorrq_u32(vshlq_n_u32(i2, 16), vshlq_n_u32(i3, 24)));++ uint8x16_t indices = vreinterpretq_u8_u32(idx_u32);+ uint8x16_t chars = vqtbl4q_u8(lut, indices);+ vst1q_u8(dst + o, chars);++ i += 12;+ o += 16;+ }++ /* scalar tail: full triplets */+ for (; i + 3 <= l; i += 3, o += 4) {+ uint32_t v = ((uint32_t)src[i] << 16)+ | ((uint32_t)src[i + 1] << 8)+ | (uint32_t)src[i + 2];+ dst[o] = b64_alphabet[(v >> 18) & 0x3F];+ dst[o + 1] = b64_alphabet[(v >> 12) & 0x3F];+ dst[o + 2] = b64_alphabet[(v >> 6) & 0x3F];+ dst[o + 3] = b64_alphabet[ v & 0x3F];+ }++ /* 1- or 2-byte padded tail */+ if (i + 1 == l) {+ uint8_t b = src[i];+ dst[o] = b64_alphabet[(b >> 2) & 0x3F];+ dst[o + 1] = b64_alphabet[(b & 0x03) << 4];+ dst[o + 2] = '=';+ dst[o + 3] = '=';+ } else if (i + 2 == l) {+ uint8_t b0 = src[i];+ uint8_t b1 = src[i + 1];+ dst[o] = b64_alphabet[(b0 >> 2) & 0x3F];+ dst[o + 1] = b64_alphabet[((b0 & 0x03) << 4) | (b1 >> 4)];+ dst[o + 2] = b64_alphabet[(b1 & 0x0F) << 2];+ dst[o + 3] = '=';+ }+}++/*+ * Convert 16 ASCII base64 chars to 6-bit values in 'val'.+ * Each lane of 'bad' is 0xff if the corresponding input is not a+ * valid base64 char ('A'..'Z', 'a'..'z', '0'..'9', '+', '/'), else 0.+ * '=' is treated as invalid here; the caller handles padding.+ */+static inline void ascii_to_b64(uint8x16_t c,+ uint8x16_t *val,+ uint8x16_t *bad) {+ uint8x16_t is_upper = vandq_u8(vcgeq_u8(c, vdupq_n_u8('A')),+ vcleq_u8(c, vdupq_n_u8('Z')));+ uint8x16_t is_lower = vandq_u8(vcgeq_u8(c, vdupq_n_u8('a')),+ vcleq_u8(c, vdupq_n_u8('z')));+ uint8x16_t is_digit = vandq_u8(vcgeq_u8(c, vdupq_n_u8('0')),+ vcleq_u8(c, vdupq_n_u8('9')));+ uint8x16_t is_plus = vceqq_u8(c, vdupq_n_u8('+'));+ uint8x16_t is_slash = vceqq_u8(c, vdupq_n_u8('/'));++ /* Per-lane additive offset that takes c to its 6-bit value:+ * 'A'..'Z': +(-65) = 0xBF mod 256 ('A' + 0xBF = 0)+ * 'a'..'z': +(-71) = 0xB9+ * '0'..'9': +4+ * '+': +19+ * '/': +16+ * Invalid lanes get +0; 'bad' flags them. */+ uint8x16_t add = vorrq_u8(+ vandq_u8(is_upper, vdupq_n_u8((uint8_t)(0u - 65))),+ vorrq_u8(+ vandq_u8(is_lower, vdupq_n_u8((uint8_t)(0u - 71))),+ vorrq_u8(+ vandq_u8(is_digit, vdupq_n_u8(4)),+ vorrq_u8(+ vandq_u8(is_plus, vdupq_n_u8(19)),+ vandq_u8(is_slash, vdupq_n_u8(16))))));++ *val = vaddq_u8(c, add);++ uint8x16_t any_valid = vorrq_u8(is_upper,+ vorrq_u8(is_lower,+ vorrq_u8(is_digit,+ vorrq_u8(is_plus, is_slash))));+ *bad = vmvnq_u8(any_valid);+}++static inline uint8_t scalar_b64(uint8_t c) {+ if (c >= 'A' && c <= 'Z') return (uint8_t)(c - 'A');+ if (c >= 'a' && c <= 'z') return (uint8_t)(c - 'a' + 26);+ if (c >= '0' && c <= '9') return (uint8_t)(c - '0' + 52);+ if (c == '+') return 62;+ if (c == '/') return 63;+ return 0x80; /* invalid sentinel */+}++/*+ * Decode 'inlen' ASCII base64 chars at 'src' into 'outlen' bytes at+ * 'dst'. Returns 1 on success, 0 on any decoding error: malformed+ * length, malformed padding, invalid char in body, or invalid char /+ * non-zero non-data bits in the padded final quartet (RFC 4648 §3.5).+ *+ * Caller must allocate 'outlen' bytes at 'dst' and pass the correct+ * outlen for the given inlen and padding; mismatch returns 0 with+ * 'dst' unspecified.+ *+ * Body NEON kernel processes 16 input chars (= 4 quartets) per+ * iteration:+ * - vld1q_u8 loads 16 chars+ * - ascii_to_b64 validates each lane and yields 6-bit values+ * - per u32x4 lane: build the 24-bit packed value V = (v0 << 18) |+ * (v1 << 12) | (v2 << 6) | v3, whose bytes in LE are [V_low,+ * V_mid, V_high, 0]+ * - vqtbl1q_u8 reshuffles those bytes into [V_high, V_mid, V_low]+ * per triplet, yielding 12 output bytes at the bottom of the+ * output vector+ * - vst1q_u8 stores 16 bytes (writing 12 valid + 4 spurious; the+ * loop bound 'o + 16 <= body_outlen' keeps the overrun within+ * the allocated buffer, and the spurious bytes get clobbered by+ * the next iteration or by the scalar tail / final quartet)+ *+ * A scalar tail finishes any body quartets that didn't make the+ * NEON cut-off, then the padded final quartet is decoded explicitly.+ */+int base64_decode_arm(const uint8_t *src, uint8_t *dst,+ size_t inlen, size_t outlen) {+ if (inlen == 0) return outlen == 0;+ if (inlen & 0x3) return 0;++ uint8_t c_pre = src[inlen - 2];+ uint8_t c_end = src[inlen - 1];+ size_t pad = 0;+ if (c_end == '=') {+ if (c_pre == '=') pad = 2;+ else pad = 1;+ } else if (c_pre == '=') {+ return 0; /* '=' at offset -2 only is malformed */+ }++ size_t nfull = inlen >> 2;+ if (outlen != nfull * 3 - pad) return 0;++ size_t body_chars = (pad > 0) ? (inlen - 4) : inlen;+ size_t body_outlen = (body_chars >> 2) * 3;++ uint8x16_t bad_acc = vdupq_n_u8(0);++ static const uint8_t pack_shuf[16] = {+ 2, 1, 0,+ 6, 5, 4,+ 10, 9, 8,+ 14,13,12,+ 0xFF, 0xFF, 0xFF, 0xFF+ };+ uint8x16_t pshuf = vld1q_u8(pack_shuf);++ size_t i = 0, o = 0;+ while (o + 16 <= body_outlen) {+ uint8x16_t c = vld1q_u8(src + i);+ uint8x16_t val, this_bad;+ ascii_to_b64(c, &val, &this_bad);+ bad_acc = vorrq_u8(bad_acc, this_bad);++ uint32x4_t v32 = vreinterpretq_u32_u8(val);+ uint32x4_t mask8 = vdupq_n_u32(0xFF);++ uint32x4_t p0 = vshlq_n_u32(vandq_u32(v32, mask8), 18);+ uint32x4_t p1 = vshlq_n_u32(+ vandq_u32(vshrq_n_u32(v32, 8), mask8), 12);+ uint32x4_t p2 = vshlq_n_u32(+ vandq_u32(vshrq_n_u32(v32, 16), mask8), 6);+ uint32x4_t p3 = vshrq_n_u32(v32, 24);++ uint32x4_t V = vorrq_u32(vorrq_u32(p0, p1),+ vorrq_u32(p2, p3));+ uint8x16_t V_bytes = vreinterpretq_u8_u32(V);+ uint8x16_t packed = vqtbl1q_u8(V_bytes, pshuf);++ vst1q_u8(dst + o, packed); /* 12 valid bytes + 4 spurious */++ i += 16;+ o += 12;+ }++ uint8_t tail_bad = 0;++ /* scalar body tail (full quartets, no '=') */+ while (o + 3 <= body_outlen) {+ uint8_t v0 = scalar_b64(src[i]);+ uint8_t v1 = scalar_b64(src[i + 1]);+ uint8_t v2 = scalar_b64(src[i + 2]);+ uint8_t v3 = scalar_b64(src[i + 3]);+ tail_bad |= (v0 | v1 | v2 | v3) & 0x80;+ dst[o] = (uint8_t)((v0 << 2) | (v1 >> 4));+ dst[o + 1] = (uint8_t)(((v1 & 0x0F) << 4) | (v2 >> 2));+ dst[o + 2] = (uint8_t)(((v2 & 0x03) << 6) | (v3 & 0x3F));+ i += 4;+ o += 3;+ }++ /* padded final quartet */+ if (pad > 0) {+ uint8_t v0 = scalar_b64(src[i]);+ uint8_t v1 = scalar_b64(src[i + 1]);+ if ((v0 | v1) & 0x80) return 0;++ if (pad == 2) {+ /* "XX==" -> 1 output byte; bottom 4 bits of v1 must be 0 */+ if (v1 & 0x0F) return 0;+ dst[o] = (uint8_t)((v0 << 2) | (v1 >> 4));+ } else {+ /* "XXX=" -> 2 output bytes; bottom 2 bits of v2 must be 0 */+ uint8_t v2 = scalar_b64(src[i + 2]);+ if (v2 & 0x80) return 0;+ if (v2 & 0x03) return 0;+ dst[o] = (uint8_t)((v0 << 2) | (v1 >> 4));+ dst[o + 1] = (uint8_t)(((v1 & 0x0F) << 4) | (v2 >> 2));+ }+ }++ return (vmaxvq_u8(bad_acc) == 0) && (tail_bad == 0);+}++int base64_arm_available(void) {+ return 1;+}++#else++/* stubs for non-aarch64 builds; never reached because dispatch is+ * gated on 'base64_arm_available' returning 0 */++void base64_encode_arm(const uint8_t *src, uint8_t *dst, size_t l) {+ (void)src; (void)dst; (void)l;+}++int base64_decode_arm(const uint8_t *src, uint8_t *dst,+ size_t inlen, size_t outlen) {+ (void)src; (void)dst; (void)inlen; (void)outlen;+ return 0;+}++int base64_arm_available(void) {+ return 0;+}++#endif
+ lib/Data/ByteString/Base64.hs view
@@ -0,0 +1,254 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Data.ByteString.Base64+-- Copyright: (c) 2026 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Pure 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 #-}++-- | Encode a base256 'ByteString' as base64.+--+-- Uses ARM NEON extensions when available, otherwise a pure+-- Haskell scalar loop.+--+-- >>> encode "hello world"+-- "aGVsbG8gd29ybGQ="+encode :: BS.ByteString -> BS.ByteString+encode bs+ | Arm.base64_arm_available = Arm.encode bs+ | otherwise = encode_scalar bs+{-# INLINABLE encode #-}++-- | Decode a base64 'ByteString' to base256.+--+-- Uses ARM NEON extensions when available, otherwise a pure+-- Haskell scalar loop. Invalid inputs (including incorrectly-+-- padded or non-canonical inputs) will produce 'Nothing'.+--+-- >>> decode "aGVsbG8gd29ybGQ="+-- Just "hello world"+-- >>> decode "aGVsbG8gd29ybGQ" -- missing padding+-- Nothing+decode :: BS.ByteString -> Maybe BS.ByteString+decode bs+ | Arm.base64_arm_available = Arm.decode bs+ | otherwise = decode_scalar 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/Arm.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module: Data.ByteString.Base64.Arm+-- Copyright: (c) 2026 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- ARM NEON support for base64 encoding and decoding.++module Data.ByteString.Base64.Arm (+ base64_arm_available+ , 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.C.Types (CInt(..), CSize(..))+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (peekElemOff)+import System.IO.Unsafe (unsafeDupablePerformIO)++-- ffi ------------------------------------------------------------------------++foreign import ccall unsafe "base64_encode_arm"+ c_base64_encode :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()++foreign import ccall unsafe "base64_decode_arm"+ c_base64_decode :: Ptr Word8 -> Ptr Word8 -> CSize -> CSize -> IO CInt++foreign import ccall unsafe "base64_arm_available"+ c_base64_arm_available :: IO CInt++-- utilities ------------------------------------------------------------------++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- api ------------------------------------------------------------------------++-- | Are ARM NEON extensions available?+base64_arm_available :: Bool+base64_arm_available =+ unsafeDupablePerformIO c_base64_arm_available /= 0+{-# NOINLINE base64_arm_available #-}++-- | Encode a base256 'ByteString' as base64 using NEON.+encode :: BS.ByteString -> BS.ByteString+encode (BI.PS sfp soff l) =+ BI.unsafeCreate ((l + 2) `quot` 3 * 4) $ \dst ->+ withForeignPtr sfp $ \sp0 ->+ c_base64_encode (sp0 `plusPtr` soff) dst (fi l)++-- | Decode a base64 'ByteString' to base256 using NEON. Returns+-- 'Nothing' on malformed input.+decode :: BS.ByteString -> Maybe BS.ByteString+decode (BI.PS sfp soff l)+ | l == 0 = Just BS.empty+ | l .&. 0x03 /= 0 = Nothing+ | otherwise = unsafeDupablePerformIO $+ withForeignPtr sfp $ \sp0 -> do+ let !sp = sp0 `plusPtr` soff :: 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+ !outlen = nfull * 3 - pad+ fp <- BI.mallocByteString outlen+ ok <- withForeignPtr fp $ \dst ->+ c_base64_decode sp dst (fi l) (fi outlen)+ pure $! if ok /= 0+ then Just (BI.PS fp 0 outlen)+ else Nothing
+ ppad-base64.cabal view
@@ -0,0 +1,104 @@+cabal-version: 3.0+name: ppad-base64+version: 0.1.0+synopsis: Fast base64 encoding and decoding on bytestrings.+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == { 9.10.3 }+extra-doc-files: CHANGELOG+description:+ Fast base64 encoding and decoding on strict bytestrings.++flag llvm+ description: Use GHC's LLVM backend.+ default: False+ manual: True++flag sanitize+ description: Build with AddressSanitizer and UndefinedBehaviorSanitizer.+ default: False+ manual: True++source-repository head+ type: git+ location: git.ppad.tech/base64.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ if flag(llvm)+ ghc-options: -fllvm -O2+ exposed-modules:+ Data.ByteString.Base64+ Data.ByteString.Base64.Arm+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ c-sources:+ cbits/base64_arm.c+ if arch(aarch64)+ cc-options: -march=armv8-a+ if flag(sanitize)+ cc-options: -fsanitize=address,undefined -fno-omit-frame-pointer+ ghc-options: -optl=-fsanitize=address,undefined++test-suite base64-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options:+ -rtsopts -Wall -O2+ if flag(sanitize)+ ghc-options: -optl=-fsanitize=address,undefined++ build-depends:+ base+ , base64-bytestring+ , bytestring+ , ppad-base64+ , tasty+ , tasty-hunit+ , tasty-quickcheck++benchmark base64-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , base64+ , base64-bytestring+ , bytestring+ , criterion+ , ppad-base64++benchmark base64-weigh+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Weight.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , base64+ , base64-bytestring+ , bytestring+ , criterion+ , ppad-base64+ , weigh
+ test/Main.hs view
@@ -0,0 +1,84 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}++module Main where++import qualified Data.ByteString as BS+import qualified "ppad-base64" Data.ByteString.Base64 as B64+import qualified "base64-bytestring" Data.ByteString.Base64 as R0+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)++bytes :: Int -> Q.Gen BS.ByteString+bytes k = do+ l <- Q.chooseInt (0, k)+ v <- Q.vectorOf l Q.arbitrary+ pure (BS.pack v)++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++encode_matches_reference :: BS -> Bool+encode_matches_reference (BS bs) =+ let us = B64.encode bs+ r0 = R0.encode bs+ in us == 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++case_rfc_vectors :: TestTree+case_rfc_vectors = H.testCase "RFC 4648 \167 10 vectors" $ do+ let vectors = [+ ("", "")+ , ("f", "Zg==")+ , ("fo", "Zm8=")+ , ("foo", "Zm9v")+ , ("foob", "Zm9vYg==")+ , ("fooba", "Zm9vYmE=")+ , ("foobar", "Zm9vYmFy")+ ]+ check (input, expected) = do+ H.assertEqual ("encode " <> show input)+ expected (B64.encode input)+ H.assertEqual ("decode " <> show expected)+ (Just input) (B64.decode expected)+ mapM_ check vectors++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.withMaxSuccess 5000 encode_matches_reference+ , Q.testProperty "decode matches reference" $+ Q.withMaxSuccess 5000 decode_matches_reference+ ]+ , testGroup "unit tests" [+ case_rfc_vectors+ ]+ ]