From 303dc5746a0c17d2e1d7b3ecb54955c18a0fa44a Mon Sep 17 00:00:00 2001 From: Mikhail Kilianovski Date: Thu, 15 Mar 2018 16:55:17 +0200 Subject: [PATCH 1/3] Refactor `Maybe` to `Either DecodeError` --- ref/haskell/src/Codec/Binary/Bech32.hs | 57 ++++++++++++++++++-------- ref/haskell/test/Spec.hs | 20 +++++---- 2 files changed, 53 insertions(+), 24 deletions(-) diff --git a/ref/haskell/src/Codec/Binary/Bech32.hs b/ref/haskell/src/Codec/Binary/Bech32.hs index 23e58a5..4033e24 100644 --- a/ref/haskell/src/Codec/Binary/Bech32.hs +++ b/ref/haskell/src/Codec/Binary/Bech32.hs @@ -1,5 +1,7 @@ module Codec.Binary.Bech32 - ( bech32Encode + ( DecodeError(..) + + , bech32Encode , bech32Decode , toBase32 , toBase256 @@ -12,13 +14,13 @@ module Codec.Binary.Bech32 import Control.Monad (guard) import qualified Data.Array as Arr -import Data.Bits (Bits, unsafeShiftL, unsafeShiftR, (.&.), (.|.), xor, testBit) +import Data.Bits (Bits, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Data.Char (toLower, toUpper) import Data.Foldable (foldl') import Data.Functor.Identity (Identity, runIdentity) -import Data.Ix (Ix(..)) +import Data.Ix (Ix (..)) import Data.Word (Word8) type HRP = BS.ByteString @@ -29,7 +31,7 @@ type Data = [Word8] (.<<.) = unsafeShiftL newtype Word5 = UnsafeWord5 Word8 - deriving (Eq, Ord) + deriving (Eq, Ord, Show) instance Ix Word5 where range (UnsafeWord5 m, UnsafeWord5 n) = map UnsafeWord5 $ range (m, n) @@ -79,32 +81,47 @@ bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1 bech32Encode :: HRP -> [Word5] -> Maybe BS.ByteString bech32Encode hrp dat = do - guard $ checkHRP hrp + guard $ validHRP hrp let dat' = dat ++ bech32CreateChecksum hrp dat rest = map (charset Arr.!) dat' result = BSC.concat [BSC.map toLower hrp, BSC.pack "1", BSC.pack rest] guard $ BS.length result <= 90 return result -checkHRP :: BS.ByteString -> Bool -checkHRP hrp = not (BS.null hrp) && BS.all (\char -> char >= 33 && char <= 126) hrp +validHRP :: BS.ByteString -> Bool +validHRP hrp = not (BS.null hrp) && BS.all (\char -> char >= 33 && char <= 126) hrp + +data DecodeError = + Bech32StringLengthExceeded + | CaseInconsistency + | TooShortDataPart + | InvalidHRP + | ChecksumVerificationFail + | InvalidCharsetMap + deriving (Show, Eq) -bech32Decode :: BS.ByteString -> Maybe (HRP, [Word5]) +bech32Decode :: BS.ByteString -> Either DecodeError (HRP, [Word5]) bech32Decode bech32 = do - guard $ BS.length bech32 <= 90 - guard $ BSC.map toUpper bech32 == bech32 || BSC.map toLower bech32 == bech32 + verify Bech32StringLengthExceeded $ BS.length bech32 <= 90 + verify CaseInconsistency $ validCase bech32 let (hrp, dat) = BSC.breakEnd (== '1') $ BSC.map toLower bech32 - guard $ BS.length dat >= 6 - hrp' <- BSC.stripSuffix (BSC.pack "1") hrp - guard $ checkHRP hrp' - dat' <- mapM charsetMap $ BSC.unpack dat - guard $ bech32VerifyChecksum hrp' dat' + verify TooShortDataPart $ BS.length dat >= 6 + hrp' <- maybeToRight InvalidHRP $ BSC.stripSuffix (BSC.pack "1") hrp + verify InvalidHRP $ validHRP hrp' + dat' <- maybeToRight InvalidCharsetMap . mapM charsetMap $ BSC.unpack dat + verify ChecksumVerificationFail $ bech32VerifyChecksum hrp' dat' return (hrp', take (BS.length dat - 6) dat') + where + verify :: a -> Bool -> Either a () + verify _ True = Right () + verify v False = Left v + validCase :: BS.ByteString -> Bool + validCase b32 = BSC.map toUpper b32 == b32 || BSC.map toLower b32 == b32 type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]] yesPadding :: Pad Identity -yesPadding _ 0 _ result = return result +yesPadding _ 0 _ result = return result yesPadding _ _ padValue result = return $ [padValue] : result {-# INLINE yesPadding #-} @@ -146,7 +163,7 @@ segwitCheck witver witprog = segwitDecode :: HRP -> BS.ByteString -> Maybe (Word8, Data) segwitDecode hrp addr = do - (hrp', dat) <- bech32Decode addr + (hrp', dat) <- rightToMaybe $ bech32Decode addr guard $ (hrp == hrp') && not (null dat) let (UnsafeWord5 witver : datBase32) = dat decoded <- toBase256 datBase32 @@ -157,3 +174,9 @@ segwitEncode :: HRP -> Word8 -> Data -> Maybe BS.ByteString segwitEncode hrp witver witprog = do guard $ segwitCheck witver witprog bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog + +rightToMaybe :: Either l r -> Maybe r +rightToMaybe = either (const Nothing) Just + +maybeToRight :: l -> Maybe r -> Either l r +maybeToRight l = maybe (Left l) Right diff --git a/ref/haskell/test/Spec.hs b/ref/haskell/test/Spec.hs index 964571d..30f74c6 100644 --- a/ref/haskell/test/Spec.hs +++ b/ref/haskell/test/Spec.hs @@ -1,12 +1,14 @@ +import Codec.Binary.Bech32 (DecodeError (..), bech32Decode, bech32Encode, segwitDecode, + segwitEncode, word5) import Control.Monad (forM_) import Data.Bits (xor) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as BSC import Data.Char (toLower) -import Data.Maybe (isNothing, isJust) +import Data.Either (isLeft) +import Data.Maybe (isJust, isNothing) import Data.Word (Word8) -import Codec.Binary.Bech32 (bech32Encode, bech32Decode, segwitEncode, segwitDecode, word5) import Test.Tasty import Test.Tasty.HUnit @@ -74,19 +76,19 @@ tests :: TestTree tests = testGroup "Tests" [ testCase "Checksums" $ forM_ validChecksums $ \checksum -> do case bech32Decode checksum of - Nothing -> assertFailure (show checksum) - Just (resultHRP, resultData) -> do + Left err -> assertFailure (show checksum ++ ", " ++ show err) + Right (resultHRP, resultData) -> do -- test that a corrupted checksum fails decoding. let (hrp, rest) = BSC.breakEnd (== '1') checksum Just (first, rest') = BS.uncons rest checksumCorrupted = (hrp `BS.snoc` (first `xor` 1)) `BS.append` rest' - assertBool (show checksum ++ " corrupted") $ isNothing (bech32Decode checksumCorrupted) + assertBool (show checksum ++ " corrupted") $ isLeft (bech32Decode checksumCorrupted) -- test that re-encoding the decoded checksum results in the same checksum. let checksumEncoded = bech32Encode resultHRP resultData expectedChecksum = Just $ BSC.map toLower checksum assertEqual (show checksum ++ " re-encode") expectedChecksum checksumEncoded , testCase "Invalid checksums" $ forM_ invalidChecksums $ - \checksum -> assertBool (show checksum) (isNothing $ bech32Decode checksum) + \checksum -> assertBool (show checksum) (isLeft $ bech32Decode checksum) , testCase "Addresses" $ forM_ validAddresses $ \(address, hexscript) -> do let address' = BSC.map toLower address hrp = BSC.take 2 address' @@ -110,8 +112,12 @@ tests = testGroup "Tests" assertBool "segwit prog len version != 0" $ isNothing $ segwitEncode (BSC.pack "bc") 1 (replicate 41 1) assertBool "empty HRP encode" $ isNothing $ bech32Encode (BSC.pack "") [] - assertBool "empty HRP decode" $ isNothing $ bech32Decode (BSC.pack "10a06t8") + assertBool "empty HRP decode" $ isError InvalidHRP $ bech32Decode (BSC.pack "10a06t8") assertEqual "hrp lowercased" (Just $ BSC.pack "hrp1g9xj8m") (bech32Encode (BSC.pack "HRP") []) ] + +isError :: DecodeError -> Either DecodeError a -> Bool +isError e' (Left e) = e == e' +isError _ _ = False From d4cbb658e88cb2888d39ac03a384a01b50646001 Mon Sep 17 00:00:00 2001 From: Mikhail Kilianovski Date: Tue, 20 Mar 2018 17:55:05 +0200 Subject: [PATCH 2/3] Refactor `Maybe` to `Either EncodeError` --- ref/haskell/src/Codec/Binary/Bech32.hs | 24 ++++++++++++++++-------- ref/haskell/test/Spec.hs | 14 +++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/ref/haskell/src/Codec/Binary/Bech32.hs b/ref/haskell/src/Codec/Binary/Bech32.hs index 4033e24..c71b845 100644 --- a/ref/haskell/src/Codec/Binary/Bech32.hs +++ b/ref/haskell/src/Codec/Binary/Bech32.hs @@ -1,5 +1,7 @@ module Codec.Binary.Bech32 - ( DecodeError(..) + ( + DecodeError(..) + , EncodeError(..) , bech32Encode , bech32Decode @@ -79,13 +81,18 @@ bech32CreateChecksum hrp dat = [word5 (polymod .>>. i) | i <- [25,20..0]] bech32VerifyChecksum :: HRP -> [Word5] -> Bool bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1 -bech32Encode :: HRP -> [Word5] -> Maybe BS.ByteString +data EncodeError = + ResultStringLengthExceeded + | InvalidHumanReadablePart + deriving (Show, Eq) + +bech32Encode :: HRP -> [Word5] -> Either EncodeError BS.ByteString bech32Encode hrp dat = do - guard $ validHRP hrp + verify InvalidHumanReadablePart $ validHRP hrp let dat' = dat ++ bech32CreateChecksum hrp dat rest = map (charset Arr.!) dat' result = BSC.concat [BSC.map toLower hrp, BSC.pack "1", BSC.pack rest] - guard $ BS.length result <= 90 + verify ResultStringLengthExceeded $ BS.length result <= 90 return result validHRP :: BS.ByteString -> Bool @@ -112,9 +119,6 @@ bech32Decode bech32 = do verify ChecksumVerificationFail $ bech32VerifyChecksum hrp' dat' return (hrp', take (BS.length dat - 6) dat') where - verify :: a -> Bool -> Either a () - verify _ True = Right () - verify v False = Left v validCase :: BS.ByteString -> Bool validCase b32 = BSC.map toUpper b32 == b32 || BSC.map toLower b32 == b32 @@ -173,10 +177,14 @@ segwitDecode hrp addr = do segwitEncode :: HRP -> Word8 -> Data -> Maybe BS.ByteString segwitEncode hrp witver witprog = do guard $ segwitCheck witver witprog - bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog + rightToMaybe $ bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog rightToMaybe :: Either l r -> Maybe r rightToMaybe = either (const Nothing) Just maybeToRight :: l -> Maybe r -> Either l r maybeToRight l = maybe (Left l) Right + +verify :: a -> Bool -> Either a () +verify _ True = Right () +verify v False = Left v diff --git a/ref/haskell/test/Spec.hs b/ref/haskell/test/Spec.hs index 30f74c6..ac1511f 100644 --- a/ref/haskell/test/Spec.hs +++ b/ref/haskell/test/Spec.hs @@ -1,5 +1,5 @@ -import Codec.Binary.Bech32 (DecodeError (..), bech32Decode, bech32Encode, segwitDecode, - segwitEncode, word5) +import Codec.Binary.Bech32 (DecodeError (..), EncodeError (..), bech32Decode, bech32Encode, + segwitDecode, segwitEncode, word5) import Control.Monad (forM_) import Data.Bits (xor) import qualified Data.ByteString as BS @@ -85,7 +85,7 @@ tests = testGroup "Tests" assertBool (show checksum ++ " corrupted") $ isLeft (bech32Decode checksumCorrupted) -- test that re-encoding the decoded checksum results in the same checksum. let checksumEncoded = bech32Encode resultHRP resultData - expectedChecksum = Just $ BSC.map toLower checksum + expectedChecksum = Right $ BSC.map toLower checksum assertEqual (show checksum ++ " re-encode") expectedChecksum checksumEncoded , testCase "Invalid checksums" $ forM_ invalidChecksums $ \checksum -> assertBool (show checksum) (isLeft $ bech32Decode checksum) @@ -101,7 +101,7 @@ tests = testGroup "Tests" assertBool (show address) (isNothing $ segwitDecode (BSC.pack "bc") address) assertBool (show address) (isNothing $ segwitDecode (BSC.pack "tb") address) , testCase "More Encoding/Decoding Cases" $ do - assertBool "length > 90" $ isNothing $ + assertBool "length > 90" $ isError ResultStringLengthExceeded $ bech32Encode (BSC.pack "bc") (replicate 82 (word5 (1::Word8))) assertBool "segwit version bounds" $ isNothing $ segwitEncode (BSC.pack "bc") 17 [] @@ -111,13 +111,13 @@ tests = testGroup "Tests" segwitEncode (BSC.pack "bc") 1 (replicate 30 1) assertBool "segwit prog len version != 0" $ isNothing $ segwitEncode (BSC.pack "bc") 1 (replicate 41 1) - assertBool "empty HRP encode" $ isNothing $ bech32Encode (BSC.pack "") [] + assertBool "empty HRP encode" $ isError InvalidHumanReadablePart $ bech32Encode (BSC.pack "") [] assertBool "empty HRP decode" $ isError InvalidHRP $ bech32Decode (BSC.pack "10a06t8") assertEqual "hrp lowercased" - (Just $ BSC.pack "hrp1g9xj8m") + (Right $ BSC.pack "hrp1g9xj8m") (bech32Encode (BSC.pack "HRP") []) ] -isError :: DecodeError -> Either DecodeError a -> Bool +isError :: Eq a => a -> Either a b -> Bool isError e' (Left e) = e == e' isError _ _ = False From c31bf7689495457d9fcf2d81ecc81f4d4ab77b38 Mon Sep 17 00:00:00 2001 From: Russell O'Connor Date: Wed, 17 Nov 2021 13:11:49 -0500 Subject: [PATCH 3/3] Update Haskell reference code to support Bech32m. --- ref/haskell/src/Codec/Binary/Bech32.hs | 50 ++++++----- ref/haskell/test/Spec.hs | 114 ++++++++++++++++++------- 2 files changed, 112 insertions(+), 52 deletions(-) diff --git a/ref/haskell/src/Codec/Binary/Bech32.hs b/ref/haskell/src/Codec/Binary/Bech32.hs index c71b845..87fd746 100644 --- a/ref/haskell/src/Codec/Binary/Bech32.hs +++ b/ref/haskell/src/Codec/Binary/Bech32.hs @@ -2,9 +2,11 @@ module Codec.Binary.Bech32 ( DecodeError(..) , EncodeError(..) + , Bech32Type(..) , bech32Encode , bech32Decode + , bech32Spec , toBase32 , toBase256 , segwitEncode @@ -72,24 +74,24 @@ bech32Polymod values = foldl' go 1 values .&. 0x3fffffff bech32HRPExpand :: HRP -> [Word5] bech32HRPExpand hrp = map (UnsafeWord5 . (.>>. 5)) (BS.unpack hrp) ++ [UnsafeWord5 0] ++ map word5 (BS.unpack hrp) -bech32CreateChecksum :: HRP -> [Word5] -> [Word5] -bech32CreateChecksum hrp dat = [word5 (polymod .>>. i) | i <- [25,20..0]] +bech32CreateChecksum :: Word -> HRP -> [Word5] -> [Word5] +bech32CreateChecksum residue hrp dat = [word5 (polymod .>>. i) | i <- [25,20..0]] where values = bech32HRPExpand hrp ++ dat - polymod = bech32Polymod (values ++ map UnsafeWord5 [0, 0, 0, 0, 0, 0]) `xor` 1 + polymod = bech32Polymod (values ++ map UnsafeWord5 [0, 0, 0, 0, 0, 0]) `xor` residue -bech32VerifyChecksum :: HRP -> [Word5] -> Bool -bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1 +bech32Residue :: HRP -> [Word5] -> Word +bech32Residue hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) data EncodeError = ResultStringLengthExceeded | InvalidHumanReadablePart deriving (Show, Eq) -bech32Encode :: HRP -> [Word5] -> Either EncodeError BS.ByteString -bech32Encode hrp dat = do +bech32Encode :: Word -> HRP -> [Word5] -> Either EncodeError BS.ByteString +bech32Encode residue hrp dat = do verify InvalidHumanReadablePart $ validHRP hrp - let dat' = dat ++ bech32CreateChecksum hrp dat + let dat' = dat ++ bech32CreateChecksum residue hrp dat rest = map (charset Arr.!) dat' result = BSC.concat [BSC.map toLower hrp, BSC.pack "1", BSC.pack rest] verify ResultStringLengthExceeded $ BS.length result <= 90 @@ -107,7 +109,7 @@ data DecodeError = | InvalidCharsetMap deriving (Show, Eq) -bech32Decode :: BS.ByteString -> Either DecodeError (HRP, [Word5]) +bech32Decode :: BS.ByteString -> Either DecodeError (Word, HRP, [Word5]) bech32Decode bech32 = do verify Bech32StringLengthExceeded $ BS.length bech32 <= 90 verify CaseInconsistency $ validCase bech32 @@ -116,8 +118,8 @@ bech32Decode bech32 = do hrp' <- maybeToRight InvalidHRP $ BSC.stripSuffix (BSC.pack "1") hrp verify InvalidHRP $ validHRP hrp' dat' <- maybeToRight InvalidCharsetMap . mapM charsetMap $ BSC.unpack dat - verify ChecksumVerificationFail $ bech32VerifyChecksum hrp' dat' - return (hrp', take (BS.length dat - 6) dat') + let residue = bech32Residue hrp' dat' + return (residue, hrp', take (BS.length dat - 6) dat') where validCase :: BS.ByteString -> Bool validCase b32 = BSC.map toUpper b32 == b32 || BSC.map toLower b32 == b32 @@ -158,26 +160,34 @@ toBase32 dat = map word5 $ runIdentity $ convertBits (map fromIntegral dat) 8 5 toBase256 :: [Word5] -> Maybe [Word8] toBase256 dat = fmap (map fromIntegral) $ convertBits (map fromWord5 dat) 5 8 noPadding -segwitCheck :: Word8 -> Data -> Bool -segwitCheck witver witprog = - witver <= 16 && +data Bech32Type = Bech32 + | Bech32m + +bech32Spec :: Bech32Type -> Word +bech32Spec Bech32 = 1 +bech32Spec Bech32m = 0x2bc830a3 + +segwitCheck :: Word8 -> Data -> Maybe Bech32Type +segwitCheck witver witprog = do + guard $ witver <= 16 if witver == 0 - then length witprog == 20 || length witprog == 32 - else length witprog >= 2 && length witprog <= 40 + then guard (length witprog == 20 || length witprog == 32) >> return Bech32 + else guard (length witprog >= 2 && length witprog <= 40) >> return Bech32m segwitDecode :: HRP -> BS.ByteString -> Maybe (Word8, Data) segwitDecode hrp addr = do - (hrp', dat) <- rightToMaybe $ bech32Decode addr + (residue, hrp', dat) <- rightToMaybe $ bech32Decode addr guard $ (hrp == hrp') && not (null dat) let (UnsafeWord5 witver : datBase32) = dat decoded <- toBase256 datBase32 - guard $ segwitCheck witver decoded + b32type <- segwitCheck witver decoded + guard $ bech32Spec b32type == residue return (witver, decoded) segwitEncode :: HRP -> Word8 -> Data -> Maybe BS.ByteString segwitEncode hrp witver witprog = do - guard $ segwitCheck witver witprog - rightToMaybe $ bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog + b32type <- segwitCheck witver witprog + rightToMaybe $ bech32Encode (bech32Spec b32type) hrp $ UnsafeWord5 witver : toBase32 witprog rightToMaybe :: Either l r -> Maybe r rightToMaybe = either (const Nothing) Just diff --git a/ref/haskell/test/Spec.hs b/ref/haskell/test/Spec.hs index ac1511f..1896bc3 100644 --- a/ref/haskell/test/Spec.hs +++ b/ref/haskell/test/Spec.hs @@ -1,4 +1,5 @@ -import Codec.Binary.Bech32 (DecodeError (..), EncodeError (..), bech32Decode, bech32Encode, +import Codec.Binary.Bech32 (DecodeError (..), EncodeError (..), Bech32Type(..), + bech32Decode, bech32Encode, bech32Spec, segwitDecode, segwitEncode, word5) import Control.Monad (forM_) import Data.Bits (xor) @@ -6,7 +7,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as BSC import Data.Char (toLower) -import Data.Either (isLeft) import Data.Maybe (isJust, isNothing) import Data.Word (Word8) import Test.Tasty @@ -15,38 +15,68 @@ import Test.Tasty.HUnit main :: IO () main = defaultMain tests -validChecksums :: [BS.ByteString] -validChecksums = map BSC.pack - [ "A12UEL5L" - , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs" - , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw" - , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j" - , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w" - ] +validChecksums :: [(Bech32Type, BS.ByteString)] +validChecksums = [(b32type, BSC.pack string) + | (b32type, string) <- + [ (Bech32, "A12UEL5L") + , (Bech32, "a12uel5l") + , (Bech32, "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs") + , (Bech32, "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw") + , (Bech32, "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j") + , (Bech32, "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w") + , (Bech32m, "A1LQFN3A") + , (Bech32m, "a1lqfn3a") + , (Bech32m, "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11sg7hg6") + , (Bech32m, "abcdef1l7aum6echk45nj3s0wdvt2fg8x9yrzpqzd3ryx") + , (Bech32m, "11llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllludsr8") + , (Bech32m, "split1checkupstagehandshakeupstreamerranterredcaperredlc445v") + ] ] -invalidChecksums :: [BS.ByteString] -invalidChecksums = map BSC.pack - [ " 1nwldj5" - , "\DEL1axkwrx" - , "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx" - , "pzry9x0s0muk" - , "1pzry9x0s0muk" - , "x1b4n0q5v" - , "li1dgmt3" - , "de1lg7wt\xFF" - ] +invalidChecksums :: [(Bech32Type, BS.ByteString)] +invalidChecksums = [(b32type, BSC.pack string) + | (b32type, string) <- + [ (Bech32, " 1nwldj5") + , (Bech32, "\DEL1axkwrx") + , (Bech32, "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx") + , (Bech32, "pzry9x0s0muk") + , (Bech32, "1pzry9x0s0muk") + , (Bech32, "x1b4n0q5v") + , (Bech32, "li1dgmt3") + , (Bech32, "de1lg7wt\xFF") + , (Bech32, "A1G7SGD8") + , (Bech32, "10a06t8") + , (Bech32, "1qzzfhee") + , (Bech32m, " 1xj0phk") + , (Bech32m, "\x79" ++ "1g6xzxy") + , (Bech32m, "\x80" ++ "1vctc34") + , (Bech32m, "an84characterslonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11d6pts4") + , (Bech32m, "qyrz8wqd2c9m") + , (Bech32m, "1qyrz8wqd2c9m") + , (Bech32m, "y1b0jsk6g") + , (Bech32m, "lt1igcx5c0") + , (Bech32m, "in1muywd") + , (Bech32m, "mm1crxm3i") + , (Bech32m, "au1s5cgom") + , (Bech32m, "M1VUXWEZ") + , (Bech32m, "16plkw9") + , (Bech32m, "1p2gdwpf") + ] ] validAddresses :: [(BS.ByteString, BS.ByteString)] validAddresses = map mapTuple [ ("BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4", "0014751e76e8199196d454941c45d1b3a323f1433bd6") , ("tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7" ,"00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262") - , ("bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7k7grplx" + , ("bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kt5nd6y" ,"5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6") - , ("BC1SW50QA3JX3S", "6002751e") - , ("bc1zw508d6qejxtdg4y5r3zarvaryvg6kdaj", "5210751e76e8199196d454941c45d1b3a323") + , ("BC1SW50QGDZ25J", "6002751e") + , ("bc1zw508d6qejxtdg4y5r3zarvaryvaxxpcs", "5210751e76e8199196d454941c45d1b3a323") , ("tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy" ,"0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433") + , ("tb1pqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesf3hn0c" + ,"5120000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433") + , ("bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqzk5jj0" + ,"512079be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798") ] where mapTuple (a, b) = (BSC.pack a, BSC.pack b) @@ -62,6 +92,20 @@ invalidAddresses = map BSC.pack , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sL5k7" , "bc1zw508d6qejxtdg4y5r3zarvaryvqyzf3du" , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3pjxtptv" + , "tc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq5zuyut" + , "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqh2y7hd" + , "tb1z0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqglt7rf" + , "BC1S0XLXVLHEMJA6C4DQV22UAPCTQUPFHLXM9H8Z3K2E72Q4K9HCZ7VQ54WELL" + , "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kemeawh" + , "tb1q0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq24jc47" + , "bc1p38j9r5y49hruaue7wxjce0updqjuyyx0kh56v8s25huc6995vvpql3jow4" + , "BC130XLXVLHEMJA6C4DQV22UAPCTQUPFHLXM9H8Z3K2E72Q4K9HCZ7VQ7ZWS8R" + , "bc1pw5dgrnzv" + , "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7v8n0nx0muaewav253zgeav" + , "BC1QR508D6QEJXTDG4Y5R3ZARVARYV98GJ9P" + , "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq47Zagq" + , "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7v07qwwzcrf" + , "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vpggkg4j" , "bc1gmk9yu" ] @@ -74,21 +118,23 @@ segwitScriptPubkey witver witprog = BS.pack $ witver' : (fromIntegral $ length w tests :: TestTree tests = testGroup "Tests" - [ testCase "Checksums" $ forM_ validChecksums $ \checksum -> do + [ testCase "Checksums" $ forM_ validChecksums $ \(b32type, checksum) -> do + let spec = bech32Spec b32type case bech32Decode checksum of Left err -> assertFailure (show checksum ++ ", " ++ show err) - Right (resultHRP, resultData) -> do + Right (residue, resultHRP, resultData) -> do + assertEqual (show checksum ++ " spec") spec residue -- test that a corrupted checksum fails decoding. let (hrp, rest) = BSC.breakEnd (== '1') checksum Just (first, rest') = BS.uncons rest checksumCorrupted = (hrp `BS.snoc` (first `xor` 1)) `BS.append` rest' - assertBool (show checksum ++ " corrupted") $ isLeft (bech32Decode checksumCorrupted) + assertBool (show checksum ++ " corrupted") $ isCorrupted spec (bech32Decode checksumCorrupted) -- test that re-encoding the decoded checksum results in the same checksum. - let checksumEncoded = bech32Encode resultHRP resultData + let checksumEncoded = bech32Encode spec resultHRP resultData expectedChecksum = Right $ BSC.map toLower checksum assertEqual (show checksum ++ " re-encode") expectedChecksum checksumEncoded , testCase "Invalid checksums" $ forM_ invalidChecksums $ - \checksum -> assertBool (show checksum) (isLeft $ bech32Decode checksum) + \(b32type, checksum) -> assertBool (show checksum) $ isCorrupted (bech32Spec b32type) (bech32Decode checksum) , testCase "Addresses" $ forM_ validAddresses $ \(address, hexscript) -> do let address' = BSC.map toLower address hrp = BSC.take 2 address' @@ -102,7 +148,7 @@ tests = testGroup "Tests" assertBool (show address) (isNothing $ segwitDecode (BSC.pack "tb") address) , testCase "More Encoding/Decoding Cases" $ do assertBool "length > 90" $ isError ResultStringLengthExceeded $ - bech32Encode (BSC.pack "bc") (replicate 82 (word5 (1::Word8))) + bech32Encode 1 (BSC.pack "bc") (replicate 82 (word5 (1::Word8))) assertBool "segwit version bounds" $ isNothing $ segwitEncode (BSC.pack "bc") 17 [] assertBool "segwit prog len version 0" $ isNothing $ @@ -111,13 +157,17 @@ tests = testGroup "Tests" segwitEncode (BSC.pack "bc") 1 (replicate 30 1) assertBool "segwit prog len version != 0" $ isNothing $ segwitEncode (BSC.pack "bc") 1 (replicate 41 1) - assertBool "empty HRP encode" $ isError InvalidHumanReadablePart $ bech32Encode (BSC.pack "") [] + assertBool "empty HRP encode" $ isError InvalidHumanReadablePart $ bech32Encode 1 (BSC.pack "") [] assertBool "empty HRP decode" $ isError InvalidHRP $ bech32Decode (BSC.pack "10a06t8") assertEqual "hrp lowercased" (Right $ BSC.pack "hrp1g9xj8m") - (bech32Encode (BSC.pack "HRP") []) + (bech32Encode 1 (BSC.pack "HRP") []) ] isError :: Eq a => a -> Either a b -> Bool isError e' (Left e) = e == e' isError _ _ = False + +isCorrupted :: Word -> Either x (Word, y, z) -> Bool +isCorrupted _ (Left _) = True +isCorrupted spec (Right (resultSpec, _, _)) = spec /= resultSpec