commit 8d7b99217b929ed6c379dc54f94ec59b7fe9b6cf
parent 55f351f4c17608f6c384cddc4112418f1409674a
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 16 May 2026 19:33:13 -0230
lib: refactor base32 to direct allocation
Drops the bytestring 'Builder' + 'toStrict' path used by both 'encode'
and 'decode'. Output buffers are now allocated up-front with
'BI.unsafeCreate' / 'BI.mallocByteString' at exactly the required
length and filled in-place via 'pokeElemOff'.
Adds a small hidden 'Data.ByteString.Base32.Internal' module holding
two static rodata tables, shared with 'Data.ByteString.Bech32.Internal':
- 'enc_tab' (32 bytes): the bech32 character set, mapping a 5-bit
value to its ASCII char.
- 'dec_tab' (256 bytes): inverse table, mapping ASCII to its biased
5-bit value (0x20..0x3f) or a 0x40 sentinel for invalid chars.
The bias is chosen so the literal is strictly ASCII with no
embedded NUL, which lets the bytestring 'IsString' rule rewrite
the literal to 'unsafePackAddress' and place the bytes in static
rodata. Validity is checked by OR-folding every lookup and
testing '.&. 0x40 == 0' once at the end; the 5-bit value is
recovered with '.&. 0x1f'.
The bit-shuffle for both directions is unchanged; only the storage
mechanism is different. The 'decode' canonical-form checks are
folded into the tail cases.
Benchmarks (M4 Air, -fllvm):
base32 encode 120b 55.24 ns -> 19.56 ns (2.82x)
base32 encode 128b 50.13 ns -> 19.95 ns (2.51x)
base32 encode 240b 79.78 ns -> 24.42 ns (3.27x)
base32 decode 120b 70.37 ns -> 24.19 ns (2.91x)
base32 decode 128b 66.59 ns -> 24.93 ns (2.67x)
Diffstat:
3 files changed, 327 insertions(+), 288 deletions(-)
diff --git a/lib/Data/ByteString/Base32.hs b/lib/Data/ByteString/Base32.hs
@@ -1,10 +1,5 @@
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE BinaryLiterals #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-- |
-- Module: Data.ByteString.Base32
@@ -14,112 +9,27 @@
--
-- Unpadded base32 encoding & decoding using the bech32 character set.
--- this module is an adaptation of emilypi's 'base32' library
-
module Data.ByteString.Base32 (
-- * base32 encoding and decoding
encode
, decode
) where
-import Control.Monad (guard)
-import Data.Bits ((.|.), (.&.))
import qualified Data.Bits as B
+import Data.Bits ((.&.), (.|.))
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Builder as BSB
-import qualified Data.ByteString.Builder.Extra as BE
+import Data.ByteString.Base32.Internal (enc_tab, dec_tab)
import qualified Data.ByteString.Internal as BI
-import qualified Data.ByteString.Unsafe as BU
-import Data.Word (Word8, Word32, Word64)
+import Data.Word (Word8)
+import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Ptr (Ptr, plusPtr)
+import Foreign.Storable (peekElemOff, pokeElemOff)
+import System.IO.Unsafe (unsafeDupablePerformIO)
-fi :: (Integral a, Num b) => a -> b
+fi :: (Num a, Integral b) => b -> a
fi = fromIntegral
{-# INLINE fi #-}
-word32be :: BS.ByteString -> Word32
-word32be s =
- (fi (s `BU.unsafeIndex` 0) `B.shiftL` 24) .|.
- (fi (s `BU.unsafeIndex` 1) `B.shiftL` 16) .|.
- (fi (s `BU.unsafeIndex` 2) `B.shiftL` 8) .|.
- (fi (s `BU.unsafeIndex` 3))
-{-# INLINE word32be #-}
-
--- realization for small builders
-toStrict :: BSB.Builder -> BS.ByteString
-toStrict = BS.toStrict
- . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty
-{-# INLINE toStrict #-}
-
-bech32_charset :: BS.ByteString
-bech32_charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
-
-word5 :: Word8 -> Maybe Word8
-word5 = \case
- 113 -> pure $! 0
- 112 -> pure $! 1
- 122 -> pure $! 2
- 114 -> pure $! 3
- 121 -> pure $! 4
- 57 -> pure $! 5
- 120 -> pure $! 6
- 56 -> pure $! 7
- 103 -> pure $! 8
- 102 -> pure $! 9
- 50 -> pure $! 10
- 116 -> pure $! 11
- 118 -> pure $! 12
- 100 -> pure $! 13
- 119 -> pure $! 14
- 48 -> pure $! 15
- 115 -> pure $! 16
- 51 -> pure $! 17
- 106 -> pure $! 18
- 110 -> pure $! 19
- 53 -> pure $! 20
- 52 -> pure $! 21
- 107 -> pure $! 22
- 104 -> pure $! 23
- 99 -> pure $! 24
- 101 -> pure $! 25
- 54 -> pure $! 26
- 109 -> pure $! 27
- 117 -> pure $! 28
- 97 -> pure $! 29
- 55 -> pure $! 30
- 108 -> pure $! 31
- _ -> Nothing
-{-# INLINE word5 #-}
-
-arrange :: Word32 -> Word8 -> BSB.Builder
-arrange w32 w8 =
- let mask = 0b00011111 -- low 5-bit mask
- bech32_char = fi . BS.index bech32_charset . fi -- word5 -> bech32
-
- -- split 40 bits into 8 w5's
- w5_0 = mask .&. (w32 `B.shiftR` 27) -- highest 5 bits
- w5_1 = mask .&. (w32 `B.shiftR` 22)
- w5_2 = mask .&. (w32 `B.shiftR` 17)
- w5_3 = mask .&. (w32 `B.shiftR` 12)
- w5_4 = mask .&. (w32 `B.shiftR` 07)
- w5_5 = mask .&. (w32 `B.shiftR` 02)
- -- combine lowest 2 bits of w32 with highest 3 bits of w8
- w5_6 = mask .&. (w32 `B.shiftL` 03 .|. fi w8 `B.shiftR` 05)
- -- lowest 5 bits of w8
- w5_7 = mask .&. fi w8
-
- -- get (w8) bech32 char for each w5, pack all into little-endian w64
- !w64 = bech32_char w5_0
- .|. bech32_char w5_1 `B.shiftL` 8
- .|. bech32_char w5_2 `B.shiftL` 16
- .|. bech32_char w5_3 `B.shiftL` 24
- .|. bech32_char w5_4 `B.shiftL` 32
- .|. bech32_char w5_5 `B.shiftL` 40
- .|. bech32_char w5_6 `B.shiftL` 48
- .|. bech32_char w5_7 `B.shiftL` 56
-
- in BSB.word64LE w64
-{-# INLINE arrange #-}
-
-- | Encode a base256-encoded 'ByteString' as a base32-encoded
-- 'ByteString', using the bech32 character set.
--
@@ -128,91 +38,101 @@ arrange w32 w8 =
encode
:: BS.ByteString -- ^ base256-encoded bytestring
-> BS.ByteString -- ^ base32-encoded bytestring
-encode dat = toStrict (go dat) where
- bech32_char = fi . BS.index bech32_charset . fi
-
- go bs@(BI.PS _ _ l)
- | l >= 5 = case BS.splitAt 5 bs of
- (chunk, etc) -> case BS.unsnoc chunk of
- Nothing -> error "impossible, chunk length is 5"
- Just (word32be -> w32, w8) -> arrange w32 w8 <> go etc
- | l == 0 = mempty
- | l == 1 =
- let a = BU.unsafeIndex bs 0
- t = bech32_char ((a .&. 0b11111000) `B.shiftR` 3)
- u = bech32_char ((a .&. 0b00000111) `B.shiftL` 2)
-
- !w16 = fi t
- .|. fi u `B.shiftL` 8
-
- in BSB.word16LE w16
- | l == 2 =
- let a = BU.unsafeIndex bs 0
- b = BU.unsafeIndex bs 1
- t = bech32_char ((a .&. 0b11111000) `B.shiftR` 3)
- u = bech32_char $
- ((a .&. 0b00000111) `B.shiftL` 2)
- .|. ((b .&. 0b11000000) `B.shiftR` 6)
- v = bech32_char ((b .&. 0b00111110) `B.shiftR` 1)
- w = bech32_char ((b .&. 0b00000001) `B.shiftL` 4)
-
- !w32 = fi t
- .|. fi u `B.shiftL` 8
- .|. fi v `B.shiftL` 16
- .|. fi w `B.shiftL` 24
-
- in BSB.word32LE w32
- | l == 3 =
- let a = BU.unsafeIndex bs 0
- b = BU.unsafeIndex bs 1
- c = BU.unsafeIndex bs 2
- t = bech32_char ((a .&. 0b11111000) `B.shiftR` 3)
- u = bech32_char $
- ((a .&. 0b00000111) `B.shiftL` 2)
- .|. ((b .&. 0b11000000) `B.shiftR` 6)
- v = bech32_char ((b .&. 0b00111110) `B.shiftR` 1)
- w = bech32_char $
- ((b .&. 0b00000001) `B.shiftL` 4)
- .|. ((c .&. 0b11110000) `B.shiftR` 4)
- x = bech32_char ((c .&. 0b00001111) `B.shiftL` 1)
-
- !w32 = fi t
- .|. fi u `B.shiftL` 8
- .|. fi v `B.shiftL` 16
- .|. fi w `B.shiftL` 24
-
- in BSB.word32LE w32 <> BSB.word8 x
- | l == 4 =
- let a = BU.unsafeIndex bs 0
- b = BU.unsafeIndex bs 1
- c = BU.unsafeIndex bs 2
- d = BU.unsafeIndex bs 3
- t = bech32_char ((a .&. 0b11111000) `B.shiftR` 3)
- u = bech32_char $
- ((a .&. 0b00000111) `B.shiftL` 2)
- .|. ((b .&. 0b11000000) `B.shiftR` 6)
- v = bech32_char ((b .&. 0b00111110) `B.shiftR` 1)
- w = bech32_char $
- ((b .&. 0b00000001) `B.shiftL` 4)
- .|. ((c .&. 0b11110000) `B.shiftR` 4)
- x = bech32_char $
- ((c .&. 0b00001111) `B.shiftL` 1)
- .|. ((d .&. 0b10000000) `B.shiftR` 7)
- y = bech32_char ((d .&. 0b01111100) `B.shiftR` 2)
- z = bech32_char ((d .&. 0b00000011) `B.shiftL` 3)
-
- !w32 = fi t
- .|. fi u `B.shiftL` 8
- .|. fi v `B.shiftL` 16
- .|. fi w `B.shiftL` 24
-
- !w16 = fi x
- .|. fi y `B.shiftL` 8
-
- in BSB.word32LE w32 <> BSB.word16LE w16 <> BSB.word8 z
-
- | otherwise =
- error "impossible"
+encode (BI.PS sfp soff l) = case enc_tab of
+ BI.PS tfp toff _ ->
+ let !outlen = (l * 8 + 4) `quot` 5
+ in BI.unsafeCreate outlen $ \dst ->
+ withForeignPtr sfp $ \sp0 ->
+ withForeignPtr tfp $ \tp0 -> do
+ let !sp = sp0 `plusPtr` soff :: Ptr Word8
+ !tp = tp0 `plusPtr` toff :: Ptr Word8
+ encode_loop sp tp dst l 0 0
+
+encode_loop
+ :: Ptr Word8 -> Ptr Word8 -> Ptr Word8
+ -> Int -> Int -> Int -> IO ()
+encode_loop !sp !tp !dst !len !i !j
+ | i + 5 <= len = do
+ a <- peekElemOff sp i
+ b <- peekElemOff sp (i + 1)
+ c <- peekElemOff sp (i + 2)
+ d <- peekElemOff sp (i + 3)
+ e <- peekElemOff sp (i + 4)
+ let !w0 = (a `B.shiftR` 3) .&. 0x1f
+ !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f
+ !w2 = (b `B.shiftR` 1) .&. 0x1f
+ !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f
+ !w4 = (c `B.shiftL` 1 .|. d `B.shiftR` 7) .&. 0x1f
+ !w5 = (d `B.shiftR` 2) .&. 0x1f
+ !w6 = (d `B.shiftL` 3 .|. e `B.shiftR` 5) .&. 0x1f
+ !w7 = e .&. 0x1f
+ peekElemOff tp (fi w0) >>= pokeElemOff dst j
+ peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1)
+ peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2)
+ peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3)
+ peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4)
+ peekElemOff tp (fi w5) >>= pokeElemOff dst (j + 5)
+ peekElemOff tp (fi w6) >>= pokeElemOff dst (j + 6)
+ peekElemOff tp (fi w7) >>= pokeElemOff dst (j + 7)
+ encode_loop sp tp dst len (i + 5) (j + 8)
+ | otherwise = encode_tail sp tp dst len i j
+
+encode_tail
+ :: Ptr Word8 -> Ptr Word8 -> Ptr Word8
+ -> Int -> Int -> Int -> IO ()
+encode_tail !sp !tp !dst !len !i !j = case len - i of
+ 0 -> pure ()
+ 1 -> do
+ a <- peekElemOff sp i
+ let !w0 = (a `B.shiftR` 3) .&. 0x1f
+ !w1 = (a `B.shiftL` 2) .&. 0x1f
+ peekElemOff tp (fi w0) >>= pokeElemOff dst j
+ peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1)
+ 2 -> do
+ a <- peekElemOff sp i
+ b <- peekElemOff sp (i + 1)
+ let !w0 = (a `B.shiftR` 3) .&. 0x1f
+ !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f
+ !w2 = (b `B.shiftR` 1) .&. 0x1f
+ !w3 = (b `B.shiftL` 4) .&. 0x1f
+ peekElemOff tp (fi w0) >>= pokeElemOff dst j
+ peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1)
+ peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2)
+ peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3)
+ 3 -> do
+ a <- peekElemOff sp i
+ b <- peekElemOff sp (i + 1)
+ c <- peekElemOff sp (i + 2)
+ let !w0 = (a `B.shiftR` 3) .&. 0x1f
+ !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f
+ !w2 = (b `B.shiftR` 1) .&. 0x1f
+ !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f
+ !w4 = (c `B.shiftL` 1) .&. 0x1f
+ peekElemOff tp (fi w0) >>= pokeElemOff dst j
+ peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1)
+ peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2)
+ peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3)
+ peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4)
+ 4 -> do
+ a <- peekElemOff sp i
+ b <- peekElemOff sp (i + 1)
+ c <- peekElemOff sp (i + 2)
+ d <- peekElemOff sp (i + 3)
+ let !w0 = (a `B.shiftR` 3) .&. 0x1f
+ !w1 = (a `B.shiftL` 2 .|. b `B.shiftR` 6) .&. 0x1f
+ !w2 = (b `B.shiftR` 1) .&. 0x1f
+ !w3 = (b `B.shiftL` 4 .|. c `B.shiftR` 4) .&. 0x1f
+ !w4 = (c `B.shiftL` 1 .|. d `B.shiftR` 7) .&. 0x1f
+ !w5 = (d `B.shiftR` 2) .&. 0x1f
+ !w6 = (d `B.shiftL` 3) .&. 0x1f
+ peekElemOff tp (fi w0) >>= pokeElemOff dst j
+ peekElemOff tp (fi w1) >>= pokeElemOff dst (j + 1)
+ peekElemOff tp (fi w2) >>= pokeElemOff dst (j + 2)
+ peekElemOff tp (fi w3) >>= pokeElemOff dst (j + 3)
+ peekElemOff tp (fi w4) >>= pokeElemOff dst (j + 4)
+ peekElemOff tp (fi w5) >>= pokeElemOff dst (j + 5)
+ peekElemOff tp (fi w6) >>= pokeElemOff dst (j + 6)
+ _ -> pure () -- impossible: 0 <= len - i < 5
-- | Decode a 'ByteString', encoded as base32 using the bech32 character
-- set, to a base256-encoded 'ByteString'.
@@ -224,108 +144,166 @@ encode dat = toStrict (go dat) where
decode
:: BS.ByteString -- ^ base32-encoded bytestring
-> Maybe BS.ByteString -- ^ base256-encoded bytestring
-decode = fmap toStrict . go mempty where
- go acc bs@(BI.PS _ _ l)
- | l < 8 = do
- fin <- finalize bs
- pure (acc <> fin)
- | otherwise = case BS.splitAt 8 bs of
- (chunk, etc) -> do
- res <- decode_chunk chunk
- go (acc <> res) etc
-
-finalize :: BS.ByteString -> Maybe BSB.Builder
-finalize bs@(BI.PS _ _ l)
- | l == 0 = Just mempty
- | otherwise = do
- guard (l >= 2)
- w5_0 <- word5 (BU.unsafeIndex bs 0)
- w5_1 <- word5 (BU.unsafeIndex bs 1)
- let w8_0 = w5_0 `B.shiftL` 3
- .|. w5_1 `B.shiftR` 2
-
- -- https://datatracker.ietf.org/doc/html/rfc4648#section-6
- if | l == 2 -> do -- 2 w5's, need 1 w8; 2 bits remain
- guard (w5_1 `B.shiftL` 6 == 0)
- pure (BSB.word8 w8_0)
-
- | l == 4 -> do -- 4 w5's, need 2 w8's; 4 bits remain
- w5_2 <- word5 (BU.unsafeIndex bs 2)
- w5_3 <- word5 (BU.unsafeIndex bs 3)
- let w8_1 = w5_1 `B.shiftL` 6
- .|. w5_2 `B.shiftL` 1
- .|. w5_3 `B.shiftR` 4
-
- !w16 = fi w8_1
- .|. fi w8_0 `B.shiftL` 8
-
- guard (w5_3 `B.shiftL` 4 == 0)
- pure (BSB.word16BE w16)
-
- | l == 5 -> do -- 5 w5's, need 3 w8's; 1 bit remains
- w5_2 <- word5 (BU.unsafeIndex bs 2)
- w5_3 <- word5 (BU.unsafeIndex bs 3)
- w5_4 <- word5 (BU.unsafeIndex bs 4)
- let w8_1 = w5_1 `B.shiftL` 6
- .|. w5_2 `B.shiftL` 1
- .|. w5_3 `B.shiftR` 4
- w8_2 = w5_3 `B.shiftL` 4
- .|. w5_4 `B.shiftR` 1
-
- w16 = fi w8_1
- .|. fi w8_0 `B.shiftL` 8
-
- guard (w5_4 `B.shiftL` 7 == 0)
- pure (BSB.word16BE w16 <> BSB.word8 w8_2)
-
- | l == 7 -> do -- 7 w5's, need 4 w8's; 3 bits remain
- w5_2 <- word5 (BU.unsafeIndex bs 2)
- w5_3 <- word5 (BU.unsafeIndex bs 3)
- w5_4 <- word5 (BU.unsafeIndex bs 4)
- w5_5 <- word5 (BU.unsafeIndex bs 5)
- w5_6 <- word5 (BU.unsafeIndex bs 6)
- let w8_1 = w5_1 `B.shiftL` 6
- .|. w5_2 `B.shiftL` 1
- .|. w5_3 `B.shiftR` 4
- w8_2 = w5_3 `B.shiftL` 4
- .|. w5_4 `B.shiftR` 1
- w8_3 = w5_4 `B.shiftL` 7
- .|. w5_5 `B.shiftL` 2
- .|. w5_6 `B.shiftR` 3
-
- w32 = fi w8_3
- .|. fi w8_2 `B.shiftL` 8
- .|. fi w8_1 `B.shiftL` 16
- .|. fi w8_0 `B.shiftL` 24
-
- guard (w5_6 `B.shiftL` 5 == 0)
- pure (BSB.word32BE w32)
-
- | otherwise -> Nothing
-
--- assumes length 8 input
-decode_chunk :: BS.ByteString -> Maybe BSB.Builder
-decode_chunk bs = do
- w5_0 <- word5 (BU.unsafeIndex bs 0)
- w5_1 <- word5 (BU.unsafeIndex bs 1)
- w5_2 <- word5 (BU.unsafeIndex bs 2)
- w5_3 <- word5 (BU.unsafeIndex bs 3)
- w5_4 <- word5 (BU.unsafeIndex bs 4)
- w5_5 <- word5 (BU.unsafeIndex bs 5)
- w5_6 <- word5 (BU.unsafeIndex bs 6)
- w5_7 <- word5 (BU.unsafeIndex bs 7)
-
- let w40 :: Word64
- !w40 = fi w5_0 `B.shiftL` 35
- .|. fi w5_1 `B.shiftL` 30
- .|. fi w5_2 `B.shiftL` 25
- .|. fi w5_3 `B.shiftL` 20
- .|. fi w5_4 `B.shiftL` 15
- .|. fi w5_5 `B.shiftL` 10
- .|. fi w5_6 `B.shiftL` 05
- .|. fi w5_7
- !w32 = fi (w40 `B.shiftR` 8) :: Word32
- !w8 = fi (0b11111111 .&. w40) :: Word8
-
- pure $ BSB.word32BE w32 <> BSB.word8 w8
-
+decode (BI.PS sfp soff l) = case l `rem` 8 of
+ 1 -> Nothing
+ 3 -> Nothing
+ 6 -> Nothing
+ _ -> case dec_tab of
+ BI.PS tfp toff _ -> unsafeDupablePerformIO $ do
+ let !n = (l * 5) `B.shiftR` 3
+ fp <- BI.mallocByteString n
+ ok <- withForeignPtr fp $ \dst ->
+ withForeignPtr sfp $ \sp0 ->
+ withForeignPtr tfp $ \tp0 -> do
+ let !sp = sp0 `plusPtr` soff :: Ptr Word8
+ !tp = tp0 `plusPtr` toff :: Ptr Word8
+ decode_loop sp tp dst l 0 0 0
+ pure $! if ok then Just (BI.PS fp 0 n) else Nothing
+
+decode_loop
+ :: Ptr Word8 -> Ptr Word8 -> Ptr Word8
+ -> Int -> Int -> Int -> Word8 -> IO Bool
+decode_loop !sp !tp !dst !len !i !j !acc
+ | i + 8 <= len = do
+ c0 <- peekElemOff sp i
+ c1 <- peekElemOff sp (i + 1)
+ c2 <- peekElemOff sp (i + 2)
+ c3 <- peekElemOff sp (i + 3)
+ c4 <- peekElemOff sp (i + 4)
+ c5 <- peekElemOff sp (i + 5)
+ c6 <- peekElemOff sp (i + 6)
+ c7 <- peekElemOff sp (i + 7)
+ n0 <- peekElemOff tp (fi c0)
+ n1 <- peekElemOff tp (fi c1)
+ n2 <- peekElemOff tp (fi c2)
+ n3 <- peekElemOff tp (fi c3)
+ n4 <- peekElemOff tp (fi c4)
+ n5 <- peekElemOff tp (fi c5)
+ n6 <- peekElemOff tp (fi c6)
+ n7 <- peekElemOff tp (fi c7)
+ let !v0 = n0 .&. 0x1f
+ !v1 = n1 .&. 0x1f
+ !v2 = n2 .&. 0x1f
+ !v3 = n3 .&. 0x1f
+ !v4 = n4 .&. 0x1f
+ !v5 = n5 .&. 0x1f
+ !v6 = n6 .&. 0x1f
+ !v7 = n7 .&. 0x1f
+ !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2)
+ !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|.
+ (v3 `B.shiftR` 4)
+ !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1)
+ !b3 = (v4 `B.shiftL` 7) .|. (v5 `B.shiftL` 2) .|.
+ (v6 `B.shiftR` 3)
+ !b4 = (v6 `B.shiftL` 5) .|. v7
+ pokeElemOff dst j b0
+ pokeElemOff dst (j + 1) b1
+ pokeElemOff dst (j + 2) b2
+ pokeElemOff dst (j + 3) b3
+ pokeElemOff dst (j + 4) b4
+ decode_loop sp tp dst len (i + 8) (j + 5)
+ (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4 .|. n5 .|. n6 .|. n7)
+ | otherwise = decode_tail sp tp dst len i j acc
+
+decode_tail
+ :: Ptr Word8 -> Ptr Word8 -> Ptr Word8
+ -> Int -> Int -> Int -> Word8 -> IO Bool
+decode_tail !sp !tp !dst !len !i !j !acc = case len - i of
+ 0 -> pure $! acc .&. 0x40 == 0
+ 2 -> do
+ c0 <- peekElemOff sp i
+ c1 <- peekElemOff sp (i + 1)
+ n0 <- peekElemOff tp (fi c0)
+ n1 <- peekElemOff tp (fi c1)
+ let !v0 = n0 .&. 0x1f
+ !v1 = n1 .&. 0x1f
+ !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2)
+ -- canonical-form check: bits dropped from v1 must be zero
+ !slack = v1 `B.shiftL` 6
+ pokeElemOff dst j b0
+ pure $! (acc .|. n0 .|. n1) .&. 0x40 == 0 && slack == 0
+ 4 -> do
+ c0 <- peekElemOff sp i
+ c1 <- peekElemOff sp (i + 1)
+ c2 <- peekElemOff sp (i + 2)
+ c3 <- peekElemOff sp (i + 3)
+ n0 <- peekElemOff tp (fi c0)
+ n1 <- peekElemOff tp (fi c1)
+ n2 <- peekElemOff tp (fi c2)
+ n3 <- peekElemOff tp (fi c3)
+ let !v0 = n0 .&. 0x1f
+ !v1 = n1 .&. 0x1f
+ !v2 = n2 .&. 0x1f
+ !v3 = n3 .&. 0x1f
+ !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2)
+ !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|.
+ (v3 `B.shiftR` 4)
+ !slack = v3 `B.shiftL` 4
+ pokeElemOff dst j b0
+ pokeElemOff dst (j + 1) b1
+ pure $! (acc .|. n0 .|. n1 .|. n2 .|. n3) .&. 0x40 == 0
+ && slack == 0
+ 5 -> do
+ c0 <- peekElemOff sp i
+ c1 <- peekElemOff sp (i + 1)
+ c2 <- peekElemOff sp (i + 2)
+ c3 <- peekElemOff sp (i + 3)
+ c4 <- peekElemOff sp (i + 4)
+ n0 <- peekElemOff tp (fi c0)
+ n1 <- peekElemOff tp (fi c1)
+ n2 <- peekElemOff tp (fi c2)
+ n3 <- peekElemOff tp (fi c3)
+ n4 <- peekElemOff tp (fi c4)
+ let !v0 = n0 .&. 0x1f
+ !v1 = n1 .&. 0x1f
+ !v2 = n2 .&. 0x1f
+ !v3 = n3 .&. 0x1f
+ !v4 = n4 .&. 0x1f
+ !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2)
+ !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|.
+ (v3 `B.shiftR` 4)
+ !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1)
+ !slack = v4 `B.shiftL` 7
+ pokeElemOff dst j b0
+ pokeElemOff dst (j + 1) b1
+ pokeElemOff dst (j + 2) b2
+ pure $! (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4) .&. 0x40 == 0
+ && slack == 0
+ 7 -> do
+ c0 <- peekElemOff sp i
+ c1 <- peekElemOff sp (i + 1)
+ c2 <- peekElemOff sp (i + 2)
+ c3 <- peekElemOff sp (i + 3)
+ c4 <- peekElemOff sp (i + 4)
+ c5 <- peekElemOff sp (i + 5)
+ c6 <- peekElemOff sp (i + 6)
+ n0 <- peekElemOff tp (fi c0)
+ n1 <- peekElemOff tp (fi c1)
+ n2 <- peekElemOff tp (fi c2)
+ n3 <- peekElemOff tp (fi c3)
+ n4 <- peekElemOff tp (fi c4)
+ n5 <- peekElemOff tp (fi c5)
+ n6 <- peekElemOff tp (fi c6)
+ let !v0 = n0 .&. 0x1f
+ !v1 = n1 .&. 0x1f
+ !v2 = n2 .&. 0x1f
+ !v3 = n3 .&. 0x1f
+ !v4 = n4 .&. 0x1f
+ !v5 = n5 .&. 0x1f
+ !v6 = n6 .&. 0x1f
+ !b0 = (v0 `B.shiftL` 3) .|. (v1 `B.shiftR` 2)
+ !b1 = (v1 `B.shiftL` 6) .|. (v2 `B.shiftL` 1) .|.
+ (v3 `B.shiftR` 4)
+ !b2 = (v3 `B.shiftL` 4) .|. (v4 `B.shiftR` 1)
+ !b3 = (v4 `B.shiftL` 7) .|. (v5 `B.shiftL` 2) .|.
+ (v6 `B.shiftR` 3)
+ !slack = v6 `B.shiftL` 5
+ pokeElemOff dst j b0
+ pokeElemOff dst (j + 1) b1
+ pokeElemOff dst (j + 2) b2
+ pokeElemOff dst (j + 3) b3
+ pure $!
+ (acc .|. n0 .|. n1 .|. n2 .|. n3 .|. n4 .|. n5 .|. n6)
+ .&. 0x40 == 0
+ && slack == 0
+ _ -> pure False -- impossible: tail-length guard already rejected
diff --git a/lib/Data/ByteString/Base32/Internal.hs b/lib/Data/ByteString/Base32/Internal.hs
@@ -0,0 +1,59 @@
+{-# OPTIONS_HADDOCK hide, prune #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Data.ByteString.Base32.Internal
+-- Copyright: (c) 2024 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Static rodata tables for the bech32 base32 charset, shared by
+-- 'Data.ByteString.Base32' and 'Data.ByteString.Bech32.Internal'.
+
+module Data.ByteString.Base32.Internal (
+ enc_tab
+ , dec_tab
+ ) where
+
+import qualified Data.ByteString as BS
+
+-- 32-byte encoding table: the bech32 character set. Maps a 5-bit
+-- value (0..31) to its bech32 character. ASCII-only with no embedded
+-- NUL, so the bytestring 'IsString' rule rewrites the literal to
+-- 'unsafePackAddress' and the bytes live in static rodata.
+enc_tab :: BS.ByteString
+enc_tab = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
+{-# NOINLINE enc_tab #-}
+
+-- 256-byte reverse table. Index by an ASCII byte to obtain its
+-- 5-bit value (biased into bit 5); valid bech32 chars map to
+-- 0x20..0x3f, every other byte maps to 0x40.
+--
+-- 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 0x40 sentinel is distinguished by bit 6; no value 0x20..0x3f
+-- carries that bit, so callers OR-fold every lookup into an
+-- accumulator and test 'acc .&. 0x40 == 0' once at the end. The
+-- 5-bit value is extracted as 'b .&. 0x1f'.
+dec_tab :: BS.ByteString
+dec_tab =
+ "\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x2f\x40\x2a\x31\x35\x34\x3a\x3e\x27\x25\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x3d\x40\x38\x2d\x39\x29\x28\x37\x40\x32\x36\x3f\x3b\x33\x40\
+ \\x21\x20\x23\x30\x2b\x3c\x2c\x2e\x26\x24\x22\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\
+ \\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40\x40"
+{-# NOINLINE dec_tab #-}
diff --git a/ppad-bech32.cabal b/ppad-bech32.cabal
@@ -35,6 +35,8 @@ library
, Data.ByteString.Bech32.Internal
, Data.ByteString.Bech32
, Data.ByteString.Bech32m
+ other-modules:
+ Data.ByteString.Base32.Internal
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
