bitcoin-address (empty) → 0.1
raw patch · 11 files changed
+1509/−0 lines, 11 filesdep +basedep +base16-bytestringdep +base58-bytestring
Dependencies added: base, base16-bytestring, base58-bytestring, bech32, binary, bitcoin-address, bitcoin-hash, bitcoin-keys, bitcoin-script, bytestring, hedgehog, tasty, tasty-hedgehog, tasty-hunit, text
Files
- CHANGELOG.md +3/−0
- LICENSE +219/−0
- README.md +5/−0
- bitcoin-address.cabal +64/−0
- lib/Bitcoin/Address.hs +227/−0
- lib/Bitcoin/Address/Hash.hs +134/−0
- lib/Bitcoin/Address/Internal.hs +49/−0
- lib/Bitcoin/Address/Script.hs +108/−0
- lib/Bitcoin/Address/SegWit.hs +133/−0
- lib/Bitcoin/Address/Settings.hs +81/−0
- test/Main.hs +486/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# Version 0.1++* Initial version.
+ LICENSE view
@@ -0,0 +1,219 @@+Copyright 2020, Renzo Carbonara.++Except where otherwise explicitly mentioned, all of contents of the+"bitcoin-address" project are licensed under the Apache License,+Version 2.0 (the "License"); you may not use this file except in+compliance with the License. You may obtain a copy of the License at the+end of this file or at http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+++-------------------------------------------------------------------------------+++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,5 @@+# bitcoin-address++Bitcoin address generation and rendering. Parsing coming soon.++This library builds on GHC and GHCJS.
+ bitcoin-address.cabal view
@@ -0,0 +1,64 @@+cabal-version: 2.4+name: bitcoin-address+version: 0.1+license: Apache-2.0+license-file: LICENSE+extra-source-files: README.md CHANGELOG.md+author: Renzo Carbonara+maintainer: renλren.zone+copyright: Copyright (c) Renzo Carbonara 2020+category: Cryptography+build-type: Simple+synopsis: Bitcoin address generation and rendering. Parsing coming soon.+description:+ Bitcoin address generation and rendering. Parsing coming soon.+ .+ This library builds in GHC and GHCJS.+homepage: https://gitlab.com/k0001/hs-bitcoin-address+bug-reports: https://gitlab.com/k0001/hs-bitcoin-address/issues+tested-with: GHC == 8.8.3, GHC == 8.6.5, GHCJS == 8.6.0++common basic+ default-language: Haskell2010+ ghc-options: -O2 -Wall -Werror=incomplete-patterns+ ghcjs-options: -O3 -Wall -Werror=incomplete-patterns+ build-depends:+ base == 4.*,+ bitcoin-keys,+ bitcoin-script,+ bytestring,+ default-extensions:+ DerivingStrategies+ GeneralizedNewtypeDeriving+ LambdaCase+ OverloadedStrings++library+ import: basic+ hs-source-dirs: lib+ exposed-modules:+ Bitcoin.Address+ Bitcoin.Address.Hash+ Bitcoin.Address.Internal+ Bitcoin.Address.Settings+ Bitcoin.Address.Script+ Bitcoin.Address.SegWit+ build-depends:+ base58-bytestring,+ bech32,+ binary,+ bitcoin-hash,+ text,++test-suite test+ import: basic+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base16-bytestring,+ hedgehog,+ bitcoin-address,+ tasty,+ tasty-hedgehog,+ tasty-hunit,
+ lib/Bitcoin/Address.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE StrictData #-}++-- | Bitcoin address generation and rendering. Parsing is comming soon.+--+-- Most of what you'll normally need for safely dealing with Bitcoin addresses+-- is exported from this module.+module Bitcoin.Address+ ( -- * Network settings+ btc+ , btcTestnet++ -- * Addresses+ , Address(..)+ , renderAddress+ , addressScript+ -- ** P2PKH+ , p2pkh+ -- ** P2SH+ , p2sh+ , p2sh_multiSig+ , p2sh_p2wpkh+ , p2sh_p2wsh+ , p2sh_p2wsh_multiSig+ -- ** SegWit P2WPKH+ , p2wpkh+ -- ** SegWit P2WSH+ , p2wsh+ , p2wsh_multiSig+ ) where++import Bitcoin.Keys (Pub)+import Bitcoin.Hash (check32)+import qualified Data.Bitcoin.Script as S+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Base58 as B58++import Bitcoin.Address.Hash+import qualified Bitcoin.Address.Script as XS+import qualified Bitcoin.Address.SegWit as SW+import Bitcoin.Address.Settings++--------------------------------------------------------------------------------++-- | A Bitcoin compatible address.+--+-- These constructors are safe to use. However, you may find the similarly+-- named helper functions in "Bitcoin.Address" more practical.+data Address+ = P2PKH PrefixP2PKH PubHash160+ -- ^ A “pay to public-key hash” address. See 'p2pkh'.+ | P2SH PrefixP2SH ScriptHash160+ -- ^ A “pay to script hash” address. See 'p2sh', 'p2sh_multiSig',+ -- 'p2sh_p2wpkh', 'p2sh_p2wsh_multiSig'.+ | SegWit PrefixSegWit SW.Program+ -- ^ A native SegWit address. See 'p2wpkh', 'p2wsh', 'p2wsh_multiSig'.+ deriving (Eq, Ord)++-- | As 'renderAddress'.+instance Show Address where+ show = B8.unpack . renderAddress++--------------------------------------------------------------------------------+-- P2PKH++-- | 'P2PKH' 'Address' for a 'Pub'lic key.+--+-- This is the address format associated with BIP-0032+-- derivation path @m\/44'\/0'@+p2pkh :: Settings -> Pub -> Address+p2pkh sett = P2PKH (settings_prefixP2PKH sett) . pubHash160++--------------------------------------------------------------------------------+-- P2SH++-- | 'P2SH' 'Address' for a 'S.Script'.+--+-- See 'p2sh_p2wpkh', 'p2sh_p2wpkh' or 'p2sh_p2wsh_multiSig' for some of+-- the typical constructions using 'p2sh'. It's unlikely that you'll need to use+-- 'p2sh' directly unless you are deploying a non-standard 'S.Script'.+p2sh :: Settings -> S.Script -> Address+p2sh sett = P2SH (settings_prefixP2SH sett) . scriptHash160++-- | 'P2SH' “P2WPKH-in-'P2SH'” 'Address' for a 'Pub'lic key.+--+-- This is the address format associated with BIP-0032+-- derivation path @m\/49'\/0'@+p2sh_p2wpkh :: Settings -> Pub -> Address+p2sh_p2wpkh sett = p2sh sett . XS.segWit . SW.p2wpkh . pubHash160++-- | 'P2SH' 'Address' for a standard m-of-n 'XS.multiSig' 'S.Script'.+p2sh_multiSig+ :: Settings+ -> [Pub] -- ^ Public keys. Total number in range [1 … 16]+ -> Int -- ^ Required number of signatures in range [1 … 16]+ -> Maybe Address -- ^ 'Nothing' if any of the inputs is invalid.+p2sh_multiSig sett pks req = p2sh sett <$> XS.multiSig pks req++-- | 'P2SH' “P2WSH-in-'P2SH'” 'Address' for a 'S.Script'.+--+-- __WARNING__ SegWit does not support uncompressed SEC 'Pub'lic addresses+-- (i.e., 'Bitcoin.Keys.pubUncompressed' and 'pubUncompressedHash160'), so be+-- sure to only mention compressed SEC 'Pub'lic addresses in your 'S.Script's+-- (i.e., 'Bitcoin.Keys.pubCompressed' and 'pubHash160').+p2sh_p2wsh :: Settings -> S.Script -> Address+p2sh_p2wsh sett = p2sh sett . XS.segWit . SW.p2wsh . scriptSHA256++-- | 'P2SH' “P2WSH-in-'P2SH'” 'Address' for a standard m-of-n 'XS.multiSig'+-- 'S.Script'.+p2sh_p2wsh_multiSig+ :: Settings+ -> [Pub] -- ^ Public keys. Total number in range [1 … 16]+ -> Int -- ^ Required number of signatures in range [1 … 16]+ -> Maybe Address -- ^ 'Nothing' if any of the inputs is invalid.+p2sh_p2wsh_multiSig sett pks req = p2sh_p2wsh sett <$> XS.multiSig pks req++--------------------------------------------------------------------------------+-- SegWit++-- | 'SegWit' “P2WPKH” 'Address' for a 'Pub'lic key.+--+-- This is the address format associated with BIP-0032+-- derivation path @m\/84'\/0'@+p2wpkh :: Settings -> Pub -> Address+p2wpkh sett = SegWit (settings_prefixSegWit sett) . SW.p2wpkh . pubHash160++-- | 'SegWit' “P2WSH” 'Address' for a 'S.Script'.+--+-- Please see 'p2wsh_multiSig' for some of the typical constructions using+-- 'p2wsh'. It's unlikely that you'll need to use 'p2wsh' directly unless you+-- are deploying a non-standard 'S.Script'.+--+-- __WARNING__ SegWit does not support uncompressed SEC 'Pub'lic addresses+-- (i.e., 'Bitcoin.Keys.pubUncompressed' and 'pubUncompressedHash160'), so be+-- sure to only mention compressed SEC 'Pub'lic addresses in your 'S.Script's+-- (i.e., 'Bitcoin.Keys.pubCompressed' and 'pubHash160').+p2wsh :: Settings -> S.Script -> Address+p2wsh sett = SegWit (settings_prefixSegWit sett) . SW.p2wsh . scriptSHA256++-- | 'SegWit' “P2WSH” 'Address' for a standard m-of-n 'XS.multiSig' 'S.Script'.+p2wsh_multiSig+ :: Settings+ -> [Pub] -- ^ Public keys. Total number in range [1 … 16]+ -> Int -- ^ Required number of signatures in range [1 … 16]+ -> Maybe Address -- ^ 'Nothing' if any of the inputs is invalid.+p2wsh_multiSig sett pks req = p2wsh sett <$> XS.multiSig pks req++--------------------------------------------------------------------------------++-- | Obtain the 'S.Script' associated with a particular 'Address'.+--+-- This will be one of 'XS.p2pkh', 'XS.p2sh' or 'XS.segWit' from+-- the "Bitcoin.Address.Script" module.+addressScript :: Address -> S.Script+addressScript = \case+ P2PKH _ pkh -> XS.p2pkh pkh+ P2SH _ sh -> XS.p2sh sh+ SegWit _ swp -> XS.segWit swp++--------------------------------------------------------------------------------+{-+fromBase58Check :: B.ByteString -> Maybe B.ByteString+fromBase58Check a = do+ b <- B58.decodeBase58 B58.bitcoinAlphabet a+ guard (B.length b >= 4)+ let (x, ch) = B.splitAt (B.length b - 4) b+ guard (check32 x == ch)+ pure x+-}+--------------------------------------------------------------------------------++-- | Render and 'Address' to its human readable form.+renderAddress :: Address -> B.ByteString+renderAddress = \case+ P2PKH pre pkh -> toBase58Check $ B.cons (unPrefixP2PKH pre) (unPubHash160 pkh)+ P2SH pre sh -> toBase58Check $ B.cons (unPrefixP2SH pre) (unScriptHash160 sh)+ SegWit pre swp -> SW.renderProgram pre swp++--------------------------------------------------------------------------------++toBase58Check :: B.ByteString -> B.ByteString+{-# INLINE toBase58Check #-}+toBase58Check a = B58.encodeBase58 B58.bitcoinAlphabet (a <> check32 a)++--------------------------------------------------------------------------------++-- | BTC /mainnet/ network settings.+--+-- * 'P2PKH' addresses, when rendered, start with __1__.+--+-- * 'P2SH' addresses, when rendered, start with __3__.+--+-- * 'SegWit' addresses, when rendered, start with __bc1__.+btc :: Settings+btc = Settings btc_prefixP2PKH btc_prefixP2SH btc_prefixSegWit++btc_prefixP2PKH :: PrefixP2PKH+btc_prefixP2PKH = PrefixP2PKH 0x00++btc_prefixP2SH :: PrefixP2SH+btc_prefixP2SH = PrefixP2SH 0x05++btc_prefixSegWit :: PrefixSegWit+Just btc_prefixSegWit = prefixSegWit "bc"++--------------------------------------------------------------------------------++-- | BTC /testnet/ network settings.+--+-- * 'P2PKH' addresses, when rendered, start with __m__ or __n__.+--+-- * 'P2SH' addresses, when rendered, start with __2__.+--+-- * 'SegWit' addresses, when rendered, start with __tb1__.+btcTestnet :: Settings+btcTestnet = Settings btcTestnet_prefixP2PKH btcTestnet_prefixP2SH+ btcTestnet_prefixSegWit++btcTestnet_prefixP2PKH :: PrefixP2PKH+btcTestnet_prefixP2PKH = PrefixP2PKH 0x6f++btcTestnet_prefixP2SH :: PrefixP2SH+btcTestnet_prefixP2SH = PrefixP2SH 0xc4++btcTestnet_prefixSegWit :: PrefixSegWit+Just btcTestnet_prefixSegWit = prefixSegWit "tb"+
+ lib/Bitcoin/Address/Hash.hs view
@@ -0,0 +1,134 @@+-- | This module exports hash constructions used by Bitcoin addresses.+module Bitcoin.Address.Hash+ ( -- * PubHash160+ PubHash160+ , unPubHash160+ , parsePubHash160+ , pubHash160+ , pubUncompressedHash160++ -- * ScriptHash160+ , ScriptHash160+ , unScriptHash160+ , parseScriptHash160+ , scriptHash160++ -- * ScriptSHA256+ , ScriptSHA256+ , unScriptSHA256+ , parseScriptSHA256+ , scriptSHA256+ ) where++import Bitcoin.Keys (Pub, pubCompressed, pubUncompressed)+import Bitcoin.Hash (hash160)+import Bitcoin.Hash.Prim (sha256)+import Control.Monad+import qualified Data.Bitcoin.Script as S+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL8++import Bitcoin.Address.Internal (scriptBytes)++--------------------------------------------------------------------------------++-- | The 'hash160' of a 'Pub'lic key.+newtype PubHash160 = PubHash160 B.ByteString+ deriving newtype (Eq, Ord)++-- | Base-16 encoded.+instance Show PubHash160 where+ showsPrec n (PubHash160 b) = showParen (n > 10) $+ showString "PubHash160 " .+ mappend (BL8.unpack (BB.toLazyByteString (BB.byteStringHex b)))++-- | Get the 20 bytes in 'PubHash160'.+unPubHash160 :: PubHash160 -> B.ByteString+{-# INLINE unPubHash160 #-}+unPubHash160 (PubHash160 x) = x++-- | Create a 'PubHash160' from its 20 raw bytes.+parsePubHash160 :: B.ByteString -> Maybe PubHash160+{-# INLINE parsePubHash160 #-}+parsePubHash160 b = do+ guard (B.length b == 20)+ pure (PubHash160 b)++-- | The 'hash160' of the compressed SEC representation of a 'Pub'lic key.+--+-- Usually, __this is what you want__.+pubHash160 :: Pub -> PubHash160+{-# INLINE pubHash160 #-}+pubHash160 = PubHash160 . hash160 . pubCompressed++-- | The 'hash160' of the uncompressed SEC representation of a 'Pub'lic key.+--+-- It's very unlikely that you want this. Except if it's ten years ago or you+-- are dealing with very old addresses.+--+-- __WARNING__ do not use this with SegWit addresses 'Bitcoin.Address.P2WPKH',+-- or in 'Bitcoin.Address.P2WSH' 'S.Script's.+pubUncompressedHash160 :: Pub -> PubHash160+{-# INLINE pubUncompressedHash160 #-}+pubUncompressedHash160 = PubHash160 . hash160 . pubUncompressed++--------------------------------------------------------------------------------++-- | The 'hash160' of a 'S.Script' as required by 'Bitcoin.Address.P2SH'.+newtype ScriptHash160 = ScriptHash160 B.ByteString+ deriving newtype (Eq, Ord)++-- | Base-16 encoded.+instance Show ScriptHash160 where+ showsPrec n (ScriptHash160 b) = showParen (n > 10) $+ showString "ScriptHash160 " .+ mappend (BL8.unpack (BB.toLazyByteString (BB.byteStringHex b)))++-- | Get the 20 bytes in 'ScriptHash160'.+unScriptHash160 :: ScriptHash160 -> B.ByteString+{-# INLINE unScriptHash160 #-}+unScriptHash160 (ScriptHash160 x) = x++-- | Create a 'ScriptHash160' from its 20 raw bytes.+parseScriptHash160 :: B.ByteString -> Maybe ScriptHash160+{-# INLINE parseScriptHash160 #-}+parseScriptHash160 b = do+ guard (B.length b == 20)+ pure (ScriptHash160 b)++-- | Hash a 'S.Script' as required by 'Bitcoin.Address.P2SH'.+scriptHash160 :: S.Script -> ScriptHash160+{-# INLINE scriptHash160 #-}+scriptHash160 = ScriptHash160 . hash160 . scriptBytes++--------------------------------------------------------------------------------++-- | The 'sha256' of a 'S.Script' as required by 'Bitcoin.Address.P2WSH'.+newtype ScriptSHA256 = ScriptSHA256 B.ByteString+ deriving newtype (Eq, Ord)++-- | Base-16 encoded.+instance Show ScriptSHA256 where+ showsPrec n (ScriptSHA256 b) = showParen (n > 10) $+ showString "ScriptSHA256 " .+ mappend (BL8.unpack (BB.toLazyByteString (BB.byteStringHex b)))++-- | Get the 32 bytes in 'ScriptSHA256'.+unScriptSHA256 :: ScriptSHA256 -> B.ByteString+{-# INLINE unScriptSHA256 #-}+unScriptSHA256 (ScriptSHA256 x) = x++-- | Create a 'ScriptSHA256' from its 32 raw bytes.+parseScriptSHA256 :: B.ByteString -> Maybe ScriptSHA256+{-# INLINE parseScriptSHA256 #-}+parseScriptSHA256 b = do+ guard (B.length b == 32)+ pure (ScriptSHA256 b)++-- | Hash a 'S.Script' as required by 'Bitcoin.Address.P2WSH'.+scriptSHA256 :: S.Script -> ScriptSHA256+{-# INLINE scriptSHA256 #-}+scriptSHA256 = ScriptSHA256 . sha256 . scriptBytes++
+ lib/Bitcoin/Address/Internal.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_HADDOCK hide #-}+module Bitcoin.Address.Internal+ ( op0to16+ , scriptBytes+ , hush+ ) where++import qualified Data.Binary as Bin+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Bitcoin.Script as S++--------------------------------------------------------------------------------++-- | Converts the numbers [0 … 16] to the corresponding ['S.OP_0' … 'S.OP_16'].+op0to16 :: Int -> Maybe S.ScriptOp+op0to16 i = case i of+ 0 -> Just S.OP_0+ 1 -> Just S.OP_1+ 2 -> Just S.OP_2+ 3 -> Just S.OP_3+ 4 -> Just S.OP_4+ 5 -> Just S.OP_5+ 6 -> Just S.OP_6+ 7 -> Just S.OP_7+ 8 -> Just S.OP_8+ 9 -> Just S.OP_9+ 10 -> Just S.OP_10+ 11 -> Just S.OP_11+ 12 -> Just S.OP_12+ 13 -> Just S.OP_13+ 14 -> Just S.OP_14+ 15 -> Just S.OP_15+ 16 -> Just S.OP_16+ _ -> Nothing++-------------------------------------------------------------------------------++-- | Obtain the raw 'S.Script' bytes.+scriptBytes :: S.Script -> B.ByteString+scriptBytes = BL.toStrict . Bin.encode+{-# INLINE scriptBytes #-}++--------------------------------------------------------------------------------++hush :: Either a b -> Maybe b+hush = either (\_ -> Nothing) Just+{-# INLINE hush #-}+
+ lib/Bitcoin/Address/Script.hs view
@@ -0,0 +1,108 @@+-- | This module exports standard Bitcoin 'S.Script' constructions.+module Bitcoin.Address.Script+ ( -- * Scripts+ p2pkh+ , p2sh+ , segWit+ , multiSig+ ) where++import Bitcoin.Keys (Pub, pubCompressed)+import Control.Monad+import qualified Data.Bitcoin.Script as S++import Bitcoin.Address.Hash+import Bitcoin.Address.Internal (op0to16)+import qualified Bitcoin.Address.SegWit as SW++--------------------------------------------------------------------------------++-- | Standard 'Bitcoin.Address.P2PKH' script.+--+-- [pubh]: 'PubHash160'.+--+-- Script:+--+-- @+-- 'S.OP_DUP'+-- 'S.OP_HASH160'+-- 'S.OP_PUSHDATA' pubh 'S.OPCODE'+-- 'S.OP_EQUALVERIFY'+-- 'S.OP_CHECKSIG'+-- @+p2pkh :: PubHash160 -> S.Script+p2pkh pkh = S.Script+ [ S.OP_DUP+ , S.OP_HASH160+ , S.OP_PUSHDATA (unPubHash160 pkh) S.OPCODE+ , S.OP_EQUALVERIFY+ , S.OP_CHECKSIG+ ]++-- | Standard 'Bitcoin.Address.P2SH' script.+--+-- [sh]: 'ScriptHash160'.+--+-- Script:+--+-- @+-- 'S.OP_HASH160'+-- 'S.OP_PUSHDATA' sh 'S.OPCODE'+-- 'S.OP_EQUAL'+-- @+p2sh :: ScriptHash160 -> S.Script+p2sh sh = S.Script+ [ S.OP_HASH160+ , S.OP_PUSHDATA (unScriptHash160 sh) S.OPCODE+ , S.OP_EQUAL+ ]++-- | Standard SegWit 'Bitcoin.Address.Program' script.+--+-- [ver]: SegWit 'SW.versionOp'+--+-- [prog]: SegWit 'SW.programData'+--+-- Script:+--+-- @+-- ver+-- 'S.OP_PUSHDATA' prog 'S.OPCODE'+-- @+segWit :: SW.Program -> S.Script+segWit swp = S.Script+ [ SW.versionOp (SW.programVersion swp)+ , S.OP_PUSHDATA (SW.programData swp ) S.OPCODE+ ]++-- | Standard “m-of-n” multi-signature script.+--+-- [m]: Number of required signatures in range ['S.OP_1' … 'S.OP_16']+--+-- [n]: Number of 'Pub'lic keys given in range ['S.OP_1' … 'S.OP_16']+--+-- [pubs]: Compressed SEC representation the given 'Pub'lic keys, each one+-- (@pub@) encoded as @'S.OP_PUSHDATA' ('pubCompressed' pub) 'S.OPCODE'@.+--+-- Script:+--+-- @+-- m+-- pubs+-- n+-- 'S.OP_CHECKMULTISIG'+-- @+multiSig+ :: [Pub] -- ^ Public keys. Total number in range [1 … 16]+ -> Int -- ^ Required number of signatures in range [1, 16].+ -> Maybe S.Script -- ^ 'Nothing' if any of the inputs is invalid.+multiSig pks req = do+ let len = length pks+ guard (req >= 1 && req <= 16 && req <= len)+ opLen <- op0to16 len+ opReq <- op0to16 req+ pure $ S.Script $ mconcat+ [ [ opReq ]+ , do pk <- pks+ pure $ S.OP_PUSHDATA (pubCompressed pk) S.OPCODE+ , [ opLen, S.OP_CHECKMULTISIG ] ]
+ lib/Bitcoin/Address/SegWit.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE StrictData #-}+module Bitcoin.Address.SegWit+ ( -- * Version+ Version+ , version+ , unVersion+ , versionOp+ , version0+ -- * Programs+ , Program+ , program+ , programVersion+ , programData+ , renderProgram+ -- ** Standard programs+ , p2wpkh+ , p2wsh+ ) where++import qualified Codec.Binary.Bech32 as Bech32+import qualified Codec.Binary.Bech32.Internal as Bech32+import Control.Monad+import qualified Data.Bitcoin.Script as S+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Data.Text.Encoding as T+import Data.Word++import Bitcoin.Address.Hash+import Bitcoin.Address.Internal (op0to16)+import Bitcoin.Address.Settings++--------------------------------------------------------------------------------++-- | A SegWit program. Construct with 'program'.+data Program = Program Version B.ByteString+ deriving (Eq, Ord)++-- | Version and base-16 encoded program data.+instance Show Program where+ showsPrec n (Program v d) = showParen (n > 10) $+ showString "Program " .+ mappend (show v) .+ mappend " " .+ mappend (BL8.unpack (BB.toLazyByteString (BB.byteStringHex d)))++-- | SegWit program version.+programVersion :: Program -> Version+{-# INLINE programVersion #-}+programVersion (Program v _) = v++-- | Raw SegWit program data.+programData :: Program -> B.ByteString+{-# INLINE programData #-}+programData (Program _ x) = x++-- | Construct a 'Program' from its raw bytes.+--+-- __WARINING__ This function will prevent you frow constructing invalid SegWit+-- programs, but won't help you write __meaningful__ programs. Prefer to use+-- safe constructions such as 'p2wpkh' or 'p2wsh' instead.+program+ :: Version+ -> B.ByteString -- ^ Raw SegWit program bytes.+ -> Maybe Program -- ^ Nothing if program length is invalid for version.+program ver prog = do+ let len = B.length prog+ guard $ case unVersion ver of+ 0 -> len == 20 || len == 32+ _ -> len >= 2 && len <= 40+ pure (Program ver prog)++--------------------------------------------------------------------------------++-- | Bech32-encode a 'Program'.+renderProgram :: PrefixSegWit -> Program -> B.ByteString+{-# INLINE renderProgram #-}+renderProgram pre (Program ver prog) =+ let w5ver = toEnum $ fromIntegral $ unVersion ver+ dver = Bech32.dataPartFromWords [w5ver]+ dprog = Bech32.dataPartFromBytes prog+ in T.encodeUtf8 $ Bech32.encodeLenient (prefixSegWitHRP pre) (dver <> dprog)++--------------------------------------------------------------------------------++-- | The version for of a SegWit 'Program'.+newtype Version = Version Word8+ deriving (Eq, Ord, Show)++-- | Construct a SegWit 'Version'.+--+-- The given 'Word8' must be in the inclusive range [0 … 16].+version :: Word8 -> Maybe Version+{-# INLINE version #-}+version w = do+ guard (w <= 16)+ Just (Version w)++-- | The obtained 'Word8' is in the inclusive range [0 … 16].+unVersion :: Version -> Word8+{-# INLINE unVersion #-}+unVersion (Version w) = w++-- | The 'S.ScriptOp' corresponding to the 'Version', in+-- range ['S.OP_0' … 'S.OP_16']+versionOp :: Version -> S.ScriptOp+{-# INLINE versionOp #-}+versionOp (Version w) = case op0to16 (fromIntegral w) of+ Just op -> op+ Nothing -> undefined -- impossible++--------------------------------------------------------------------------------++-- | SegWit version 0+version0 :: Version+{-# INLINE version0 #-}+Just version0 = version 0++-- | Construct a standard SegWit version 0 P2WPKH program.+p2wpkh :: PubHash160 -> Program+{-# INLINE p2wpkh #-}+p2wpkh pkh = case program version0 (unPubHash160 pkh) of+ Just prog -> prog+ Nothing -> undefined -- impossible++-- | Construct a standard SegWit version 0 P2WSH program.+p2wsh :: ScriptSHA256 -> Program+{-# INLINE p2wsh #-}+p2wsh sh = case program version0 (unScriptSHA256 sh) of+ Just prog -> prog+ Nothing -> undefined -- impossible+
+ lib/Bitcoin/Address/Settings.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE StrictData #-}+{-# OPTIONS_HADDOCK prune #-}++-- | This module exports settings for different Bitcoin networks.+module Bitcoin.Address.Settings+ ( -- * Settings+ Settings(..)+ -- ** PrefixP2PKH+ , PrefixP2PKH(..)+ -- ** PrefixP2SH+ , PrefixP2SH(..)+ -- ** PrefixSegWit+ , PrefixSegWit+ , prefixSegWit+ , unPrefixSegWit+ , prefixSegWitHRP+ ) where++import qualified Codec.Binary.Bech32 as Bech32+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Data.Text.Encoding as T+import Data.Word++import Bitcoin.Address.Internal (hush)++--------------------------------------------------------------------------------++-- | Bitcoin network settings+--+-- For examples, see 'Bitcoin.Address.btc' or 'Bitcoin.Address.btcTestnet' in+-- "Bitcoin.Address".+data Settings = Settings+ { settings_prefixP2PKH :: PrefixP2PKH+ , settings_prefixP2SH :: PrefixP2SH+ , settings_prefixSegWit :: PrefixSegWit+ } deriving (Eq, Show)++--------------------------------------------------------------------------------++-- | The byte prefix used in 'P2PKH' addresses.+newtype PrefixP2PKH = PrefixP2PKH { unPrefixP2PKH :: Word8 }+ deriving newtype (Eq, Ord, Show)++--------------------------------------------------------------------------------++-- | The byte prefix used in 'P2SH' addresses.+newtype PrefixP2SH = PrefixP2SH { unPrefixP2SH :: Word8 }+ deriving newtype (Eq, Ord, Show)++--------------------------------------------------------------------------------++-- | The Human Readable Part of a 'P2WPKH' or 'P2WSH'+-- address (e.g., the “bc” in “bc1…”)+newtype PrefixSegWit = PrefixSegWit Bech32.HumanReadablePart+ deriving newtype (Eq)++instance Ord PrefixSegWit where+ compare a b = compare (unPrefixSegWit a) (unPrefixSegWit b)++instance Show PrefixSegWit where+ showsPrec n p = showParen (n > 10) $+ showString "PrefixSegWit " .+ mappend (BL8.unpack (BB.toLazyByteString+ (BB.byteStringHex (unPrefixSegWit p))))++prefixSegWitHRP :: PrefixSegWit -> Bech32.HumanReadablePart+prefixSegWitHRP (PrefixSegWit hrp) = hrp++-- | Obtain the Bech32 Human Readable Part inside 'PrefixSegWit'.+unPrefixSegWit :: PrefixSegWit -> B.ByteString+unPrefixSegWit (PrefixSegWit hrp) =+ T.encodeUtf8 (Bech32.humanReadablePartToText hrp)++-- | Construct a 'PrefixSegWit' from the Bech32 Human Readable Part.+prefixSegWit :: B.ByteString -> Maybe PrefixSegWit+prefixSegWit b = do+ t <- hush (T.decodeUtf8' b)+ PrefixSegWit <$> hush (Bech32.humanReadablePartFromText t)+
+ test/Main.hs view
@@ -0,0 +1,486 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++module Main (main) where++import qualified Bitcoin.Keys as K+import qualified Data.Bitcoin.Script as S+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B16+import Data.Word+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Runners as Tasty+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.Hedgehog (testProperty, HedgehogTestLimit(..))+import Hedgehog (MonadGen, property, forAll, (===))+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import qualified Bitcoin.Address as A+import qualified Bitcoin.Address.Hash as AH+import qualified Bitcoin.Address.Internal as AI+import qualified Bitcoin.Address.Script as ASC+import qualified Bitcoin.Address.SegWit as ASW+import qualified Bitcoin.Address.Settings as ASE++--------------------------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMainWithIngredients+ [ Tasty.consoleTestReporter+ , Tasty.listingTests+ ] $ Tasty.localOption (HedgehogTestLimit (Just 100))+ $ tt++tt :: TestTree+tt = testGroup "bitcoin-address"+ [ tt_settings+ , tt_script+ , tt_hash+ , tt_address+ ]++tt_settings :: TestTree+tt_settings = testGroup "Settings"+ [ testCase "btc" $ do+ let ASE.Settings preP2PKH preP2SH preSegWit = A.btc+ preP2PKH @?= ASE.PrefixP2PKH { ASE.unPrefixP2PKH = 0x00 }+ preP2SH @?= ASE.PrefixP2SH { ASE.unPrefixP2SH = 0x05 }+ Just preSegWit @?= ASE.prefixSegWit "bc"++ , testCase "btcTestnet" $ do+ let ASE.Settings preP2PKH preP2SH preSegWit = A.btcTestnet+ preP2PKH @?= ASE.PrefixP2PKH { ASE.unPrefixP2PKH = 0x6f }+ preP2SH @?= ASE.PrefixP2SH { ASE.unPrefixP2SH = 0xc4 }+ Just preSegWit @?= ASE.prefixSegWit "tb"+ ]++tt_hash :: TestTree+tt_hash = testGroup "Hash"+ [ testGroup "pubHash160"+ [ testCase "pk1" $ do+ toBase16 (AH.unPubHash160 pk1hash160)+ @?= "5f04d673fdbd072b97558a8f830a5ddf655839d7"++ , testCase "pk2" $ do+ toBase16 (AH.unPubHash160 pk2hash160)+ @?= "980938e055943e47b73e5d16b2de7343a61a0a7b"+ ]+ , testGroup "pubUncompressedHash160"+ [ testCase "pk1" $ do+ toBase16 (AH.unPubHash160 (AH.pubUncompressedHash160 pk1))+ @?= "6baec369d3d75a0a27818c3560fe2c4db8f916d6"++ , testCase "pk2" $ do+ toBase16 (AH.unPubHash160 (AH.pubUncompressedHash160 pk2))+ @?= "85b679742f15e5b24849747c8eab44c0eb508fbe"+ ]+ , testCase "scriptHash160" $ do+ toBase16 (AH.unScriptHash160 (AH.scriptHash160 (ASC.p2pkh pk1hash160)))+ @?= "929f8c79af58e615ffe465a76f44c02865b5b77b"++ , testCase "scriptSHA256" $ do+ toBase16 (AH.unScriptSHA256 (AH.scriptSHA256 (ASC.p2pkh pk1hash160)))+ @?= "a39b82cbb33b2ee51d0fd5e415ce924f3f4a120ae962c13ab2f9b6433326e0bf"+ ]++tt_script :: TestTree+tt_script = testGroup "Script"+ [ tt_script_p2pkh+ , tt_script_multiSig+ , tt_script_p2sh+ , tt_script_segWit+ ]++tt_script_p2pkh :: TestTree+tt_script_p2pkh = testGroup "P2PKH"+ [ testCase "pk1" $ do+ let s = ASC.p2pkh pk1hash160+ toBase16 (AI.scriptBytes s) @?=+ "76a9145f04d673fdbd072b97558a8f830a5ddf655839d788ac"++ , testCase "pk2" $ do+ let s = ASC.p2pkh pk2hash160+ toBase16 (AI.scriptBytes s) @?=+ "76a914980938e055943e47b73e5d16b2de7343a61a0a7b88ac"++ , testProperty "prop" $ property $ do+ pk <- forAll genPub+ let pkh = AH.pubHash160 pk+ s = ASC.p2pkh pkh+ toBase16 (AI.scriptBytes s) === mconcat+ [ "76a914", toBase16 (AH.unPubHash160 pkh), "88ac" ]+ ]+++tt_script_segWit :: TestTree+tt_script_segWit = testGroup "SegWit"+ [ tt_script_segWit_p2wpkh+ , tt_script_segWit_p2wsh+ ]++tt_script_segWit_p2wpkh :: TestTree+tt_script_segWit_p2wpkh = testGroup "P2WPKH"+ [ testCase "pk1" $ do+ let s = ASC.segWit (ASW.p2wpkh pk1hash160)+ toBase16 (AI.scriptBytes s) @?=+ "00145f04d673fdbd072b97558a8f830a5ddf655839d7"++ , testCase "pk2" $ do+ let s = ASC.segWit (ASW.p2wpkh pk2hash160)+ toBase16 (AI.scriptBytes s) @?=+ "0014980938e055943e47b73e5d16b2de7343a61a0a7b"++ , testProperty "prop" $ property $ do+ pk <- forAll genPub+ let pkh = AH.pubHash160 pk+ s = ASC.segWit (ASW.p2wpkh pkh)+ toBase16 (AI.scriptBytes s) === mconcat+ [ "0014", toBase16 (AH.unPubHash160 pkh) ]+ ]++tt_script_multiSig :: TestTree+tt_script_multiSig = testGroup "MultiSig"+ [ testCase "1 of [pk1]" $ do+ let Just s = ASC.multiSig [pk1] 1+ toBase16 (AI.scriptBytes s) @?= mconcat+ ["5121", toBase16 (K.pubCompressed pk1), "51ae"]++ , testCase "1 of [pk2]" $ do+ let Just s = ASC.multiSig [pk2] 1+ toBase16 (AI.scriptBytes s) @?= mconcat+ ["5121", toBase16 (K.pubCompressed pk2), "51ae"]++ , testCase "1 of [pk1, pk2]" $ do+ let Just s = ASC.multiSig [pk1, pk2] 1+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "5121", toBase16 (K.pubCompressed pk1)+ , "21", toBase16 (K.pubCompressed pk2)+ , "52ae" ]++ , testCase "1 of [pk2, pk1]" $ do+ let Just s = ASC.multiSig [pk2, pk1] 1+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "5121", toBase16 (K.pubCompressed pk2)+ , "21", toBase16 (K.pubCompressed pk1)+ , "52ae" ]++ , testCase "2 of [pk1, pk2]" $ do+ let Just s = ASC.multiSig [pk1, pk2] 2+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "5221", toBase16 (K.pubCompressed pk1)+ , "21", toBase16 (K.pubCompressed pk2)+ , "52ae" ]++ , testCase "2 of [pk2, pk1]" $ do+ let Just s = ASC.multiSig [pk2, pk1] 2+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "5221", toBase16 (K.pubCompressed pk2)+ , "21", toBase16 (K.pubCompressed pk1)+ , "52ae"]++ , testProperty "0 of n (invalid)" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 0 20) genPub+ Nothing === ASC.multiSig pks 0++ , testProperty "m of [] (invalid)" $ property $ do+ n <- forAll $ Gen.int (Range.constant (-20) 20)+ Nothing === ASC.multiSig [] n++ , testProperty "m of n, m > n (invalid)" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 0 20) genPub+ i <- forAll $ Gen.int (Range.constant 1 20)+ Nothing === ASC.multiSig pks (length pks + i)++ , testProperty "m of n, n > 16 (invalid)" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 17 30) genPub+ m <- forAll $ Gen.int (Range.constant 1 20)+ Nothing === ASC.multiSig pks m++ , testProperty "m of n (correct)" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 1 16) genPub+ m <- forAll $ Gen.int (Range.constant 1 (length pks))+ let Just mOp = AI.op0to16 m+ Just nOp = AI.op0to16 (length pks)+ pksOps = map (\pk -> S.OP_PUSHDATA (K.pubCompressed pk) S.OPCODE) pks+ s = S.Script $ (mOp : pksOps) <> [nOp, S.OP_CHECKMULTISIG]+ Just s === ASC.multiSig pks m+ ]++tt_script_p2sh :: TestTree+tt_script_p2sh = testGroup "P2SH"+ [ tt_script_p2sh_p2wpkh+ , tt_script_p2sh_multiSig+ , tt_script_p2sh_p2wsh+ ]++tt_script_p2sh_p2wpkh :: TestTree+tt_script_p2sh_p2wpkh = testGroup "P2WPKH-in-P2SH"+ [ testCase "pk1" $ do+ let sw = ASC.segWit (ASW.p2wpkh pk1hash160)+ swh = AH.scriptHash160 sw+ s = ASC.p2sh swh+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "a914", toBase16 (AH.unScriptHash160 swh), "87" ]+ toBase16 (AI.scriptBytes s) @?=+ "a914ba9102a5c6407308a600e114cb3474bb179b1eca87"++ , testCase "pk2" $ do+ let sw = ASC.segWit (ASW.p2wpkh pk2hash160)+ swh = AH.scriptHash160 sw+ s = ASC.p2sh swh+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "a914", toBase16 (AH.unScriptHash160 swh), "87" ]+ toBase16 (AI.scriptBytes s) @?=+ "a9140e8ee6d7778e0b708844a8c40b1f1c700de2489287"++ , testProperty "prop" $ property $ do+ pk <- forAll genPub+ let pkh = AH.pubHash160 pk+ sw = ASC.segWit (ASW.p2wpkh pkh)+ swh = AH.scriptHash160 sw+ s = ASC.p2sh swh+ toBase16 (AI.scriptBytes s) === mconcat+ [ "a914", toBase16 (AH.unScriptHash160 swh), "87" ]+ ]++tt_script_p2sh_multiSig :: TestTree+tt_script_p2sh_multiSig = testGroup "MultiSig"+ [ testCase "1 of [pk1, pk2]" $ do+ let Just sMultiSig = ASC.multiSig [pk1, pk2] 1+ shMultiSig = AH.scriptHash160 sMultiSig+ s = ASC.p2sh shMultiSig+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "a914", toBase16 (AH.unScriptHash160 shMultiSig), "87" ]+ toBase16 (AI.scriptBytes s) @?=+ "a914db9775b7424ddfd3a69d83c2a9a91bf7953197b187"++ , testProperty "prop" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 1 16) genPub+ m <- forAll $ Gen.int (Range.constant 1 (length pks))+ let Just sMultiSig = ASC.multiSig pks m+ shMultiSig = AH.scriptHash160 sMultiSig+ s = ASC.p2sh shMultiSig+ s === S.Script [ S.OP_HASH160+ , S.OP_PUSHDATA (AH.unScriptHash160 shMultiSig) S.OPCODE+ , S.OP_EQUAL ]+ toBase16 (AI.scriptBytes s) === mconcat+ [ "a914", toBase16 (AH.unScriptHash160 shMultiSig), "87"]+ ]++tt_script_p2sh_p2wsh :: TestTree+tt_script_p2sh_p2wsh = testGroup "P2WSH-in-P2SH"+ [ tt_script_p2sh_p2wsh_multiSig+ ]++tt_script_p2sh_p2wsh_multiSig :: TestTree+tt_script_p2sh_p2wsh_multiSig = testGroup "P2WSH-MultiSig-in-P2SH"+ [ testCase "1 of [pk1, pk2]" $ do+ let Just sMultiSig = ASC.multiSig [pk1, pk2] 1+ shMultiSig = AH.scriptSHA256 sMultiSig+ sw = ASC.segWit (ASW.p2wsh shMultiSig)+ swh = AH.scriptHash160 sw+ s = ASC.p2sh swh+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "a914", toBase16 (AH.unScriptHash160 swh), "87" ]+ toBase16 (AI.scriptBytes s) @?=+ "a9140b5fd2183b91a75ae09e70122bf89e79e71ff1c387"++ , testProperty "prop" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 1 16) genPub+ m <- forAll $ Gen.int (Range.constant 1 (length pks))+ let Just sMultiSig = ASC.multiSig pks m+ shMultiSig = AH.scriptSHA256 sMultiSig+ sw = ASC.segWit (ASW.p2wsh shMultiSig)+ swh = AH.scriptHash160 sw+ s = ASC.p2sh swh+ s === S.Script [ S.OP_HASH160+ , S.OP_PUSHDATA (AH.unScriptHash160 swh) S.OPCODE+ , S.OP_EQUAL ]+ toBase16 (AI.scriptBytes s) === mconcat+ [ "a914", toBase16 (AH.unScriptHash160 swh), "87" ]+ let Just s' = A.addressScript <$> A.p2sh_p2wsh_multiSig A.btc pks m+ s' === s+ ]++tt_script_segWit_p2wsh :: TestTree+tt_script_segWit_p2wsh = testGroup "P2WSH"+ [ tt_script_segWit_p2wsh_multiSig+ ]++tt_script_segWit_p2wsh_multiSig :: TestTree+tt_script_segWit_p2wsh_multiSig = testGroup "MultiSig"+ [ testCase "1 of [pk1, pk2]" $ do+ let Just sMultiSig = ASC.multiSig [pk1, pk2] 1+ shMultiSig = AH.scriptSHA256 sMultiSig+ s = ASC.segWit (ASW.p2wsh shMultiSig)+ toBase16 (AI.scriptBytes s) @?= mconcat+ [ "0020", toBase16 (AH.unScriptSHA256 shMultiSig) ]+ toBase16 (AI.scriptBytes s) @?=+ "00209d0d2b0482cfd102ae24a2720645b502fc9a56164ec54e87a51c8d4966cebdbe"++ , testProperty "prop" $ property $ do+ pks <- forAll $ Gen.list (Range.constant 1 16) genPub+ m <- forAll $ Gen.int (Range.constant 1 (length pks))+ let Just sMultiSig = ASC.multiSig pks m+ shMultiSig = AH.scriptSHA256 sMultiSig+ s = ASC.segWit (ASW.p2wsh shMultiSig)+ s === S.Script [ S.OP_0+ , S.OP_PUSHDATA (AH.unScriptSHA256 shMultiSig) S.OPCODE ]+ toBase16 (AI.scriptBytes s) === mconcat+ [ "0020", toBase16 (AH.unScriptSHA256 shMultiSig) ]+ ]++tt_address :: TestTree+tt_address = testGroup "Address"+ [ tt_address_btc+ -- , tt_address_btcTestnet+ ]+++tt_address_btc :: TestTree+tt_address_btc = testGroup "BTC"+ [ testGroup "p2pkh"+ [ testCase "pk1" $ do+ A.renderAddress (A.p2pkh A.btc pk1) @?=+ "19fQzMWpVo5esC9e2HGJRWfB2bkYLGEqAb"+ , testCase "pk2" $ do+ A.renderAddress (A.p2pkh A.btc pk2) @?=+ "1ErtkviCvV4H9a2cMCrHwb5LV1ir7aXJpF"+ ]+ , testGroup "p2wpkh"+ [ testCase "pk1" $ do+ A.renderAddress (A.p2wpkh A.btc pk1) @?=+ "bc1qtuzdvulah5rjh964328cxzjamaj4swwhj47xg6"+ , testCase "pk2" $ do+ A.renderAddress (A.p2wpkh A.btc pk2) @?=+ "bc1qnqyn3cz4jsly0de7t5tt9hnngwnp5znmk06th7"+ ]+ , testGroup "p2sh_p2wpkh"+ [ testCase "pk1" $ do+ A.renderAddress (A.p2sh_p2wpkh A.btc pk1) @?=+ "3JhVKigMH4hyZzq1MJPjwZmKY5tV5z69nC"+ , testCase "pk2" $ do+ A.renderAddress (A.p2sh_p2wpkh A.btc pk2) @?=+ "331zaDSamvQKX41nDATJPH1PKeMTQzfm22"+ ]+ , testGroup "p2sh_multiSig"+ [ testCase "1 of [pk1]" $ do+ fmap A.renderAddress (A.p2sh_multiSig A.btc [pk1] 1) @?=+ Just "3H12mXUPXvZPd4ardUEEtZnyTCyWtq5ozH"+ , testCase "1 of [pk2]" $ do+ fmap A.renderAddress (A.p2sh_multiSig A.btc [pk2] 1) @?=+ Just "3QUSu15rwtJXpLUUqGSCXG6i6j6Kv9RvQ5"+ , testCase "1 of [pk1, pk2]" $ do+ fmap A.renderAddress (A.p2sh_multiSig A.btc [pk1, pk2] 1) @?=+ Just "3Mi7MAhA2MeiLM77yYCmBYNjQMkug2fET9"+ , testCase "1 of [pk2, pk1]" $ do+ fmap A.renderAddress (A.p2sh_multiSig A.btc [pk2, pk1] 1) @?=+ Just "3PAA17FxCGdNFMjJMQWGQp1dyvxWcntDvs"+ , testCase "2 of [pk1, pk2]" $ do+ fmap A.renderAddress (A.p2sh_multiSig A.btc [pk1, pk2] 2) @?=+ Just "36i3sEMYTsECQPq6yzrhFq1mWmQRqgn6g3"+ , testCase "2 of [pk2, pk1]" $ do+ fmap A.renderAddress (A.p2sh_multiSig A.btc [pk2, pk1] 2) @?=+ Just "35CaUy8cA7xFSEFAS6mvCJbvugNS11nPBx"+ ]+ , testGroup "p2wsh_multiSig"+ [ testCase "1 of [pk1]" $ do+ fmap A.renderAddress (A.p2wsh_multiSig A.btc [pk1] 1) @?=+ Just "bc1qw2v3lcjvu0mxsqhwt673nt0t2sehhge7hamqzzqg45jyah294lsqw2j5yj"+ , testCase "1 of [pk2]" $ do+ fmap A.renderAddress (A.p2wsh_multiSig A.btc [pk2] 1) @?=+ Just "bc1q7x6l850snyxcxdlwjx3qty6rngkngxuhcjlr9a4dgk4975x6krnqzh99h6"+ , testCase "1 of [pk1, pk2]" $ do+ fmap A.renderAddress (A.p2wsh_multiSig A.btc [pk1, pk2] 1) @?=+ Just "bc1qn5xjkpyzelgs9t3y5feqv3d4qt7f54skfmz5apa9rjx5jekwhklqajj224"+ , testCase "1 of [pk2, pk1]" $ do+ fmap A.renderAddress (A.p2wsh_multiSig A.btc [pk2, pk1] 1) @?=+ Just "bc1qm29gsj6mr73kd7rg4ec848rcmujkgk05sthjcnhx2zeh09n5zcssw7j3pn"+ , testCase "2 of [pk1, pk2]" $ do+ fmap A.renderAddress (A.p2wsh_multiSig A.btc [pk2, pk1] 2) @?=+ Just "bc1qwy7gugcea2f2kckzfhvfu34raw6fevu7dhncdec5gz03ll7lxauq3t0r6u"+ , testCase "2 of [pk2, pk1]" $ do+ fmap A.renderAddress (A.p2wsh_multiSig A.btc [pk1, pk2] 2) @?=+ Just "bc1qxemuancumx68770699xahey9uqdc5qdc3572uxukdhg9wncztg3su4ecfy"+ ]+ , testGroup "p2sh_p2wsh_multiSig"+ [ testCase "pk1" $ do+ fmap A.renderAddress (A.p2sh_p2wsh_multiSig A.btc [pk1] 1) @?=+ Just "323Jncw5hBt6KL1WMSao8RrE8CtrooBt9j"+ , testCase "pk2" $ do+ fmap A.renderAddress (A.p2sh_p2wsh_multiSig A.btc [pk2] 1) @?=+ Just "39U3xFLp1KDcaixq6wyfHHsjiPvCCyVyDa"+ , testCase "1 of [pk1, pk2]" $ do+ fmap A.renderAddress (A.p2sh_p2wsh_multiSig A.btc [pk1, pk2] 1) @?=+ Just "32jA9PfdTQ74svaSQjTZPLeV98WiHEHJF3"+ , testCase "1 of [pk2, pk1]" $ do+ fmap A.renderAddress (A.p2sh_p2wsh_multiSig A.btc [pk2, pk1] 1) @?=+ Just "3GSfokgqW2G77VzTrojnPa1sNjSnYuwDuX"+ , testCase "2 of [pk1, pk2]" $ do+ fmap A.renderAddress (A.p2sh_p2wsh_multiSig A.btc [pk1, pk2] 2) @?=+ Just "3EeuEEn1uwdm2GwctKqSjBV4xPp1JiECgm"+ , testCase "2 of [pk2, pk1]" $ do+ fmap A.renderAddress (A.p2sh_p2wsh_multiSig A.btc [pk2, pk1] 2) @?=+ Just "35LhobEZN2QLpYfMfH35tTyxrxYpANBBkA"+ ]+ ]++--------------------------------------------------------------------------------++genPub :: MonadGen m => m K.Pub+genPub = go 10000 where+ go 0 = error "genPub: too many attempts"+ go n = do+ h <- Gen.element [2, 3 :: Word8]+ b <- Gen.bytes (Range.singleton 32)+ case K.parsePub (B.cons h b) of+ Just k -> pure k+ Nothing -> go (n - 1)++--------------------------------------------------------------------------------+-- BIP39 mnemonic: abandon abandon arm+--+-- BIP39 seed: 2f7b8b6eeeb7201d88ed45dcd4706ccd76e5feb61f1961990869581781f8944ae2bebff36156c6965054add29f2cf9ee8b7b488179bfba24773ce2b06ec0ce04+--+-- BIP32 Derivation path: m/44'/0'/0'/0/0+--+-- Private key WIF: L1CnCq2yTvfzngQTF4Fnh5daYUwAuysrqU5dNwZFcv33Cwu4Gf2F++pk1 :: K.Pub+Just pk1 = K.parsePub $ fromBase16+ "024ed59d3f6548c41172ec26b9144f547185cb2a9f28fccb6e3ae53dc4f1827154"++pk1hash160 :: AH.PubHash160+pk1hash160 = AH.pubHash160 pk1++--------------------------------------------------------------------------------+-- BIP39 mnemonic: abandon abandon arm+--+-- BIP39 seed: 2f7b8b6eeeb7201d88ed45dcd4706ccd76e5feb61f1961990869581781f8944ae2bebff36156c6965054add29f2cf9ee8b7b488179bfba24773ce2b06ec0ce04+--+-- BIP32 Derivation path: m/84'/0'/0'/0/0+--+-- Private key WIF: L3XRaAfqnZLCcUpcCi4g1GqMLTKvr9nbvCYBmrs1TAjx4acpZ2eY++pk2 :: K.Pub+Just pk2 = K.parsePub $ fromBase16+ "0315bd146d8b45383ad431a8204717dc9f46a7a46c1f44eeaab02d49f4511ccff0"++pk2hash160 :: AH.PubHash160+pk2hash160 = AH.pubHash160 pk2++--------------------------------------------------------------------------------++toBase16 :: B.ByteString -> B.ByteString+toBase16 = B16.encode++fromBase16 :: B.ByteString -> B.ByteString+fromBase16 a = case B16.decode a of+ (b, "") -> b+ _ -> error ("Invalid base16 string: " <> show a)+