commit 0559452ec1000ca71597ae7b6521c6e76fde5bc8
parent 1164ff141edfbac279387d804829ee82405f74d5
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 13 Dec 2024 06:33:50 -0330
lib: misc reorg/tweaks
Diffstat:
4 files changed, 44 insertions(+), 52 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -3,7 +3,6 @@
module Main where
import Criterion.Main
-import qualified Data.ByteString.Base32 as Base32
import qualified Data.ByteString.Bech32 as Bech32
main :: IO ()
@@ -12,24 +11,15 @@ main = defaultMain [
]
suite :: Benchmark
-suite = env setup $ \big ->
- bgroup "ppad-bech32" [
- bgroup "base32" [
- bench "base32 120b" $ whnf Base32.encode
- "jtobin was here"
- , bench "base32 128b" $ whnf Base32.encode
- "jtobin was here!"
- , bench "base32 240b" $ whnf Base32.encode
- "jtobin was herejtobin was here"
- , bench "base32 1200b" $ whnf Base32.encode big
- ]
- , bgroup "bech32" [
- bench "bech32 120b" $ nf (Bech32.encode "bc")
- "jtobin was here"
- , bench "bech32 128b" $ nf (Bech32.encode "bc")
- "jtobin was here!"
- ]
+suite =
+ bgroup "ppad-bech32" [
+ bgroup "bech32" [
+ bench "120b" $ nf (Bech32.encode "bc")
+ "jtobin was here"
+ , 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"
]
- where
- setup = pure . mconcat . take 10 $ repeat "jtobin was here"
+ ]
diff --git a/lib/Data/ByteString/Base32.hs b/lib/Data/ByteString/Base32.hs
@@ -8,7 +8,7 @@ module Data.ByteString.Base32 (
, as_word5
, as_bech32
- -- not base32-related, but convenient to put here
+ -- not actually base32-related, but convenient to put here
, Encoding(..)
, create_checksum
, verify_checksum
@@ -48,37 +48,12 @@ bech32_charset :: BS.ByteString
bech32_charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
-- 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
-
- 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)
-
- 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
-
- in BSB.word64LE w64
-
--- 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
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
@@ -143,6 +118,32 @@ encode dat = toStrict (go dat) where
Nothing -> error "impossible, chunk length is 5"
Just (word32be -> w32, fi -> w8) -> arrange w32 w8 <> go etc
+-- 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
+
+ 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)
+
+ 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
+
+ in BSB.word64LE w64
+
-- naive base32 -> word5
as_word5 :: BS.ByteString -> BS.ByteString
as_word5 = BS.map f where
diff --git a/lib/Data/ByteString/Bech32.hs b/lib/Data/ByteString/Bech32.hs
@@ -20,6 +20,7 @@ toStrict = BS.toStrict
verify_checksum :: BS.ByteString -> BS.ByteString -> Bool
verify_checksum = B32.verify_checksum Bech32
+-- XX no need for this to be here
create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString
create_checksum = B32.create_checksum Bech32
diff --git a/ppad-bech32.cabal b/ppad-bech32.cabal
@@ -1,7 +1,7 @@
cabal-version: 3.0
name: ppad-bech32
version: 0.1.0
-synopsis: The bech32m encoding, per BIP350.
+synopsis: The bech32 and bech32m encoding, per BIPs 173 & 350.
license: MIT
license-file: LICENSE
author: Jared Tobin
@@ -11,8 +11,7 @@ build-type: Simple
tested-with: GHC == 9.8.1
extra-doc-files: CHANGELOG
description:
- A pure implementation of bech32m encoding & decoding on strict and
- lazy ByteStrings.
+ BIP173 bech32 & BIP350 bech32m encoding/decoding on strict ByteStrings.
source-repository head
type: git
@@ -23,9 +22,10 @@ library
hs-source-dirs: lib
ghc-options:
-Wall
- exposed-modules:
+ other-modules:
Data.ByteString.Base32
- , Data.ByteString.Bech32
+ exposed-modules:
+ Data.ByteString.Bech32
, Data.ByteString.Bech32m
build-depends:
base >= 4.9 && < 5