bitcoin-scripting 0.1.0 → 0.2.0

raw patch · 19 files changed

+437/−108 lines, 19 filesdep −base16-bytestringdep ~attoparsecdep ~basedep ~haskoin-corePVP ok

version bump matches the API change (PVP)

Dependencies removed: base16-bytestring

Dependency ranges changed: attoparsec, base, haskoin-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• bitcoin-scripting.cabal +23/−13
• src/Language/Bitcoin/Miniscript/Compiler.hs +1/−1
• src/Language/Bitcoin/Miniscript/Parser.hs +1/−1
• src/Language/Bitcoin/Miniscript/Syntax.hs +1/−1
• src/Language/Bitcoin/Miniscript/Text.hs +1/−1
• src/Language/Bitcoin/Miniscript/Witness.hs +1/−1
• src/Language/Bitcoin/Script/Descriptors.hs +13/−2
• src/Language/Bitcoin/Script/Descriptors/Parser.hs +31/−17
• src/Language/Bitcoin/Script/Descriptors/Syntax.hs +52/−17
• src/Language/Bitcoin/Script/Descriptors/Text.hs +21/−13
• src/Language/Bitcoin/Script/Descriptors/Utils.hs +78/−0
• src/Language/Bitcoin/Script/Utils.hs +9/−5
• src/Language/Bitcoin/Utils.hs +14/−1
• test/Main.hs +1/−1
• test/Test/Descriptors.hs +36/−33
• test/Test/Descriptors/Utils.hs +136/−0
• test/Test/Miniscript/Compiler.hs +1/−0
• test/Test/Miniscript/Examples.hs +12/−1

@@ -1,5 +1,10 @@ # Revision history for bitcoin-scripting  +## 0.2.0++* Refactors script descriptors module in order to make invalid descriptors unrepresentable.+* Adds utility functions to compile script descriptors and produce addresses from output descriptors.+ ## 0.1.0  First release

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                bitcoin-scripting-version:             0.1.0+version:             0.2.0 synopsis:            Resources for working with miniscript, and script descriptors homepage:            https://github.com/bitnomial/bitcoin-scripting copyright:           2020 Bitnomial, Inc.@@ -12,19 +12,27 @@ build-type:          Simple extra-source-files:  CHANGELOG.md -tested-with: GHC == 8.8.4+tested-with: GHC == 8.10.4  common base   default-language: Haskell2010-  ghc-options:      -Wall+  ghc-options:+    -Wall+    -Widentities+    -Wincomplete-uni-patterns+    -Wincomplete-record-updates+    -Wpartial-fields+    -Wmissing-export-lists+    -Wmissing-home-modules+    -Wunused-packages+    -Wno-unused-do-bind+    -funbox-strict-fields   build-depends:-      base               >=4.12  && <4.15-    , base16-bytestring   <1.0-    -- ^^ Needed because of missing upper bound in haskoin-core-    , bytestring         >=0.10  && <0.12-    , cereal            ^>=0.5-    , haskoin-core       >=0.15  && <0.18-    , text               >=1.2   && <1.3+      base >=4.12 && <4.16+    , bytestring >=0.10 && <0.12+    , cereal ^>=0.5+    , haskoin-core >=0.18 && <0.21+    , text >=1.2 && <1.3  library   import:          base@@ -46,13 +54,14 @@     Language.Bitcoin.Script.Descriptors.Parser     Language.Bitcoin.Script.Descriptors.Syntax     Language.Bitcoin.Script.Descriptors.Text+    Language.Bitcoin.Script.Descriptors.Utils      Language.Bitcoin.Utils    build-depends:-      attoparsec         ^>=0.13-    , containers         ^>=0.6-    , transformers       ^>=0.5+      attoparsec >=0.13 && <0.15+    , containers ^>=0.6+    , transformers ^>=0.5  test-suite bitcoin-scripting-tests   import:          base@@ -62,6 +71,7 @@    other-modules:     Test.Descriptors+    Test.Descriptors.Utils     Test.Example     Test.Miniscript     Test.Miniscript.Compiler

@@ -37,7 +37,7 @@     MiniscriptTypeError (..),     typeCheckMiniscript,  )-import Language.Bitcoin.Script.Descriptors (KeyDescriptor, keyBytes)+import Language.Bitcoin.Script.Descriptors.Syntax (KeyDescriptor, keyBytes) import Language.Bitcoin.Script.Utils (pushNumber) import Language.Bitcoin.Utils (requiredContextValue) 

@@ -17,7 +17,7 @@     Miniscript (..),     Value (..),  )-import Language.Bitcoin.Script.Descriptors (keyDescriptorParser)+import Language.Bitcoin.Script.Descriptors.Parser (keyDescriptorParser) import Language.Bitcoin.Utils (     alphanum,     application,

@@ -30,7 +30,7 @@ import Data.Foldable (foldr') import Data.Text (Text) -import Language.Bitcoin.Script.Descriptors (KeyDescriptor)+import Language.Bitcoin.Script.Descriptors.Syntax (KeyDescriptor)  data Value a = Variable Text | Lit a     deriving (Eq, Show, Ord)

@@ -15,7 +15,7 @@     Miniscript (..),     Value (..),  )-import Language.Bitcoin.Script.Descriptors (keyDescriptorToText)+import Language.Bitcoin.Script.Descriptors.Text (keyDescriptorToText) import Language.Bitcoin.Utils (applicationText, showText)  miniscriptToText :: Network -> Miniscript -> Text

@@ -51,7 +51,7 @@     Miniscript (..),     Value (..),  )-import Language.Bitcoin.Script.Descriptors (+import Language.Bitcoin.Script.Descriptors.Syntax (     KeyDescriptor,     keyDescPubKey,  )

@@ -2,14 +2,20 @@  from <https://github.com/bitcoin/bitcoin/blob/master/doc/descriptors.md>. -} module Language.Bitcoin.Script.Descriptors (+    -- * Descriptors+    OutputDescriptor (..),     ScriptDescriptor (..),++    -- * Keys     KeyDescriptor (..),     Origin (..),     Key (..),     KeyCollection (..),+    isDefinite,+    keyAtIndex,+    keyDescPubKey,     pubKey,     secKey,-    keyDescPubKey,     keyBytes,      -- * Text representation@@ -18,11 +24,16 @@      -- * Parsing     parseDescriptor,-    descriptorParser,+    outputDescriptorParser,     parseKeyDescriptor,     keyDescriptorParser,++    -- * Conversions+    descriptorAddresses,+    compile, ) where  import Language.Bitcoin.Script.Descriptors.Parser import Language.Bitcoin.Script.Descriptors.Syntax import Language.Bitcoin.Script.Descriptors.Text+import Language.Bitcoin.Script.Descriptors.Utils

@@ -2,7 +2,7 @@  module Language.Bitcoin.Script.Descriptors.Parser (     parseDescriptor,-    descriptorParser,+    outputDescriptorParser,     parseKeyDescriptor,     keyDescriptorParser, ) where@@ -36,29 +36,43 @@     maybeFail,  ) -parseDescriptor :: Network -> Text -> Either String ScriptDescriptor-parseDescriptor net = A.parseOnly $ descriptorParser net+parseDescriptor :: Network -> Text -> Either String OutputDescriptor+parseDescriptor net = A.parseOnly $ outputDescriptorParser net -descriptorParser :: Network -> Parser ScriptDescriptor-descriptorParser net =-    shP <|> wshP <|> pkP <|> pkhP <|> wpkhP <|> comboP <|> rawP <|> addrP-        <|> multiP-        <|> sortedMultiP+outputDescriptorParser :: Network -> Parser OutputDescriptor+outputDescriptorParser net =+    spkP+        <|> shP+        <|> wpkhP+        <|> wshP+        <|> shwpkhP+        <|> shwshP+        <|> comboP+        <|> addrP   where-    dp = descriptorParser net-    kp = keyDescriptorParser net+    sdP = scriptDescriptorParser net+    keyP = keyDescriptorParser net -    shP = Sh <$> application "sh" dp-    wshP = Wsh <$> application "wsh" dp-    pkP = Pk <$> application "pk" kp-    pkhP = Pkh <$> application "pkh" kp-    wpkhP = Wpkh <$> application "wpkh" kp-    comboP = Combo <$> application "combo" kp-    rawP = Raw <$> application "raw" hex+    spkP = ScriptPubKey <$> sdP+    shP = P2SH <$> application "sh" sdP+    wshP = P2WSH <$> application "wsh" sdP+    wpkhP = P2WPKH <$> application "wpkh" keyP+    shwpkhP = WrappedWPkh <$> (application "sh" . application "wpkh") keyP+    shwshP = WrappedWSh <$> (application "sh" . application "wsh") sdP+    comboP = Combo <$> application "combo" keyP      addrP =         application "addr" (A.manyTill A.anyChar $ A.char ')')             >>= maybeFail "descriptorParser: unable to parse address" Addr . textToAddr net . pack++scriptDescriptorParser :: Network -> Parser ScriptDescriptor+scriptDescriptorParser net = pkP <|> pkhP <|> rawP <|> multiP <|> sortedMultiP+  where+    kp = keyDescriptorParser net++    rawP = Raw <$> application "raw" hex+    pkP = Pk <$> application "pk" kp+    pkhP = Pkh <$> application "pkh" kp      multiP = application "multi" $ Multi <$> A.decimal <*> comma keyList     sortedMultiP = application "sortedmulti" $ SortedMulti <$> A.decimal <*> comma keyList

@@ -1,47 +1,67 @@+{-# LANGUAGE LambdaCase #-}+ module Language.Bitcoin.Script.Descriptors.Syntax (+    OutputDescriptor (..),     ScriptDescriptor (..),     KeyDescriptor (..),+    isDefinite,+    keyAtIndex,+    keyDescPubKey,+    keyBytes,     Origin (..),     Key (..),     KeyCollection (..),     pubKey,     secKey,-    keyDescPubKey,-    keyBytes, ) where  import Data.ByteString (ByteString)-import Haskoin.Address (Address)-import Haskoin.Keys (+import Data.Word (Word32)+import Haskoin (+    Address,     DerivPath,+    DerivPathI ((:/), (:|)),     Fingerprint,     PubKeyI (..),     SecKeyI,-    XPubKey,+    XPubKey (xPubKey),     derivePubKeyI,+    derivePubPath,     exportPubKey,+    toSoft,  ) -data ScriptDescriptor-    = -- | P2SH embed the argument.-      Sh ScriptDescriptor-    | -- | P2WSH embed the argument.-      Wsh ScriptDescriptor-    | -- | P2PK output for the given public key.-      Pk KeyDescriptor-    | -- | P2PKH output for the given public key (use 'Addr' if you only know the pubkey hash).-      Pkh KeyDescriptor+-- | High level description for a bitcoin output+data OutputDescriptor+    = -- | The output is secured by the given script.+      ScriptPubKey ScriptDescriptor+    | -- | P2SH embed the argument.+      P2SH ScriptDescriptor     | -- | P2WPKH output for the given compressed pubkey.-      Wpkh KeyDescriptor+      P2WPKH KeyDescriptor+    | -- | P2WSH embed the argument.+      P2WSH ScriptDescriptor+    | -- | P2SH-P2WPKH the given compressed pubkey.+      WrappedWPkh KeyDescriptor+    | -- | P2SH-P2WSH the given script+      WrappedWSh ScriptDescriptor     | -- | An alias for the collection of pk(KEY) and pkh(KEY). If the key is       -- compressed, it also includes wpkh(KEY) and sh(wpkh(KEY)).       Combo KeyDescriptor+    | -- | The script which ADDR expands to.+      Addr Address+    deriving (Eq, Show)++-- | High level description of a bitcoin script+data ScriptDescriptor+    = -- | Require a signature for this key+      Pk KeyDescriptor+    | -- | Require a key matching this hash and a signature for that key+      Pkh KeyDescriptor     | -- | k-of-n multisig script.       Multi Int [KeyDescriptor]     | -- | k-of-n multisig script with keys sorted lexicographically in the resulting script.       SortedMulti Int [KeyDescriptor]-    | -- | the script which ADDR expands to.-      Addr Address     | -- | the script whose hex encoding is HEX.       Raw ByteString     deriving (Eq, Show)@@ -74,6 +94,13 @@ secKey :: SecKeyI -> KeyDescriptor secKey = KeyDescriptor Nothing . SecretKey +-- | For key families, get the key at the given index.  Otherwise, return the input key.+keyAtIndex :: Word32 -> Key -> Key+keyAtIndex ix = \case+    XPub xpub path HardKeys -> XPub xpub (path :| ix) Single+    XPub xpub path SoftKeys -> XPub xpub (path :/ ix) Single+    key -> key+ -- | Represent whether the key corresponds to a collection (and how) or a single key. data KeyCollection     = Single@@ -94,4 +121,12 @@ keyDescPubKey (KeyDescriptor _ k) = case k of     Pubkey pk -> Just pk     SecretKey sk -> Just $ derivePubKeyI sk+    XPub xpub path Single -> (`PubKeyI` True) . xPubKey . (`derivePubPath` xpub) <$> toSoft path     _ -> Nothing++-- | Test whether the key descriptor corresponds to a single key+isDefinite :: KeyDescriptor -> Bool+isDefinite (KeyDescriptor _ k) = case k of+    XPub _ _ HardKeys -> False+    XPub _ _ SoftKeys -> False+    _ -> True

@@ -35,25 +35,33 @@     showText,  ) -descriptorToText :: Network -> ScriptDescriptor -> Text+descriptorToText :: Network -> OutputDescriptor -> Text descriptorToText net = \case-    Sh x -> applicationText "sh" $ pd x-    Wsh x -> applicationText "wsh" $ pd x-    Pk k -> applicationText "pk" $ pk k-    Pkh k -> applicationText "pkh" $ pk k-    Wpkh k -> applicationText "wpkh" $ pk k-    Combo k -> applicationText "combo" $ pk k+    ScriptPubKey x -> sdToText x+    P2SH x -> applicationText "sh" $ sdToText x+    P2WPKH k -> applicationText "wpkh" $ keyToText k+    P2WSH x -> applicationText "wsh" $ sdToText x+    WrappedWPkh k -> applicationText "sh" . applicationText "wpkh" $ keyToText k+    WrappedWSh x -> applicationText "sh" . applicationText "wsh" $ sdToText x+    Combo k -> applicationText "combo" $ keyToText k     Addr a -> applicationText "addr" . fromMaybe addrErr $ addrToText net a+  where+    sdToText = scriptDescriptorToText net+    keyToText = keyDescriptorToText net++    addrErr = error "Unable to parse address"++scriptDescriptorToText :: Network -> ScriptDescriptor -> Text+scriptDescriptorToText net = \case+    Pk k -> applicationText "pk" $ keyToText k+    Pkh k -> applicationText "pkh" $ keyToText k     Raw bs -> applicationText "raw" $ encodeHex bs     Multi k ks ->-        applicationText "multi" . intercalate "," $ showText k : (pk <$> ks)+        applicationText "multi" . intercalate "," $ showText k : (keyToText <$> ks)     SortedMulti k ks ->-        applicationText "sortedmulti" . intercalate "," $ showText k : (pk <$> ks)+        applicationText "sortedmulti" . intercalate "," $ showText k : (keyToText <$> ks)   where-    pd = descriptorToText net-    pk = keyDescriptorToText net--    addrErr = error "Unable to parse address"+    keyToText = keyDescriptorToText net  keyDescriptorToText :: Network -> KeyDescriptor -> Text keyDescriptorToText net (KeyDescriptor o k) = maybe mempty originText o <> definitionText

@@ -0,0 +1,78 @@+{-# LANGUAGE LambdaCase #-}++module Language.Bitcoin.Script.Descriptors.Utils (+    descriptorAddresses,+    compile,+) where++import Data.List (sortOn)+import Data.Maybe (maybeToList)+import Data.Serialize (decode, encode)+import Haskoin (+    Address,+    Script,+    ScriptOutput (..),+    addressHash,+    eitherToMaybe,+    payToNestedScriptAddress,+    payToScriptAddress,+    payToWitnessScriptAddress,+    pubKeyAddr,+    pubKeyCompatWitnessAddr,+    pubKeyCompressed,+    pubKeyWitnessAddr,+    sortMulSig,+ )++import qualified Language.Bitcoin.Miniscript as M+import Language.Bitcoin.Script.Descriptors.Syntax (+    OutputDescriptor (..),+    ScriptDescriptor (..),+    keyBytes,+    keyDescPubKey,+ )++{- | Get the set of addresses associated with an output descriptor.  The list will be empty if:++     * any keys are indefinite+     * the output is p2pk+     * the output has a non-standard script++     The list can contain more than one address in the case of the "combo" construct.+-}+descriptorAddresses :: OutputDescriptor -> [Address]+descriptorAddresses = \case+    ScriptPubKey Pk{} -> mempty+    ScriptPubKey (Pkh key) -> foldMap (pure . pubKeyAddr) $ keyDescPubKey key+    P2SH descriptor -> maybeToList $ payToScriptAddress <$> scriptDescriptorOutput descriptor+    P2WPKH key -> foldMap (pure . pubKeyWitnessAddr) $ keyDescPubKey key+    P2WSH descriptor -> maybeToList $ payToWitnessScriptAddress <$> scriptDescriptorOutput descriptor+    WrappedWPkh key -> foldMap (pure . pubKeyCompatWitnessAddr) $ keyDescPubKey key+    WrappedWSh descriptor -> maybeToList $ payToNestedScriptAddress <$> scriptDescriptorOutput descriptor+    Combo key+        | Just pk <- keyDescPubKey key ->+            [pubKeyAddr pk]+                <> if pubKeyCompressed pk+                    then [pubKeyWitnessAddr pk, pubKeyCompatWitnessAddr pk]+                    else mempty+    Addr addr -> [addr]+    _ -> mempty++scriptDescriptorOutput :: ScriptDescriptor -> Maybe ScriptOutput+scriptDescriptorOutput = \case+    Pk key -> PayPK <$> keyDescPubKey key+    Pkh key -> PayPKHash . addressHash . encode <$> keyDescPubKey key+    Multi k ks -> PayMulSig <$> traverse keyDescPubKey ks <*> pure k+    SortedMulti k ks -> sortMulSig <$> (PayMulSig <$> traverse keyDescPubKey ks <*> pure k)+    _ -> Nothing++-- | Produce the script described by the descriptor.  Fails when any keys in the descriptor are indeterminate.+compile :: ScriptDescriptor -> Maybe Script+compile = \case+    Pk key -> compileMaybe $ M.key key+    Pkh key -> compileMaybe $ M.keyH key+    Multi k ks -> compileMaybe $ M.multi k ks+    SortedMulti k ks -> compileMaybe $ M.multi k (sortOn keyBytes ks)+    Raw bs -> eitherToMaybe (decode bs)+  where+    compileMaybe = eitherToMaybe . M.compile

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+ module Language.Bitcoin.Script.Utils (     pushNumber,     toCScriptNum,@@ -8,15 +10,15 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Word (Word8)-import Haskoin.Script (ScriptOp, opPushData)+import Haskoin (ScriptOp, intToScriptOp, opPushData)  -- | Decode a numeric stack value fromCScriptNum :: ByteString -> Int fromCScriptNum b     | BS.null b = 0-    | msb == 0x80 = negate . fromIntegral $ leWord64 b'-    | testBit msb 7 = negate . fromIntegral . leWord64 $ BS.snoc b' (clearBit msb 7)-    | otherwise = fromIntegral $ leWord64 b+    | msb == 0x80 = negate $ leWord64 b'+    | testBit msb 7 = negate . leWord64 $ BS.snoc b' (clearBit msb 7)+    | otherwise = leWord64 b   where     Just (b', msb) = BS.unsnoc b @@ -33,7 +35,9 @@     b = BS.snoc b' msb  pushNumber :: Int -> ScriptOp-pushNumber = opPushData . toCScriptNum+pushNumber i+    | i <= 16 = intToScriptOp i+    | otherwise = opPushData $ toCScriptNum i  intLE :: Int -> (ByteString, Word8) intLE = go mempty . abs

@@ -1,7 +1,20 @@ {-# LANGUAGE OverloadedStrings #-}  -- |  Various parsing and printing utilities-module Language.Bitcoin.Utils where+module Language.Bitcoin.Utils (+    parens,+    brackets,+    application,+    hex,+    comma,+    argList,+    alphanum,+    spacePadded,+    showText,+    applicationText,+    requiredContextValue,+    maybeFail,+) where  import Control.Applicative ((<|>)) import Control.Monad (void)

@@ -1,4 +1,4 @@-module Main where+module Main (main) where  import Test.Tasty (defaultMain, testGroup) 

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  -- | We took these examples from <https://github.com/bitcoin/bitcoin/blob/master/doc/descriptors.md> module Test.Descriptors (@@ -21,17 +22,19 @@     KeyCollection (..),     KeyDescriptor (..),     Origin (..),+    OutputDescriptor (..),     ScriptDescriptor (..),     descriptorToText,     parseDescriptor,  )-+import Test.Descriptors.Utils (testDescriptorUtils) import Test.Example (Example (..), testTextRep)  descriptorTests :: TestTree descriptorTests =     testGroup "descriptor tests" $-        testTextRep (parseDescriptor btc) (descriptorToText btc) <$> examples+        (testTextRep (parseDescriptor btc) (descriptorToText btc) <$> examples)+            <> [testDescriptorUtils]   where     examples =         [ example1@@ -60,47 +63,47 @@   where     Just k = importPubKey =<< decodeHex h -example1 :: Example ScriptDescriptor+example1 :: Example OutputDescriptor example1 =     Example         { name = "pk"         , text = "pk(0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798)"-        , script = Pk $ key k+        , script = ScriptPubKey . Pk $ key k         }   where     k = hexPubkey "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" -example2 :: Example ScriptDescriptor+example2 :: Example OutputDescriptor example2 =     Example         { name = "pkh"         , text = "pkh(02c6047f9441ed7d6d3045406e95c07cd85c778e4b8cef3ca7abac09b95c709ee5)"-        , script = Pkh $ key k+        , script = ScriptPubKey . Pkh $ key k         }   where     k = hexPubkey "02c6047f9441ed7d6d3045406e95c07cd85c778e4b8cef3ca7abac09b95c709ee5" -example3 :: Example ScriptDescriptor+example3 :: Example OutputDescriptor example3 =     Example         { name = "wpkh"         , text = "wpkh(02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9)"-        , script = Wpkh $ key k+        , script = P2WPKH $ key k         }   where     k = hexPubkey "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9" -example4 :: Example ScriptDescriptor+example4 :: Example OutputDescriptor example4 =     Example         { name = "p2sh-p2wpkh"         , text = "sh(wpkh(03fff97bd5755eeea420453a14355235d382f6472f8568a18b2f057a1460297556))"-        , script = Sh . Wpkh $ key k+        , script = WrappedWPkh $ key k         }   where     k = hexPubkey "03fff97bd5755eeea420453a14355235d382f6472f8568a18b2f057a1460297556" -example5 :: Example ScriptDescriptor+example5 :: Example OutputDescriptor example5 =     Example         { name = "combo"@@ -110,56 +113,56 @@   where     k = hexPubkey "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" -example6 :: Example ScriptDescriptor+example6 :: Example OutputDescriptor example6 =     Example         { name = "p2sh-p2wsh-p2pkh"         , text = "sh(wsh(pkh(02e493dbf1c10d80f3581e4904930b1404cc6c13900ee0758474fa94abe8c4cd13)))"-        , script = Sh . Wsh . Pkh $ key k+        , script = WrappedWSh . Pkh $ key k         }   where     k = hexPubkey "02e493dbf1c10d80f3581e4904930b1404cc6c13900ee0758474fa94abe8c4cd13" -example7 :: Example ScriptDescriptor+example7 :: Example OutputDescriptor example7 =     Example         { name = "multi"         , text =             "multi(1,022f8bde4d1a07209355b4a7250a5c5128e88b84bddc619ab7cba8d569b240efe4,\             \025cbdf0646e5db4eaa398f365f2ea7a0e3d419b7e0330e39ce92bddedcac4f9bc)"-        , script = Multi 1 [key k1, key k2]+        , script = ScriptPubKey $ Multi 1 [key k1, key k2]         }   where     k1 = hexPubkey "022f8bde4d1a07209355b4a7250a5c5128e88b84bddc619ab7cba8d569b240efe4"     k2 = hexPubkey "025cbdf0646e5db4eaa398f365f2ea7a0e3d419b7e0330e39ce92bddedcac4f9bc" -example8 :: Example ScriptDescriptor+example8 :: Example OutputDescriptor example8 =     Example         { name = "p2sh-multisig"         , text =             "sh(multi(2,022f01e5e15cca351daff3843fb70f3c2f0a1bdd05e5af888a67784ef3e10a2a01,\             \03acd484e2f0c7f65309ad178a9f559abde09796974c57e714c35f110dfc27ccbe))"-        , script = Sh $ Multi 2 [key k1, key k2]+        , script = P2SH $ Multi 2 [key k1, key k2]         }   where     k1 = hexPubkey "022f01e5e15cca351daff3843fb70f3c2f0a1bdd05e5af888a67784ef3e10a2a01"     k2 = hexPubkey "03acd484e2f0c7f65309ad178a9f559abde09796974c57e714c35f110dfc27ccbe" -example9 :: Example ScriptDescriptor+example9 :: Example OutputDescriptor example9 =     Example         { name = "p2sh-multisig lexicographic"         , text =             "sh(sortedmulti(2,03acd484e2f0c7f65309ad178a9f559abde09796974c57e714c35f110dfc27ccbe,\             \022f01e5e15cca351daff3843fb70f3c2f0a1bdd05e5af888a67784ef3e10a2a01))"-        , script = Sh $ SortedMulti 2 [key k1, key k2]+        , script = P2SH $ SortedMulti 2 [key k1, key k2]         }   where     k1 = hexPubkey "03acd484e2f0c7f65309ad178a9f559abde09796974c57e714c35f110dfc27ccbe"     k2 = hexPubkey "022f01e5e15cca351daff3843fb70f3c2f0a1bdd05e5af888a67784ef3e10a2a01" -example10 :: Example ScriptDescriptor+example10 :: Example OutputDescriptor example10 =     Example         { name = "p2wsh-multi"@@ -167,14 +170,14 @@             "wsh(multi(2,03a0434d9e47f3c86235477c7b1ae6ae5d3442d49b1943c2b752a68e2a47e247c7,\             \03774ae7f858a9411e5ef4246b70c65aac5649980be5c17891bbec17895da008cb,\             \03d01115d548e7561b15c38f004d734633687cf4419620095bc5b0f47070afe85a))"-        , script = Wsh $ Multi 2 [key k1, key k2, key k3]+        , script = P2WSH $ Multi 2 [key k1, key k2, key k3]         }   where     k1 = hexPubkey "03a0434d9e47f3c86235477c7b1ae6ae5d3442d49b1943c2b752a68e2a47e247c7"     k2 = hexPubkey "03774ae7f858a9411e5ef4246b70c65aac5649980be5c17891bbec17895da008cb"     k3 = hexPubkey "03d01115d548e7561b15c38f004d734633687cf4419620095bc5b0f47070afe85a" -example11 :: Example ScriptDescriptor+example11 :: Example OutputDescriptor example11 =     Example         { name = "p2sh-p2wsh-mulisig"@@ -182,45 +185,45 @@             "sh(wsh(multi(1,03f28773c2d975288bc7d1d205c3748651b075fbc6610e58cddeeddf8f19405aa8,\             \03499fdf9e895e719cfd64e67f07d38e3226aa7b63678949e6e49b241a60e823e4,\             \02d7924d4f7d43ea965a465ae3095ff41131e5946f3c85f79e44adbcf8e27e080e)))"-        , script = Sh . Wsh $ Multi 1 [key k1, key k2, key k3]+        , script = WrappedWSh $ Multi 1 [key k1, key k2, key k3]         }   where     k1 = hexPubkey "03f28773c2d975288bc7d1d205c3748651b075fbc6610e58cddeeddf8f19405aa8"     k2 = hexPubkey "03499fdf9e895e719cfd64e67f07d38e3226aa7b63678949e6e49b241a60e823e4"     k3 = hexPubkey "02d7924d4f7d43ea965a465ae3095ff41131e5946f3c85f79e44adbcf8e27e080e" -example12 :: Example ScriptDescriptor+example12 :: Example OutputDescriptor example12 =     Example         { name = "xpub"         , text = "pk(xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8)"-        , script = Pk $ KeyDescriptor Nothing (XPub xpub Deriv Single)+        , script = ScriptPubKey . Pk $ KeyDescriptor Nothing (XPub xpub Deriv Single)         }   where     Just xpub = xPubImport btc "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8" -example13 :: Example ScriptDescriptor+example13 :: Example OutputDescriptor example13 =     Example         { name = "p2pkh-xpub with derivation"         , text = "pkh(xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw/1'/2)"-        , script = Pkh $ KeyDescriptor Nothing (XPub xpub (Deriv :| 1 :/ 2) Single)+        , script = ScriptPubKey . Pkh $ KeyDescriptor Nothing (XPub xpub (Deriv :| 1 :/ 2) Single)         }   where     Just xpub = xPubImport btc "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw" -example14 :: Example ScriptDescriptor+example14 :: Example OutputDescriptor example14 =     Example         { name = "pkh-xpub with origin and collection spec"         , text = "pkh([d34db33f/44'/0'/0']xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL/1/*)"-        , script = Pkh $ KeyDescriptor (Just (Origin fp (Deriv :| 44 :| 0 :| 0))) (XPub xpub (Deriv :/ 1) SoftKeys)+        , script = ScriptPubKey . Pkh $ KeyDescriptor (Just (Origin fp (Deriv :| 44 :| 0 :| 0))) (XPub xpub (Deriv :/ 1) SoftKeys)         }   where     Just xpub = xPubImport btc "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL"     fp = 0xd34db33f -example15 :: Example ScriptDescriptor+example15 :: Example OutputDescriptor example15 =     Example         { name = "wsh-multisig xpub collections"@@ -228,7 +231,7 @@             "wsh(multi(1,xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB/1/0/*,\             \xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH/0/0/*))"         , script =-            Wsh $+            P2WSH $                 Multi                     1                     [ KeyDescriptor Nothing (XPub xpub1 (Deriv :/ 1 :/ 0) SoftKeys)@@ -239,7 +242,7 @@     Just xpub1 = xPubImport btc "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB"     Just xpub2 = xPubImport btc "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH" -example16 :: Example ScriptDescriptor+example16 :: Example OutputDescriptor example16 =     Example         { name = "wsh-multi sorted"@@ -247,7 +250,7 @@             "wsh(sortedmulti(1,xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB/1/0/*,\             \xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH/0/0/*))"         , script =-            Wsh $+            P2WSH $                 SortedMulti                     1                     [ KeyDescriptor Nothing (XPub xpub1 (Deriv :/ 1 :/ 0) SoftKeys)

@@ -0,0 +1,136 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++module Test.Descriptors.Utils (+    testDescriptorUtils,+) where++import qualified Data.ByteString as BS+import Data.List (sort)+import Data.Maybe (mapMaybe)+import Data.Serialize (encode)+import Haskoin (+    PubKeyI (PubKeyI),+    Script (Script),+    ScriptOp (..),+    btcRegTest,+    derivePubKey,+    opPushData,+    ripemd160,+    secKey,+    textToAddr,+ )+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++import Language.Bitcoin.Script.Descriptors (+    OutputDescriptor (..),+    ScriptDescriptor (..),+    compile,+    descriptorAddresses,+    pubKey,+ )++testDescriptorUtils :: TestTree+testDescriptorUtils = testGroup "descriptor utils" [testCompile, testAddresses]++-- Address tests generated using @bitcoin-cli deriveaddresses@+testAddresses :: TestTree+testAddresses =+    testGroup+        "addresses"+        [ testP2PKH+        , testP2SH+        , testP2WPKH+        , testP2WSH+        , testWrappedWPhk+        , testWrappedWSh+        , testCombo+        ]++testP2PKH :: TestTree+testP2PKH = testCase "P2PKH" $ descriptorAddresses example @?= [expected]+  where+    example = ScriptPubKey . Pkh $ pubKey key0+    Just expected = textToAddr btcRegTest "mrCDrCybB6J1vRfbwM5hemdJz73FwDBC8r"++testP2SH :: TestTree+testP2SH = testCase "P2SH" $ descriptorAddresses example @?= [expected]+  where+    example = P2SH $ SortedMulti 2 ks+    Just expected = textToAddr btcRegTest "2MuFU6ZyBLtDNadMA6RnwJdXGWUSUaoKLeS"+    ks = pubKey <$> take 3 testPubKeys++testP2WPKH :: TestTree+testP2WPKH = testCase "P2WPKH" $ descriptorAddresses example @?= [expected]+  where+    example = P2WPKH $ pubKey key0+    Just expected = textToAddr btcRegTest "bcrt1qw508d6qejxtdg4y5r3zarvary0c5xw7kygt080"++testP2WSH :: TestTree+testP2WSH = testCase "P2WSH" $ descriptorAddresses example @?= [expected]+  where+    example = P2WSH . Pkh $ pubKey key0+    Just expected = textToAddr btcRegTest "bcrt1q8a9wr6e7whe40py3sywj066euga9zt8ep3emz0r2e4zfna7y629sq89pz7"++testWrappedWPhk :: TestTree+testWrappedWPhk = testCase "Wrapped P2WPKH" $ descriptorAddresses example @?= [expected]+  where+    example = WrappedWPkh $ pubKey key0+    Just expected = textToAddr btcRegTest "2NAUYAHhujozruyzpsFRP63mbrdaU5wnEpN"++testWrappedWSh :: TestTree+testWrappedWSh = testCase "Wrapped P2WSH" $ descriptorAddresses example @?= [expected]+  where+    example = WrappedWSh $ SortedMulti 2 ks+    ks = pubKey <$> take 3 testPubKeys+    Just expected = textToAddr btcRegTest "2NBbyaKyqn2AhMzSnQZrVPAW46KW1it9v7r"++testCombo :: TestTree+testCombo = testCase "Combo" $ sort (descriptorAddresses example) @?= sort expected+  where+    example = Combo $ pubKey key0+    Just expected =+        traverse+            (textToAddr btcRegTest)+            [ "mrCDrCybB6J1vRfbwM5hemdJz73FwDBC8r"+            , "bcrt1qw508d6qejxtdg4y5r3zarvary0c5xw7kygt080"+            , "2NAUYAHhujozruyzpsFRP63mbrdaU5wnEpN"+            ]++testCompile :: TestTree+testCompile = testGroup "compile" [testPk, testPkh, testMulti, testSortedMulti]++testPk :: TestTree+testPk = testCase "Pk" $ compile example @?= Just expected+  where+    example = Pk $ pubKey key0+    expected = Script [opPushData (encode key0), OP_CHECKSIG]++testPkh :: TestTree+testPkh = testCase "Pkh" $ compile example @?= Just expected+  where+    example = Pkh $ pubKey key0+    expected = Script [OP_DUP, OP_HASH160, opPushData (encode keyHash), OP_EQUALVERIFY, OP_CHECKSIG]+    keyHash = ripemd160 $ encode key0++testMulti :: TestTree+testMulti = testCase "Multi" $ compile example @?= Just expected+  where+    example = Multi 2 $ pubKey <$> ks+    expected = Script [OP_2, opPushData (encode k0), opPushData (encode k1), opPushData (encode k2), OP_3, OP_CHECKMULTISIG]+    ks@[k0, k1, k2] = take 3 testPubKeys++testSortedMulti :: TestTree+testSortedMulti = testCase "SortedMulti" $ compile example @?= Just expected+  where+    example = SortedMulti 2 $ pubKey <$> ks+    expected = Script [OP_2, opPushData k0, opPushData k1, opPushData k2, OP_3, OP_CHECKMULTISIG]+    ks = take 3 testPubKeys+    [k0, k1, k2] = sort $ encode <$> ks++key0 :: PubKeyI+testPubKeys :: [PubKeyI]+testPubKeys@(key0 : _) = (`PubKeyI` True) . derivePubKey <$> mapMaybe (secKey . mkSecKey) [1 .. 255]+  where+    mkSecKey i = BS.pack $ replicate 31 0 <> [i]

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  module Test.Miniscript.Compiler (     compilerTests,

@@ -1,6 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} -module Test.Miniscript.Examples where+module Test.Miniscript.Examples (+    example1,+    example2,+    example3,+    example4,+    example5,+    example6,+    example7,+    example8,+    example9,+    example10,+) where  import Data.Text (Text) import Language.Bitcoin.Miniscript (