ppad-bech32 0.1.2 → 0.2.0
raw patch · 8 files changed
+506/−233 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.ByteString.Base32: decode :: ByteString -> Maybe ByteString
+ Data.ByteString.Base32: encode :: ByteString -> ByteString
+ Data.ByteString.Bech32: decode :: ByteString -> Maybe (ByteString, ByteString)
+ Data.ByteString.Bech32m: decode :: ByteString -> Maybe (ByteString, ByteString)
Files
- CHANGELOG +6/−0
- bench/Main.hs +25/−20
- lib/Data/ByteString/Base32.hs +227/−173
- lib/Data/ByteString/Bech32.hs +39/−14
- lib/Data/ByteString/Bech32/Internal.hs +109/−0
- lib/Data/ByteString/Bech32m.hs +38/−13
- ppad-bech32.cabal +5/−4
- test/Main.hs +57/−9
CHANGELOG view
@@ -1,5 +1,11 @@ # Changelog +- 0.2.0 (2025-01-04)+ * Adds bech32/bech32m/base32 decoding.+ * Fixes a bug in which mixed-case HRP's would result in encodings with+ invalid checksums (IIRC this also affects the Haskell reference+ implementation).+ - 0.1.2 (2024-12-15) * Minor performance improvements.
bench/Main.hs view
@@ -21,40 +21,45 @@ suite ] -base32 :: Benchmark-base32 = bgroup "base32 encode" [+base32_encode :: Benchmark+base32_encode = bgroup "base32 encode" [ bench "120b" $ nf Base32.encode "jtobin was here" , bench "128b (non 40-bit multiple length)" $ nf Base32.encode "jtobin was here!" , bench "240b" $ nf Base32.encode "jtobin was herejtobin was here" ] -bech32 :: Benchmark-bech32 = bgroup "bech32 encode" [- bench "120b" $ nf (Bech32.encode "bc") "jtobin was here"+base32_decode :: Benchmark+base32_decode = bgroup "base32 decode" [+ bench "120b" $ nf Base32.decode "df6x7cnfdcs8wctnyp5x2un9" , bench "128b (non 40-bit multiple length)" $- nf (Bech32.encode "bc") "jtobin was here!"- , bench "240b" $ nf (Bech32.encode "bc") "jtobin was herejtobin was here"+ nf Base32.decode "df6x7cnfdcs8wctnyp5x2un9yy" ] +bech32_encode :: Benchmark+bech32_encode = bgroup "bech32 encode" [+ bench "120b" $ nf (Bech32.encode "bc") "jtobin was here"+ ]++bech32_decode :: Benchmark+bech32_decode = bgroup "bech32 decode" [+ bench "120b" $ nf Bech32.decode "bc1df6x7cnfdcs8wctnyp5x2un9f0pw8y"+ ]+ suite :: Benchmark-suite = env setup $ \ ~(a, b, c) -> bgroup "benchmarks" [+suite = bgroup "benchmarks" [ bgroup "ppad-bech32" [- base32- , bech32+ base32_encode+ , base32_decode+ , bech32_encode+ , bech32_decode ] , bgroup "reference" [- bgroup "bech32" [- bench "120b" $ nf (R.bech32Encode "bc") a- , bench "128b (non 40-bit multiple length)" $- nf (R.bech32Encode "bc") b- , bench "240b" $ nf (R.bech32Encode "bc") c+ bgroup "bech32 encode" [+ bench "120b" $ nf (refEncode "bc") "jtobin was here" ] ] ] where- setup = do- let a = R.toBase32 (BS.unpack "jtobin was here")- b = R.toBase32 (BS.unpack "jtobin was here!")- c = R.toBase32 (BS.unpack "jtobin was herejtobin was here")- pure (a, b, c)+ refEncode h a = R.bech32Encode h (R.toBase32 (BS.unpack a))+
lib/Data/ByteString/Base32.hs view
@@ -1,32 +1,36 @@-{-# OPTIONS_HADDOCK hide, prune #-}+{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} +-- |+-- Module: Data.ByteString.Base32+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- 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- , as_word5- , as_base32-- -- not actually base32-related, but convenient to put here- , Encoding(..)- , create_checksum- , verify- , valid_hrp+ , decode ) where +import Control.Monad (guard) import Data.Bits ((.|.), (.&.)) import qualified Data.Bits as B import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Builder.Extra as BE+import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Unsafe as BU-import qualified Data.Primitive.PrimArray as PA-import Data.Word (Word32)--_BECH32M_CONST :: Word32-_BECH32M_CONST = 0x2bc830a3+import Data.Word (Word8, Word32, Word64) fi :: (Integral a, Num b) => a -> b fi = fromIntegral@@ -49,195 +53,245 @@ bech32_charset :: BS.ByteString bech32_charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l" --- adapted from emilypi's 'base32' library-encode :: BS.ByteString -> BS.ByteString-encode dat = toStrict (go dat) where- bech32_char = fi . BS.index bech32_charset . fi+word5 :: Word8 -> Maybe Word8+word5 w8 = fmap fi (BS.elemIndex w8 bech32_charset) - go bs = case BS.splitAt 5 bs of- (chunk, etc) -> case BS.length etc of- -- https://datatracker.ietf.org/doc/html/rfc4648#section-6- 0 | BS.length chunk == 5 -> case BS.unsnoc chunk of- Nothing -> error "impossible, chunk length is 5"- Just (word32be -> w32, fi -> w8) -> arrange w32 w8+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 - | BS.length chunk == 1 ->- let a = BU.unsafeIndex chunk 0- t = bech32_char ((a .&. 0b11111000) `B.shiftR` 3)- u = bech32_char ((a .&. 0b00000111) `B.shiftL` 2)+ -- 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 - !w16 = fi t- .|. fi u `B.shiftL` 8+ -- 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.word16LE w16+ in BSB.word64LE w64+{-# INLINE arrange #-} - | BS.length chunk == 2 ->- let a = BU.unsafeIndex chunk 0- b = BU.unsafeIndex chunk 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)+-- | Encode a base256-encoded 'ByteString' as a base32-encoded+-- 'ByteString', using the bech32 character set.+--+-- >>> encode "jtobin was here!"+-- "df6x7cnfdcs8wctnyp5x2un9yy"+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 - !w32 = fi t- .|. fi u `B.shiftL` 8- .|. fi v `B.shiftL` 16- .|. fi w `B.shiftL` 24+ 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) - in BSB.word32LE w32+ !w16 = fi t+ .|. fi u `B.shiftL` 8 - | BS.length chunk == 3 ->- let a = BU.unsafeIndex chunk 0- b = BU.unsafeIndex chunk 1- c = BU.unsafeIndex chunk 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)+ 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+ !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+ 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) - | BS.length chunk == 4 ->- let a = BU.unsafeIndex chunk 0- b = BU.unsafeIndex chunk 1- c = BU.unsafeIndex chunk 2- d = BU.unsafeIndex chunk 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 - !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) - !w16 = fi x- .|. fi y `B.shiftL` 8+ !w32 = fi t+ .|. fi u `B.shiftL` 8+ .|. fi v `B.shiftL` 16+ .|. fi w `B.shiftL` 24 - in BSB.word32LE w32 <> BSB.word16LE w16 <> BSB.word8 z+ !w16 = fi x+ .|. fi y `B.shiftL` 8 - | otherwise -> mempty+ in BSB.word32LE w32 <> BSB.word16LE w16 <> BSB.word8 z - _ -> case BS.unsnoc chunk of- Nothing -> error "impossible, chunk length is 5"- Just (word32be -> w32, fi -> w8) -> arrange w32 w8 <> go etc+ | otherwise =+ error "impossible" --- adapted from emilypi's 'base32' library-arrange :: Word32 -> Word32 -> BSB.Builder-arrange w32 w8 =- let mask = 0b00011111- bech32_char = fi . BS.index bech32_charset . fi+-- | Decode a 'ByteString', encoded as base32 using the bech32 character+-- set, to a base256-encoded 'ByteString'.+--+-- >>> decode "df6x7cnfdcs8wctnyp5x2un9yy"+-- Just "jtobin was here!"+-- >>> decode "dfOx7cnfdcs8wctnyp5x2un9yy" -- s/6/O (non-bech32 character)+-- Nothing+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 - w8_0 = bech32_char (mask .&. (w32 `B.shiftR` 27))- w8_1 = bech32_char (mask .&. (w32 `B.shiftR` 22))- w8_2 = bech32_char (mask .&. (w32 `B.shiftR` 17))- w8_3 = bech32_char (mask .&. (w32 `B.shiftR` 12))- w8_4 = bech32_char (mask .&. (w32 `B.shiftR` 07))- w8_5 = bech32_char (mask .&. (w32 `B.shiftR` 02))- w8_6 = bech32_char (mask .&. (w32 `B.shiftL` 03 .|. w8 `B.shiftR` 05))- w8_7 = bech32_char (mask .&. w8)+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 - !w64 = w8_0- .|. w8_1 `B.shiftL` 8- .|. w8_2 `B.shiftL` 16- .|. w8_3 `B.shiftL` 24- .|. w8_4 `B.shiftL` 32- .|. w8_5 `B.shiftL` 40- .|. w8_6 `B.shiftL` 48- .|. w8_7 `B.shiftL` 56+ -- 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) - in BSB.word64LE w64-{-# INLINE arrange #-}+ | 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 --- naive base32 -> word5-as_word5 :: BS.ByteString -> BS.ByteString-as_word5 = BS.map f where- f b = case BS.elemIndex (fi b) bech32_charset of- Nothing -> error "ppad-bech32 (as_word5): input not bech32-encoded"- Just w -> fi w+ !w16 = fi w8_1+ .|. fi w8_0 `B.shiftL` 8 --- naive word5 -> base32-as_base32 :: BS.ByteString -> BS.ByteString-as_base32 = BS.map (BS.index bech32_charset . fi)+ guard (w5_3 `B.shiftL` 4 == 0)+ pure (BSB.word16BE w16) -polymod :: BS.ByteString -> Word32-polymod = BS.foldl' alg 1 where- generator = PA.primArrayFromListN 5- [0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3]+ | 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 - alg !chk v =- let !b = chk `B.shiftR` 25- c = (chk .&. 0x1ffffff) `B.shiftL` 5 `B.xor` fi v- in loop_gen 0 b c+ w16 = fi w8_1+ .|. fi w8_0 `B.shiftL` 8 - loop_gen i b !chk- | i > 4 = chk- | otherwise =- let sor | B.testBit (b `B.shiftR` i) 0 =- PA.indexPrimArray generator i- | otherwise = 0- in loop_gen (succ i) b (chk `B.xor` sor)+ guard (w5_4 `B.shiftL` 7 == 0)+ pure (BSB.word16BE w16 <> BSB.word8 w8_2) -valid_hrp :: BS.ByteString -> Bool-valid_hrp hrp- | l == 0 || l > 83 = False- | otherwise = BS.all (\b -> (b > 32) && (b < 127)) hrp- where- l = BS.length hrp+ | 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 -hrp_expand :: BS.ByteString -> BS.ByteString-hrp_expand bs = toStrict- $ BSB.byteString (BS.map (`B.shiftR` 5) bs)- <> BSB.word8 0- <> BSB.byteString (BS.map (.&. 0b11111) bs)+ w32 = fi w8_3+ .|. fi w8_2 `B.shiftL` 8+ .|. fi w8_1 `B.shiftL` 16+ .|. fi w8_0 `B.shiftL` 24 -data Encoding =- Bech32- | Bech32m+ guard (w5_6 `B.shiftL` 5 == 0)+ pure (BSB.word32BE w32) -create_checksum :: Encoding -> BS.ByteString -> BS.ByteString -> BS.ByteString-create_checksum enc hrp dat =- let pre = hrp_expand hrp <> dat- pay = toStrict $- BSB.byteString pre- <> BSB.byteString "\NUL\NUL\NUL\NUL\NUL\NUL"- pm = polymod pay `B.xor` case enc of- Bech32 -> 1- Bech32m -> _BECH32M_CONST+ | otherwise -> Nothing - code i = (fi (pm `B.shiftR` fi i) .&. 0b11111)+-- 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) - in BS.map code "\EM\DC4\SI\n\ENQ\NUL" -- BS.pack [25, 20, 15, 10, 5, 0]+ 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 -verify :: Encoding -> BS.ByteString -> Bool-verify enc b32 = case BS.elemIndexEnd 0x31 b32 of- Nothing -> False- Just idx ->- let (hrp, BU.unsafeDrop 1 -> dat) = BS.splitAt idx b32- bs = hrp_expand hrp <> as_word5 dat- in polymod bs == case enc of- Bech32 -> 1- Bech32m -> _BECH32M_CONST+ pure $ BSB.word32BE w32 <> BSB.word8 w8
lib/Data/ByteString/Bech32.hs view
@@ -9,11 +9,12 @@ -- -- The -- [BIP0173](https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki)--- bech32 checksummed base32 encoding, with checksum verification.+-- bech32 checksummed base32 encoding, with decoding and checksum verification. module Data.ByteString.Bech32 (- -- * Encoding+ -- * Encoding and Decoding encode+ , decode -- * Checksum , verify@@ -23,10 +24,11 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Base32 as B32-import Data.ByteString.Base32 (Encoding(..))+import qualified Data.ByteString.Bech32.Internal as BI import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Builder.Extra as BE-import qualified Data.Char as C (toLower)+import qualified Data.ByteString.Internal as BSI+import qualified Data.Char as C (toLower, isLower, isAlpha) -- realization for small builders toStrict :: BSB.Builder -> BS.ByteString@@ -35,28 +37,51 @@ {-# INLINE toStrict #-} create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString-create_checksum = B32.create_checksum Bech32+create_checksum = BI.create_checksum BI.Bech32 --- | Encode a base255 human-readable part and input as bech32.+-- | Encode a base256 human-readable part and input as bech32. -- -- >>> let Just bech32 = encode "bc" "my string" -- >>> bech32 -- "bc1d4ujqum5wf5kuecmu02w2" encode- :: BS.ByteString -- ^ base255-encoded human-readable part- -> BS.ByteString -- ^ base255-encoded data part+ :: BS.ByteString -- ^ base256-encoded human-readable part+ -> BS.ByteString -- ^ base256-encoded data part -> Maybe BS.ByteString -- ^ bech32-encoded bytestring-encode hrp (B32.encode -> dat) = do- guard (B32.valid_hrp hrp)- let check = create_checksum hrp (B32.as_word5 dat)+encode (B8.map C.toLower -> hrp) (B32.encode -> dat) = do+ guard (BI.valid_hrp hrp)+ let check = create_checksum hrp (BI.as_word5 dat) res = toStrict $- BSB.byteString (B8.map C.toLower hrp)+ BSB.byteString hrp <> BSB.word8 49 -- 1 <> BSB.byteString dat- <> BSB.byteString (B32.as_base32 check)+ <> BSB.byteString (BI.as_base32 check) guard (BS.length res < 91) pure res +-- | Decode a bech32-encoded 'ByteString' into its human-readable and data+-- parts.+--+-- >>> decode "hi1df6x7cnfdcs8wctnyp5x2un9wed5st"+-- Just ("hi","jtobin was here")+-- >>> decode "hey1df6x7cnfdcs8wctnyp5x2un9wed5st" -- s/hi/hey+-- Nothing+decode+ :: BS.ByteString -- ^ bech23-encoded bytestring+ -> Maybe (BS.ByteString, BS.ByteString) -- ^ (hrp, data less checksum)+decode bs@(BSI.PS _ _ l) = do+ guard (l <= 90)+ guard (B8.all (\a -> if C.isAlpha a then C.isLower a else True) bs)+ guard (verify bs)+ sep <- BS.elemIndexEnd 0x31 bs+ case BS.splitAt sep bs of+ (hrp, raw) -> do+ guard (BI.valid_hrp hrp)+ guard (BS.length raw >= 6)+ (_, BS.dropEnd 6 -> bech32dat) <- BS.uncons raw+ dat <- B32.decode bech32dat+ pure (hrp, dat)+ -- | Verify that a bech32 string has a valid checksum. -- -- >>> verify "bc1d4ujqum5wf5kuecmu02w2"@@ -66,5 +91,5 @@ verify :: BS.ByteString -- ^ bech32-encoded bytestring -> Bool-verify = B32.verify Bech32+verify = BI.verify BI.Bech32
+ lib/Data/ByteString/Bech32/Internal.hs view
@@ -0,0 +1,109 @@+{-# OPTIONS_HADDOCK hide, prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Data.ByteString.Bech32.Internal (+ as_word5+ , as_base32+ , Encoding(..)+ , create_checksum+ , verify+ , valid_hrp+ ) where++import Data.Bits ((.&.))+import qualified Data.Bits as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Builder.Extra as BE+import qualified Data.ByteString.Internal as BI+import qualified Data.ByteString.Unsafe as BU+import qualified Data.Primitive.PrimArray as PA+import Data.Word (Word32)++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- realization for small builders+toStrict :: BSB.Builder -> BS.ByteString+toStrict = BS.toStrict+ . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty+{-# INLINE toStrict #-}++_BECH32M_CONST :: Word32+_BECH32M_CONST = 0x2bc830a3++bech32_charset :: BS.ByteString+bech32_charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"++-- naive base32 -> word5+as_word5 :: BS.ByteString -> BS.ByteString+as_word5 = BS.map f where+ f b = case BS.elemIndex (fi b) bech32_charset of+ Nothing -> error "ppad-bech32 (as_word5): input not bech32-encoded"+ Just w -> fi w++-- naive word5 -> base32+as_base32 :: BS.ByteString -> BS.ByteString+as_base32 = BS.map (BS.index bech32_charset . fi)++polymod :: BS.ByteString -> Word32+polymod = BS.foldl' alg 1 where+ generator = PA.primArrayFromListN 5+ [0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3]++ alg !chk v =+ let !b = chk `B.shiftR` 25+ c = (chk .&. 0x1ffffff) `B.shiftL` 5 `B.xor` fi v+ in loop_gen 0 b c++ loop_gen i b !chk+ | i > 4 = chk+ | otherwise =+ let sor | B.testBit (b `B.shiftR` i) 0 =+ PA.indexPrimArray generator i+ | otherwise = 0+ in loop_gen (succ i) b (chk `B.xor` sor)++valid_hrp :: BS.ByteString -> Bool+valid_hrp hrp@(BI.PS _ _ l)+ | l == 0 || l > 83 = False+ | otherwise = BS.all (\b -> (b > 32) && (b < 127)) hrp++hrp_expand :: BS.ByteString -> BS.ByteString+hrp_expand bs = toStrict+ $ BSB.byteString (BS.map (`B.shiftR` 5) bs)+ <> BSB.word8 0+ <> BSB.byteString (BS.map (.&. 0b11111) bs)++data Encoding =+ Bech32+ | Bech32m++create_checksum :: Encoding -> BS.ByteString -> BS.ByteString -> BS.ByteString+create_checksum enc hrp dat =+ let pre = hrp_expand hrp <> dat+ pay = toStrict $+ BSB.byteString pre+ <> BSB.byteString "\NUL\NUL\NUL\NUL\NUL\NUL"+ pm = polymod pay `B.xor` case enc of+ Bech32 -> 1+ Bech32m -> _BECH32M_CONST++ code i = (fi (pm `B.shiftR` fi i) .&. 0b11111)++ in BS.map code "\EM\DC4\SI\n\ENQ\NUL" -- BS.pack [25, 20, 15, 10, 5, 0]++verify :: Encoding -> BS.ByteString -> Bool+verify enc b32 = case BS.elemIndexEnd 0x31 b32 of+ Nothing -> False+ Just idx ->+ let (hrp, BU.unsafeDrop 1 -> dat) = BS.splitAt idx b32+ bs = hrp_expand hrp <> as_word5 dat+ in polymod bs == case enc of+ Bech32 -> 1+ Bech32m -> _BECH32M_CONST+
lib/Data/ByteString/Bech32m.hs view
@@ -9,11 +9,13 @@ -- -- The -- [BIP350](https://github.com/bitcoin/bips/blob/master/bip-0350.mediawiki)--- bech32m checksummed base32 encoding, with checksum verification.+-- bech32m checksummed base32 encoding, with decoding and checksum+-- verification. module Data.ByteString.Bech32m (- -- * Encoding+ -- * Encoding and Decoding encode+ , decode -- * Checksum , verify@@ -23,9 +25,10 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Base32 as B32-import Data.ByteString.Base32 (Encoding(..))+import qualified Data.ByteString.Bech32.Internal as BI import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Builder.Extra as BE+import qualified Data.ByteString.Internal as BSI import qualified Data.Char as C (toLower) -- realization for small builders@@ -35,28 +38,50 @@ {-# INLINE toStrict #-} create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString-create_checksum = B32.create_checksum Bech32m+create_checksum = BI.create_checksum BI.Bech32m --- | Encode a base255 human-readable part and input as bech32m.+-- | Encode a base256 human-readable part and input as bech32m. -- -- >>> let Just bech32m = encode "bc" "my string" -- >>> bech32m -- "bc1d4ujqum5wf5kuecwqlxtg" encode- :: BS.ByteString -- ^ base255-encoded human-readable part- -> BS.ByteString -- ^ base255-encoded data part+ :: BS.ByteString -- ^ base256-encoded human-readable part+ -> BS.ByteString -- ^ base256-encoded data part -> Maybe BS.ByteString -- ^ bech32m-encoded bytestring-encode hrp (B32.encode -> dat) = do- guard (B32.valid_hrp hrp)- let check = create_checksum hrp (B32.as_word5 dat)+encode (B8.map C.toLower -> hrp) (B32.encode -> dat) = do+ guard (BI.valid_hrp hrp)+ let check = create_checksum hrp (BI.as_word5 dat) res = toStrict $- BSB.byteString (B8.map C.toLower hrp)+ BSB.byteString hrp <> BSB.word8 49 -- 1 <> BSB.byteString dat- <> BSB.byteString (B32.as_base32 check)+ <> BSB.byteString (BI.as_base32 check) guard (BS.length res < 91) pure res +-- | Decode a bech32m-encoded 'ByteString' into its human-readable and data+-- parts.+--+-- >>> decode "hi1df6x7cnfdcs8wctnyp5x2un9m9ac4f"+-- Just ("hi","jtobin was here")+-- >>> decode "hey1df6x7cnfdcs8wctnyp5x2un9m9ac4f" -- s/hi/hey+-- Nothing+decode+ :: BS.ByteString -- ^ bech23-encoded bytestring+ -> Maybe (BS.ByteString, BS.ByteString) -- ^ (hrp, data less checksum)+decode bs@(BSI.PS _ _ l) = do+ guard (l <= 90)+ guard (verify bs)+ sep <- BS.elemIndexEnd 0x31 bs+ case BS.splitAt sep bs of+ (hrp, raw) -> do+ guard (BI.valid_hrp hrp)+ guard (BS.length raw >= 6)+ (_, BS.dropEnd 6 -> bech32dat) <- BS.uncons raw+ dat <- B32.decode bech32dat+ pure (hrp, dat)+ -- | Verify that a bech32m string has a valid checksum. -- -- >>> verify "bc1d4ujqum5wf5kuecwqlxtg"@@ -66,5 +91,5 @@ verify :: BS.ByteString -- ^ bech32m-encoded bytestring -> Bool-verify = B32.verify Bech32m+verify = BI.verify BI.Bech32m
ppad-bech32.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: ppad-bech32-version: 0.1.2-synopsis: The bech32 and bech32m encodings, per BIPs 173 & 350.+version: 0.2.0+synopsis: bech32 and bech32m encoding/decoding, per BIPs 173 & 350. license: MIT license-file: LICENSE author: Jared Tobin@@ -11,8 +11,8 @@ tested-with: GHC == 9.8.1 extra-doc-files: CHANGELOG description:- The bech32 and bech32m encodings on strict bytestrings, per BIPs 173 &- 350.+ bech32 and bech32m encoding/decoding on strict bytestrings, per BIPs+ 173 & 350. source-repository head type: git@@ -25,6 +25,7 @@ -Wall exposed-modules: Data.ByteString.Base32+ , Data.ByteString.Bech32.Internal , Data.ByteString.Bech32 , Data.ByteString.Bech32m build-depends:
test/Main.hs view
@@ -1,25 +1,39 @@ module Main where +import qualified Data.Char as C import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Bech32 as Bech32+import qualified Data.ByteString.Bech32m as Bech32m+import qualified Data.ByteString.Base32 as B32 import Test.Tasty import qualified Test.Tasty.QuickCheck as Q import qualified Reference.Bech32 as R -data Input = Input BS.ByteString BS.ByteString+newtype BS = BS BS.ByteString deriving (Eq, Show) -instance Q.Arbitrary Input where+data ValidInput = ValidInput BS.ByteString BS.ByteString+ deriving (Eq, Show)++instance Q.Arbitrary ValidInput where arbitrary = do h <- hrp- b <- bytes (83 - BS.length h)- pure (Input h b)+ let l = 83 - BS.length h+ a = l * 5 `quot` 8+ b <- bytes a+ pure (ValidInput h b) +instance Q.Arbitrary BS where+ arbitrary = do+ b <- bytes 1024+ pure (BS b)+ hrp :: Q.Gen BS.ByteString hrp = do l <- Q.chooseInt (1, 83) v <- Q.vectorOf l (Q.choose (33, 126))- pure (BS.pack v)+ pure (B8.map C.toLower (BS.pack v)) bytes :: Int -> Q.Gen BS.ByteString bytes k = do@@ -27,12 +41,46 @@ v <- Q.vectorOf l Q.arbitrary pure (BS.pack v) -matches :: Input -> Bool-matches (Input h b) =+matches_reference :: ValidInput -> Bool+matches_reference (ValidInput h b) = let ref = R.bech32Encode h (R.toBase32 (BS.unpack b)) our = Bech32.encode h b in ref == our +bech32_decode_inverts_encode :: ValidInput -> Bool+bech32_decode_inverts_encode (ValidInput h b) = case Bech32.encode h b of+ Nothing -> error "generated faulty input"+ Just enc -> case Bech32.decode enc of+ Nothing -> False+ Just (h', dat) -> h == h' && b == dat++bech32m_decode_inverts_encode :: ValidInput -> Bool+bech32m_decode_inverts_encode (ValidInput h b) = case Bech32m.encode h b of+ Nothing -> error "generated faulty input"+ Just enc -> case Bech32m.decode enc of+ Nothing -> False+ Just (h', dat) -> h == h' && b == dat++base32_decode_inverts_encode :: BS -> Bool+base32_decode_inverts_encode (BS bs) = case B32.decode (B32.encode bs) of+ Nothing -> False+ Just b -> b == bs+ main :: IO ()-main = defaultMain $- Q.testProperty "encoding matches reference" matches+main = defaultMain $ testGroup "ppad-bech32" [+ testGroup "base32" [+ Q.testProperty "decode . encode ~ id" $+ Q.withMaxSuccess 1000 base32_decode_inverts_encode+ ]+ , testGroup "bech32" [+ Q.testProperty "Bech32.encode ~ R.bech32Encode" $+ Q.withMaxSuccess 1000 matches_reference+ , Q.testProperty "decode . encode ~ id" $+ Q.withMaxSuccess 1000 bech32_decode_inverts_encode+ ]+ , testGroup "bech32m" [+ Q.testProperty "decode . encode ~ id" $+ Q.withMaxSuccess 1000 bech32m_decode_inverts_encode+ ]+ ]+