Bech32m.hs (2082B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE ViewPatterns #-} 3 4 -- | 5 -- Module: Data.ByteString.Bech32m 6 -- Copyright: (c) 2024 Jared Tobin 7 -- License: MIT 8 -- Maintainer: Jared Tobin <jared@ppad.tech> 9 -- 10 -- The 11 -- [BIP350](https://github.com/bitcoin/bips/blob/master/bip-0350.mediawiki) 12 -- bech32m checksummed base32 encoding, with checksum verification. 13 14 module Data.ByteString.Bech32m ( 15 -- * Encoding 16 encode 17 18 -- * Checksum 19 , verify 20 ) where 21 22 import Control.Monad (guard) 23 import qualified Data.ByteString as BS 24 import qualified Data.ByteString.Char8 as B8 25 import qualified Data.ByteString.Base32 as B32 26 import Data.ByteString.Base32 (Encoding(..)) 27 import qualified Data.ByteString.Builder as BSB 28 import qualified Data.ByteString.Builder.Extra as BE 29 import qualified Data.Char as C (toLower) 30 31 -- realization for small builders 32 toStrict :: BSB.Builder -> BS.ByteString 33 toStrict = BS.toStrict 34 . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty 35 {-# INLINE toStrict #-} 36 37 create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString 38 create_checksum = B32.create_checksum Bech32m 39 40 -- | Encode a base256 human-readable part and input as bech32m. 41 -- 42 -- >>> let Just bech32m = encode "bc" "my string" 43 -- >>> bech32m 44 -- "bc1d4ujqum5wf5kuecwqlxtg" 45 encode 46 :: BS.ByteString -- ^ base256-encoded human-readable part 47 -> BS.ByteString -- ^ base256-encoded data part 48 -> Maybe BS.ByteString -- ^ bech32m-encoded bytestring 49 encode hrp (B32.encode -> dat) = do 50 guard (B32.valid_hrp hrp) 51 let check = create_checksum hrp (B32.as_word5 dat) 52 res = toStrict $ 53 BSB.byteString (B8.map C.toLower hrp) 54 <> BSB.word8 49 -- 1 55 <> BSB.byteString dat 56 <> BSB.byteString (B32.as_base32 check) 57 guard (BS.length res < 91) 58 pure res 59 60 -- | Verify that a bech32m string has a valid checksum. 61 -- 62 -- >>> verify "bc1d4ujqum5wf5kuecwqlxtg" 63 -- True 64 -- >>> verify "bc1d4ujquw5wf5kuecwqlxtg" -- s/m/w 65 -- False 66 verify 67 :: BS.ByteString -- ^ bech32m-encoded bytestring 68 -> Bool 69 verify = B32.verify Bech32m 70