commit 6677da490cbe01466cf819e03e874485d0d1b4a8
parent 2db858792e9d818292d80b4fc19eaf6ab99dfb72
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 3 Jan 2025 12:03:04 -0330
lib: better structure
Diffstat:
5 files changed, 127 insertions(+), 99 deletions(-)
diff --git a/lib/Data/ByteString/Base32.hs b/lib/Data/ByteString/Base32.hs
@@ -9,15 +9,6 @@
module Data.ByteString.Base32 (
encode
, decode
- , as_word5
- , as_base32
-
- -- XX put this in another module
- -- not actually base32-related, but convenient to put here
- , Encoding(..)
- , create_checksum
- , verify
- , valid_hrp
) where
import Control.Monad (guard)
@@ -27,7 +18,6 @@ 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.Unsafe as BU
-import qualified Data.Primitive.PrimArray as PA
import Data.Word (Word8, Word32, Word64)
fi :: (Integral a, Num b) => a -> b
@@ -83,7 +73,9 @@ arrange w32 w8 =
{-# INLINE arrange #-}
-- adapted from emilypi's 'base32' library
-encode :: BS.ByteString -> BS.ByteString
+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
@@ -266,7 +258,7 @@ finalize bs
l = BS.length bs
word5 i = BS.elemIndex (fi (BU.unsafeIndex bs i)) bech32_charset
--- length 8 guaranteed
+-- assumes length 8 input
decode_chunk :: BS.ByteString -> Maybe BSB.Builder
decode_chunk bs = do
let word5 i = BS.elemIndex (fi (BU.unsafeIndex bs i)) bech32_charset
@@ -294,78 +286,3 @@ decode_chunk bs = do
pure $ BSB.word32BE w32 <> BSB.word8 w8
--- XX move all of the below to another module
-
-_BECH32M_CONST :: Word32
-_BECH32M_CONST = 0x2bc830a3
-
--- 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
- | l == 0 || l > 83 = False
- | otherwise = BS.all (\b -> (b > 32) && (b < 127)) hrp
- where
- l = BS.length 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
-
diff --git a/lib/Data/ByteString/Bech32.hs b/lib/Data/ByteString/Bech32.hs
@@ -23,7 +23,7 @@ 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 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)
@@ -35,7 +35,7 @@ toStrict = BS.toStrict
{-# 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 base256 human-readable part and input as bech32.
--
@@ -47,13 +47,13 @@ encode
-> 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)
+ guard (BI.valid_hrp hrp)
+ let check = create_checksum hrp (BI.as_word5 dat)
res = toStrict $
BSB.byteString (B8.map C.toLower 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
@@ -66,5 +66,5 @@ encode hrp (B32.encode -> dat) = do
verify
:: BS.ByteString -- ^ bech32-encoded bytestring
-> Bool
-verify = B32.verify Bech32
+verify = BI.verify BI.Bech32
diff --git a/lib/Data/ByteString/Bech32/Internal.hs b/lib/Data/ByteString/Bech32/Internal.hs
@@ -0,0 +1,110 @@
+{-# 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.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
+ | l == 0 || l > 83 = False
+ | otherwise = BS.all (\b -> (b > 32) && (b < 127)) hrp
+ where
+ l = BS.length 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
+
diff --git a/lib/Data/ByteString/Bech32m.hs b/lib/Data/ByteString/Bech32m.hs
@@ -23,7 +23,7 @@ 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 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)
@@ -35,7 +35,7 @@ toStrict = BS.toStrict
{-# 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 base256 human-readable part and input as bech32m.
--
@@ -47,13 +47,13 @@ encode
-> 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)
+ guard (BI.valid_hrp hrp)
+ let check = create_checksum hrp (BI.as_word5 dat)
res = toStrict $
BSB.byteString (B8.map C.toLower 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
@@ -66,5 +66,5 @@ encode hrp (B32.encode -> dat) = do
verify
:: BS.ByteString -- ^ bech32m-encoded bytestring
-> Bool
-verify = B32.verify Bech32m
+verify = BI.verify BI.Bech32m
diff --git a/ppad-bech32.cabal b/ppad-bech32.cabal
@@ -25,6 +25,7 @@ library
-Wall
exposed-modules:
Data.ByteString.Base32
+ , Data.ByteString.Bech32.Internal
, Data.ByteString.Bech32
, Data.ByteString.Bech32m
build-depends:
