commit 428b4684a5b6b7034acfb82ce4f6b50efad9e482
parent dda8cad038aa195c14e885cde585e0d36f52243d
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 15:27:18 +0400
lib: compute bech32 data words directly on encode
The base32 encoding loop moves to the internal module, parameterised
by its output table. Encoding through an identity table yields the
5-bit data words directly, so bech32/bech32m encoding no longer
base32-encodes its input to characters and decodes them back (an
impossible failure path) to compute the checksum. Encoding is shared
between the two encodings in the internal module.
Diffstat:
5 files changed, 146 insertions(+), 129 deletions(-)
diff --git a/lib/Data/ByteString/Base32.hs b/lib/Data/ByteString/Base32.hs
@@ -18,7 +18,7 @@ module Data.ByteString.Base32 (
import qualified Data.Bits as B
import Data.Bits ((.&.), (.|.))
import qualified Data.ByteString as BS
-import Data.ByteString.Base32.Internal (enc_tab, dec_tab)
+import Data.ByteString.Base32.Internal (enc_tab, dec_tab, encode_with)
import qualified Data.ByteString.Internal as BI
import Data.Word (Word8)
import Foreign.ForeignPtr (withForeignPtr)
@@ -38,101 +38,7 @@ fi = fromIntegral
encode
:: BS.ByteString -- ^ base256-encoded bytestring
-> BS.ByteString -- ^ base32-encoded bytestring
-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
+encode = encode_with enc_tab
-- | Decode a 'ByteString', encoded as base32 using the bech32 character
-- set, to a base256-encoded 'ByteString'.
diff --git a/lib/Data/ByteString/Base32/Internal.hs b/lib/Data/ByteString/Base32/Internal.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_HADDOCK hide, prune #-}
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
@@ -7,15 +8,29 @@
-- 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'.
+-- Tables and the table-driven encoding loop for the bech32 base32
+-- charset, shared by 'Data.ByteString.Base32' and
+-- 'Data.ByteString.Bech32.Internal'.
module Data.ByteString.Base32.Internal (
enc_tab
, dec_tab
+ , w5_tab
+ , encode_with
) 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)
+
+fi :: (Num a, Integral b) => b -> a
+fi = fromIntegral
+{-# INLINE fi #-}
-- 32-byte encoding table: the bech32 character set. Maps a 5-bit
-- value (0..31) to its bech32 character. ASCII-only with no embedded
@@ -57,3 +72,111 @@ 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"
{-# NOINLINE dec_tab #-}
+
+-- 32-byte identity table: maps a 5-bit value to itself. Encoding
+-- through it yields the 5-bit values themselves rather than their
+-- bech32 characters.
+w5_tab :: BS.ByteString
+w5_tab = BS.pack [0 .. 31]
+{-# NOINLINE w5_tab #-}
+
+-- | Regroup a base256 'ByteString' into 5-bit values, mapping each
+-- through the supplied 32-byte table.
+encode_with
+ :: BS.ByteString -- ^ 32-byte table
+ -> BS.ByteString -- ^ base256-encoded bytestring
+ -> BS.ByteString
+encode_with (BI.PS tfp toff _) (BI.PS sfp soff l) =
+ 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
diff --git a/lib/Data/ByteString/Bech32.hs b/lib/Data/ByteString/Bech32.hs
@@ -1,5 +1,4 @@
{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE ViewPatterns #-}
-- |
-- Module: Data.ByteString.Bech32
@@ -20,15 +19,8 @@ module Data.ByteString.Bech32 (
, verify
) where
-import Control.Monad (guard)
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as B8
-import qualified Data.ByteString.Base32 as B32
import qualified Data.ByteString.Bech32.Internal as BI
-import qualified Data.Char as C (toLower)
-
-create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString
-create_checksum = BI.create_checksum BI.Bech32
-- | Encode a base256 human-readable part and input as bech32.
--
@@ -39,13 +31,7 @@ encode
:: BS.ByteString -- ^ base256-encoded human-readable part
-> BS.ByteString -- ^ base256-encoded data part
-> Maybe BS.ByteString -- ^ bech32-encoded bytestring
-encode (B8.map C.toLower -> hrp) (B32.encode -> dat) = do
- guard (BI.valid_hrp hrp)
- ws <- BI.as_word5 dat
- let check = create_checksum hrp ws
- res = BS.concat [hrp, BS.singleton 49, dat, BI.as_base32 check]
- guard (BS.length res < 91)
- pure res
+encode = BI.encode BI.Bech32
-- | Decode a bech32-encoded 'ByteString' into its human-readable and data
-- parts.
diff --git a/lib/Data/ByteString/Bech32/Internal.hs b/lib/Data/ByteString/Bech32/Internal.hs
@@ -9,6 +9,7 @@ module Data.ByteString.Bech32.Internal (
, create_checksum
, verify
, valid_hrp
+ , encode
, decode
) where
@@ -17,7 +18,8 @@ import Data.Bits ((.&.), (.|.))
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base32 as B32
-import Data.ByteString.Base32.Internal (enc_tab, dec_tab)
+import Data.ByteString.Base32.Internal
+ (enc_tab, dec_tab, w5_tab, encode_with)
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word8, Word32)
@@ -188,6 +190,20 @@ verify enc b32 = case normalize_case b32 of
let (hrp, BU.unsafeDrop 1 -> dat) = BS.splitAt idx bs
in valid_checksum enc hrp dat
+-- | Encode a human-readable part and base256 data as bech32 or
+-- bech32m. The human-readable part is lowercased.
+encode
+ :: Encoding
+ -> BS.ByteString -- ^ base256-encoded human-readable part
+ -> BS.ByteString -- ^ base256-encoded data part
+ -> Maybe BS.ByteString -- ^ bech32-encoded bytestring
+encode enc (BS.map to_lower -> hrp) dat = do
+ guard (valid_hrp hrp)
+ let !ws = encode_with w5_tab dat
+ guard (BS.length hrp + BS.length ws + 7 <= 90)
+ let !chk = create_checksum enc hrp ws
+ pure $! BS.concat [hrp, BS.singleton 0x31, as_base32 (ws <> chk)]
+
-- | Decode a bech32 or bech32m string into its (lowercase)
-- human-readable part and base256 data part. All-uppercase input
-- is accepted; mixed-case input is not.
diff --git a/lib/Data/ByteString/Bech32m.hs b/lib/Data/ByteString/Bech32m.hs
@@ -1,5 +1,4 @@
{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE ViewPatterns #-}
-- |
-- Module: Data.ByteString.Bech32m
@@ -21,15 +20,8 @@ module Data.ByteString.Bech32m (
, verify
) where
-import Control.Monad (guard)
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as B8
-import qualified Data.ByteString.Base32 as B32
import qualified Data.ByteString.Bech32.Internal as BI
-import qualified Data.Char as C (toLower)
-
-create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString
-create_checksum = BI.create_checksum BI.Bech32m
-- | Encode a base256 human-readable part and input as bech32m.
--
@@ -40,13 +32,7 @@ encode
:: BS.ByteString -- ^ base256-encoded human-readable part
-> BS.ByteString -- ^ base256-encoded data part
-> Maybe BS.ByteString -- ^ bech32m-encoded bytestring
-encode (B8.map C.toLower -> hrp) (B32.encode -> dat) = do
- guard (BI.valid_hrp hrp)
- ws <- BI.as_word5 dat
- let check = create_checksum hrp ws
- res = BS.concat [hrp, BS.singleton 49, dat, BI.as_base32 check]
- guard (BS.length res < 91)
- pure res
+encode = BI.encode BI.Bech32m
-- | Decode a bech32m-encoded 'ByteString' into its human-readable and data
-- parts.
