haskoin-core 0.20.4 → 0.20.5

raw patch · 4 files changed

+166/−68 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• haskoin-core.cabal +3/−3
• src/Haskoin/Address/Bech32.hs +40/−23
• test/Haskoin/Address/Bech32Spec.hs +119/−42

@@ -4,6 +4,10 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.20.5+### Added+- Support Bech32m address format for Taproot.+ ## 0.20.4 ### Fixed - Add missing case for witness version.

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: d57876572e143601ab9185c42f47f703460c4e8396b846f805068a5cff8fec3e+-- hash: 83e95434961483bbb306908fbc61269ebec705003a8994ca0a8a04d1e3f7de50  name:           haskoin-core-version:        0.20.4+version:        0.20.5 synopsis:       Bitcoin & Bitcoin Cash library for Haskell description:    Please see the README on GitHub at <https://github.com/haskoin/haskoin-core#readme> category:       Bitcoin, Finance, Network

@@ -1,3 +1,4 @@+{-# LANGUAGE MultiWayIf        #-} {-# LANGUAGE OverloadedStrings #-} {-| Module      : Haskoin.Address.Base58@@ -14,6 +15,8 @@     ( -- * Bech32       HRP     , Bech32+    , Bech32Encoding(..)+    , bech32Const     , Data     , bech32Encode     , bech32Decode@@ -41,6 +44,9 @@ import qualified Data.Text.Encoding    as E import           Data.Word             (Word8) +data Bech32Encoding = Bech32 | Bech32m+   deriving (Eq, Show, Ord, Enum)+ -- | Bech32 human-readable string. type Bech32 = Text @@ -110,17 +116,25 @@   where     hrpBytes = B.unpack $ E.encodeUtf8 hrp --- | Calculate checksum for a string of five-bit words.-bech32CreateChecksum :: HRP -> [Word5] -> [Word5]-bech32CreateChecksum hrp dat = [word5 (polymod .>>. i) | i <- [25,20 .. 0]]+bech32Const :: Bech32Encoding -> Word+bech32Const Bech32  = 0x00000001+bech32Const Bech32m = 0x2bc830a3++-- | Calculate Bech32 checksum for a string of five-bit words.+bech32CreateChecksum :: Bech32Encoding -> HRP -> [Word5] -> [Word5]+bech32CreateChecksum enc 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+    w5 = values ++ map UnsafeWord5 [0, 0, 0, 0, 0, 0]+    polymod = bech32Polymod w5 `xor` bech32Const enc --- | Verify checksum for a human-readable part and string of five-bit words.-bech32VerifyChecksum :: HRP -> [Word5] -> Bool-bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1+-- | Verify Bech32 checksum for a human-readable part and string of five-bit words.+bech32VerifyChecksum :: HRP -> [Word5] -> Maybe Bech32Encoding+bech32VerifyChecksum hrp dat =+  let poly = bech32Polymod (bech32HRPExpand hrp ++ dat)+  in if | poly == bech32Const Bech32  -> Just Bech32+        | poly == bech32Const Bech32m -> Just Bech32m+        | otherwise                   -> Nothing  -- | Maximum length of a Bech32 result. maxBech32Length :: Int@@ -129,10 +143,10 @@ -- | Encode string of five-bit words into 'Bech32' using a provided -- human-readable part. Can fail if 'HRP' is invalid or result would be longer -- than 90 characters.-bech32Encode :: HRP -> [Word5] -> Maybe Bech32-bech32Encode hrp dat = do+bech32Encode :: Bech32Encoding -> HRP -> [Word5] -> Maybe Bech32+bech32Encode enc hrp dat = do     guard $ checkHRP hrp-    let dat' = dat ++ bech32CreateChecksum (T.toLower hrp) dat+    let dat' = dat ++ bech32CreateChecksum enc (T.toLower hrp) dat         rest = map (charset !) dat'         result = T.concat [T.toLower hrp, T.pack "1", T.pack rest]     guard $ T.length result <= maxBech32Length@@ -140,11 +154,12 @@  -- | Check that human-readable part is valid for a 'Bech32' string. checkHRP :: HRP -> Bool-checkHRP hrp = not (T.null hrp) && T.all (\char -> char >= '\x21' && char <= '\x7e') hrp+checkHRP hrp = not (T.null hrp) &&+               T.all (\char -> char >= '\x21' && char <= '\x7e') hrp  -- | Decode human-readable 'Bech32' string into a human-readable part and a -- string of five-bit words.-bech32Decode :: Bech32 -> Maybe (HRP, [Word5])+bech32Decode :: Bech32 -> Maybe (Bech32Encoding, HRP, [Word5]) bech32Decode bech32 = do     guard $ T.length bech32 <= maxBech32Length     guard $ T.toUpper bech32 == bech32 || lowerBech32 == bech32@@ -153,8 +168,8 @@     hrp' <- T.stripSuffix "1" hrp     guard $ checkHRP hrp'     dat' <- mapM charsetMap $ T.unpack dat-    guard $ bech32VerifyChecksum hrp' dat'-    return (hrp', take (T.length dat - 6) dat')+    enc <- bech32VerifyChecksum hrp' dat'+    return (enc, hrp', take (T.length dat - 6) dat')   where     lowerBech32 = T.toLower bech32 @@ -204,26 +219,28 @@     map fromIntegral <$> convertBits (map fromWord5 dat) 5 8 noPadding  -- | Check if witness version and program are valid.-segwitCheck :: Word8 -> Data -> Bool-segwitCheck witver witprog =+segwitCheck :: Bech32Encoding -> Word8 -> Data -> Bool+segwitCheck enc witver witprog =     witver <= 16 &&     if witver == 0-        then length witprog == 20 || length witprog == 32-        else length witprog >= 2 && length witprog <= 40+        then enc == Bech32  && (length witprog == 20 || length witprog == 32)+        else enc == Bech32m && (length witprog >= 2 && length witprog <= 40)  -- | Decode SegWit 'Bech32' address from a string and expected human-readable part. segwitDecode :: HRP -> Bech32 -> Maybe (Word8, Data) segwitDecode hrp addr = do-    (hrp', dat) <- bech32Decode addr+    (enc, hrp', dat) <- bech32Decode addr     guard $ (hrp == hrp') && not (null dat)     let (UnsafeWord5 witver:datBase32) = dat     decoded <- toBase256 datBase32-    guard $ segwitCheck witver decoded+    guard $ segwitCheck enc witver decoded     return (witver, decoded)  -- | Encode 'Data' as a SegWit 'Bech32' address. Needs human-readable part and -- witness program version. segwitEncode :: HRP -> Word8 -> Data -> Maybe Text segwitEncode hrp witver witprog = do-    guard $ segwitCheck witver witprog-    bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog+    guard $ segwitCheck enc witver witprog+    bech32Encode enc hrp $ UnsafeWord5 witver : toBase32 witprog+  where+    enc = if witver == 0 then Bech32 else Bech32m

@@ -16,43 +16,51 @@ import           Haskoin.Address import           Haskoin.Address.Bech32 import           Haskoin.Util-import           Test.Hspec import           Test.HUnit+import           Test.Hspec  spec = do     describe "bech32 checksum" $ do-        it "should have valid checksum" $ forM_ validChecksums testValidChecksum-        it "should have invalid checksum" $+        it "should be valid" $+            forM_ validChecksums (uncurry testValidChecksum)+        it "should be invalid" $             forM_ invalidChecksums testInvalidChecksum-        it "should be a valid address" $ forM_ validAddresses testValidAddress-        it "should be an invalid address" $-            forM_ invalidAddresses testInvalidAddress-        it "should be same for the input in different case" $-            all (== Just "test12hrzfj") . map (flip bech32Encode []) $ hrpCaseVariants-    describe "more encoding/decoding cases" $ do-        it "length > 90" $-            assert $-            isNothing $-            bech32Encode "bc" (replicate 82 (word5 (1 :: Word8)))-        it "segwit version bounds" $+        it "should be case-insensitive" $+            all (== Just "test12hrzfj") $+            map (flip (bech32Encode Bech32) []) hrpCaseVariants+    describe "bech32 address" $ do+        it "should be valid" $+            forM_ validChecksums (uncurry testValidChecksum)+        it "should be invalid" $+            forM_ invalidChecksums testInvalidChecksum+        it "should be case-insensitive" $+            all (== Just "test12hrzfj") $+            map (flip (bech32Encode Bech32) []) hrpCaseVariants+    describe "bech32 encoding/decoding" $ do+        it "should not encode long data string" $+            assert . isNothing $+            bech32Encode Bech32 "bc" (replicate 82 (word5 (1 :: Word8)))+        it "should not encode bad version number" $             assert $ isNothing $ segwitEncode "bc" 17 []-        it "segwit prog len version 0" $+        it "should not encode invalid length for version 0" $             assert $ isNothing $ segwitEncode "bc" 0 (replicate 30 1)-        it "segwit prog len version != 0" $+        it "should relax length restrictions for versions other than 0" $             assert $ isJust $ segwitEncode "bc" 1 (replicate 30 1)-        it "segwit prog len version != 0" $+        it "should not encode another long data string" $             assert $ isNothing $ segwitEncode "bc" 1 (replicate 41 1)-        it "empty HRP encode" $ assert $ isNothing $ bech32Encode "" []-        it "empty HRP encode" $+        it "should not encode empty human readable part" $+            assert $ isNothing $ bech32Encode Bech32 "" []+        it "should not decode empty human-readable part" $             assert $ isNothing $ bech32Decode "10a06t8"-        it "hrp lowercased" $-            bech32Encode "HRP" [] `shouldBe` bech32Encode "hrp" []+        it "human-readable part should be case-insensitive" $+            bech32Encode Bech32 "HRP" [] `shouldBe` bech32Encode Bech32 "hrp" []  -testValidChecksum :: Bech32 -> Assertion-testValidChecksum checksum = case bech32Decode checksum of-    Nothing                      -> assertFailure (show checksum)-    Just (resultHRP, resultData) -> do+testValidChecksum :: Bech32Encoding -> Bech32 -> Assertion+testValidChecksum enc checksum = case bech32Decode checksum of+    Nothing                           -> assertFailure (show checksum)+    Just (enc', resultHRP, resultData) -> do+        assertEqual (show checksum ++ " encoding incorrect") enc enc'         -- test that a corrupted checksum fails decoding.         let (hrp, rest)         = T.breakOnEnd "1" checksum             Just (first, rest') = uncons rest@@ -60,7 +68,7 @@         assertBool (show checksum ++ " corrupted")             $ isNothing (bech32Decode checksumCorrupted)         -- test that re-encoding the decoded checksum results in the same checksum.-        let checksumEncoded  = bech32Encode resultHRP resultData+        let checksumEncoded  = bech32Encode enc' resultHRP resultData             expectedChecksum = Just $ T.toLower checksum         assertEqual (show checksum ++ " re-encode")                     expectedChecksum@@ -75,7 +83,8 @@     let address' = T.toLower address         hrp      = T.take 2 address'     case segwitDecode hrp address of-        Nothing                -> assertFailure "decode failed"+        Nothing                ->+            assertFailure (T.unpack address <> ": decode failed")         Just (witver, witprog) -> do             assertEqual (show address)                         (decodeHex hexscript)@@ -94,13 +103,44 @@     B.pack $ witver' : fromIntegral (length witprog) : witprog     where witver' = if witver == 0 then 0 else witver + 0x50 -validChecksums :: [Text]+validChecksums :: [(Bech32Encoding, Text)] validChecksums =-    [ "A12UEL5L"-    , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"-    , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"-    , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"-    , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"+    [ ( Bech32+      , "A12UEL5L"+      )+    , ( Bech32+      , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"+      )+    , ( Bech32+      , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"+      )+    , ( Bech32+      , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"+      )+    , ( Bech32+      , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"+      )+    , ( Bech32m+      , "A1LQFN3A"+      )+    , ( Bech32m+      , "a1lqfn3a"+      )+    , ( Bech32m+      , "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11sg7hg6"+      )+    , ( Bech32m+      , "abcdef1l7aum6echk45nj3s0wdvt2fg8x9yrzpqzd3ryx"+      )+    , ( Bech32m+      , "11llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllludsr8"+      )+    , ( Bech32m+      , "split1checkupstagehandshakeupstreamerranterredcaperredlc445v"+      )+    , ( Bech32m+      , "?1v759aa"+      )     ]  invalidChecksums :: [Text]@@ -117,15 +157,39 @@  validAddresses :: [(Text, Text)] validAddresses =-    [ ("BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4", "0014751e76e8199196d454941c45d1b3a323f1433bd6")-    , ("tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7"-      ,"00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262")-    , ("bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7k7grplx"-      ,"5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6")-    , ("BC1SW50QA3JX3S", "6002751e")-    , ("bc1zw508d6qejxtdg4y5r3zarvaryvg6kdaj", "5210751e76e8199196d454941c45d1b3a323")-    , ("tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy"-      ,"0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433")+    [ ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4"+      , "0014751e76e8199196d454941c45d1b3a323f1433bd6"+      )+    , ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7"+      , "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262"+      )+    , ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy"+      , "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433"+      )+    , ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4"+      , "0014751e76e8199196d454941c45d1b3a323f1433bd6"+      )+    , ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7"+      , "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262"+      )+    , ( "bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kt5nd6y"+      , "5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6"+      )+    , ( "BC1SW50QGDZ25J"+      , "6002751e"+      )+    , ( "bc1zw508d6qejxtdg4y5r3zarvaryvaxxpcs"+      , "5210751e76e8199196d454941c45d1b3a323"+      )+    , ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy"+      , "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433"+      )+    , ( "tb1pqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesf3hn0c"+      , "5120000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433"+      )+    , ( "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqzk5jj0"+      , "512079be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+      )     ]  invalidAddresses :: [Text]@@ -140,6 +204,19 @@     , "bc1zw508d6qejxtdg4y5r3zarvaryvqyzf3du"     , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3pjxtptv"     , "bc1gmk9yu"+    , "tc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq5zuyut"+    , "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqh2y7hd"+    , "tb1z0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqglt7rf"+    , "BC1S0XLXVLHEMJA6C4DQV22UAPCTQUPFHLXM9H8Z3K2E72Q4K9HCZ7VQ54WELL"+    , "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kemeawh"+    , "tb1q0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq24jc47"+    , "bc1p38j9r5y49hruaue7wxjce0updqjuyyx0kh56v8s25huc6995vvpql3jow4"+    , "BC130XLXVLHEMJA6C4DQV22UAPCTQUPFHLXM9H8Z3K2E72Q4K9HCZ7VQ7ZWS8R"+    , "bc1pw5dgrnzv"+    , "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7v8n0nx0muaewav253zgeav"+    , "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vq47Zagq"+    , "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7v07qwwzcrf"+    , "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vpggkg4j"     ]  hrpCaseVariants:: [Text]