{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
module Language.Bitcoin.Script.Descriptors.Utils (
descriptorAddresses,
compile,
TransactionScripts (..),
outputDescriptorScripts,
keyAtIndex,
keyDescriptorAtIndex,
scriptDescriptorAtIndex,
outputDescriptorAtIndex,
outputDescriptorPubKeys,
scriptDescriptorPubKeys,
toPsbtInput,
PsbtInputError (..),
) where
import Control.Applicative ((<|>))
import Control.Exception (Exception)
import Data.Functor ((<&>))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List (sortOn)
import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
import Data.Serialize (decode, encode)
import qualified Data.Serialize as S
import Data.Word (Word32)
import Haskoin (
Address,
DerivPath,
DerivPathI ((:/), (:|)),
Fingerprint,
Input,
KeyIndex,
PubKeyI (..),
Script,
ScriptOutput (..),
Tx,
addressHash,
eitherToMaybe,
emptyInput,
encodeOutput,
inputHDKeypaths,
inputRedeemScript,
inputWitnessScript,
nonWitnessUtxo,
pathToList,
payToNestedScriptAddress,
payToScriptAddress,
payToWitnessScriptAddress,
pubKeyAddr,
pubKeyCompatWitnessAddr,
pubKeyCompressed,
pubKeyWitnessAddr,
sortMulSig,
toP2SH,
toP2WSH,
txOut,
witnessUtxo,
xPubFP,
(++/),
)
import qualified Language.Bitcoin.Miniscript.Compiler as M (
compile,
)
import qualified Language.Bitcoin.Miniscript.Syntax as M (
key,
keyH,
multi,
)
import Language.Bitcoin.Script.Descriptors.Syntax (
Key (XPub),
KeyCollection (..),
KeyDescriptor (KeyDescriptor, keyDef),
OutputDescriptor (..),
ScriptDescriptor (..),
derivation,
fingerprint,
keyBytes,
keyDescPubKey,
)
descriptorAddresses :: OutputDescriptor -> [Address]
descriptorAddresses :: OutputDescriptor -> [Address]
descriptorAddresses = \case
ScriptPubKey Pk{} -> forall a. Monoid a => a
mempty
ScriptPubKey (Pkh KeyDescriptor
key) -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Address
pubKeyAddr) forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
key
P2SH ScriptDescriptor
descriptor -> forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Address
payToScriptAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptDescriptor -> Maybe ScriptOutput
scriptDescriptorOutput ScriptDescriptor
descriptor
P2WPKH KeyDescriptor
key -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Address
pubKeyWitnessAddr) forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
key
P2WSH ScriptDescriptor
descriptor -> forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Address
payToWitnessScriptAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptDescriptor -> Maybe ScriptOutput
scriptDescriptorOutput ScriptDescriptor
descriptor
WrappedWPkh KeyDescriptor
key -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Address
pubKeyCompatWitnessAddr) forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
key
WrappedWSh ScriptDescriptor
descriptor -> forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Address
payToNestedScriptAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptDescriptor -> Maybe ScriptOutput
scriptDescriptorOutput ScriptDescriptor
descriptor
Combo KeyDescriptor
key
| Just PubKeyI
pk <- KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
key ->
[PubKeyI -> Address
pubKeyAddr PubKeyI
pk]
forall a. Semigroup a => a -> a -> a
<> if PubKeyI -> Bool
pubKeyCompressed PubKeyI
pk
then [PubKeyI -> Address
pubKeyWitnessAddr PubKeyI
pk, PubKeyI -> Address
pubKeyCompatWitnessAddr PubKeyI
pk]
else forall a. Monoid a => a
mempty
Addr Address
addr -> [Address
addr]
OutputDescriptor
_ -> forall a. Monoid a => a
mempty
scriptDescriptorOutput :: ScriptDescriptor -> Maybe ScriptOutput
scriptDescriptorOutput :: ScriptDescriptor -> Maybe ScriptOutput
scriptDescriptorOutput = \case
Pk KeyDescriptor
key -> PubKeyI -> ScriptOutput
PayPK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
key
Pkh KeyDescriptor
key -> Hash160 -> ScriptOutput
PayPKHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ByteArrayAccess b => b -> Hash160
addressHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
key
Multi Int
k [KeyDescriptor]
ks -> [PubKeyI] -> Int -> ScriptOutput
PayMulSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse KeyDescriptor -> Maybe PubKeyI
keyDescPubKey [KeyDescriptor]
ks forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k
SortedMulti Int
k [KeyDescriptor]
ks -> ScriptOutput -> ScriptOutput
sortMulSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([PubKeyI] -> Int -> ScriptOutput
PayMulSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse KeyDescriptor -> Maybe PubKeyI
keyDescPubKey [KeyDescriptor]
ks forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
k)
ScriptDescriptor
_ -> forall a. Maybe a
Nothing
compile :: ScriptDescriptor -> Maybe Script
compile :: ScriptDescriptor -> Maybe Script
compile = \case
Pk KeyDescriptor
key -> Miniscript -> Maybe Script
compileMaybe forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Miniscript
M.key KeyDescriptor
key
Pkh KeyDescriptor
key -> Miniscript -> Maybe Script
compileMaybe forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Miniscript
M.keyH KeyDescriptor
key
Multi Int
k [KeyDescriptor]
ks -> Miniscript -> Maybe Script
compileMaybe forall a b. (a -> b) -> a -> b
$ Int -> [KeyDescriptor] -> Miniscript
M.multi Int
k [KeyDescriptor]
ks
SortedMulti Int
k [KeyDescriptor]
ks -> Miniscript -> Maybe Script
compileMaybe forall a b. (a -> b) -> a -> b
$ Int -> [KeyDescriptor] -> Miniscript
M.multi Int
k (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn KeyDescriptor -> Maybe ByteString
keyBytes [KeyDescriptor]
ks)
Raw ByteString
bs -> forall a b. Either a b -> Maybe b
eitherToMaybe (forall a. Serialize a => ByteString -> Either String a
decode ByteString
bs)
where
compileMaybe :: Miniscript -> Maybe Script
compileMaybe = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Miniscript -> Either CompilerError Script
M.compile
data TransactionScripts = TransactionScripts
{ TransactionScripts -> Script
txScriptPubKey :: Script
, TransactionScripts -> Maybe Script
txRedeemScript :: Maybe Script
, TransactionScripts -> Maybe Script
txWitnessScript :: Maybe Script
}
deriving (TransactionScripts -> TransactionScripts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionScripts -> TransactionScripts -> Bool
$c/= :: TransactionScripts -> TransactionScripts -> Bool
== :: TransactionScripts -> TransactionScripts -> Bool
$c== :: TransactionScripts -> TransactionScripts -> Bool
Eq, Int -> TransactionScripts -> ShowS
[TransactionScripts] -> ShowS
TransactionScripts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionScripts] -> ShowS
$cshowList :: [TransactionScripts] -> ShowS
show :: TransactionScripts -> String
$cshow :: TransactionScripts -> String
showsPrec :: Int -> TransactionScripts -> ShowS
$cshowsPrec :: Int -> TransactionScripts -> ShowS
Show)
outputDescriptorScripts :: OutputDescriptor -> Maybe TransactionScripts
outputDescriptorScripts :: OutputDescriptor -> Maybe TransactionScripts
outputDescriptorScripts =
\case
ScriptPubKey ScriptDescriptor
sd ->
ScriptDescriptor -> Maybe Script
compile ScriptDescriptor
sd forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Script
theScriptPubKey ->
TransactionScripts
{ txScriptPubKey :: Script
txScriptPubKey = Script
theScriptPubKey
, txRedeemScript :: Maybe Script
txRedeemScript = forall a. Maybe a
Nothing
, txWitnessScript :: Maybe Script
txWitnessScript = forall a. Maybe a
Nothing
}
P2SH ScriptDescriptor
sd ->
ScriptDescriptor -> Maybe Script
compile ScriptDescriptor
sd forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Script
theScript ->
TransactionScripts
{ txScriptPubKey :: Script
txScriptPubKey = ScriptOutput -> Script
encodeOutput forall a b. (a -> b) -> a -> b
$ Script -> ScriptOutput
toP2SH Script
theScript
, txRedeemScript :: Maybe Script
txRedeemScript = forall a. a -> Maybe a
Just Script
theScript
, txWitnessScript :: Maybe Script
txWitnessScript = forall a. Maybe a
Nothing
}
P2WPKH KeyDescriptor
kd -> do
Script
theScriptPubKey <- ScriptOutput -> Script
encodeOutput forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> ScriptOutput
PayWitnessPKHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ByteArrayAccess b => b -> Hash160
addressHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
S.encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
kd
forall (f :: * -> *) a. Applicative f => a -> f a
pure
TransactionScripts
{ txScriptPubKey :: Script
txScriptPubKey = Script
theScriptPubKey
, txRedeemScript :: Maybe Script
txRedeemScript = forall a. Maybe a
Nothing
, txWitnessScript :: Maybe Script
txWitnessScript = forall a. Maybe a
Nothing
}
P2WSH ScriptDescriptor
sd ->
ScriptDescriptor -> Maybe Script
compile ScriptDescriptor
sd forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Script
theScript ->
TransactionScripts
{ txScriptPubKey :: Script
txScriptPubKey = ScriptOutput -> Script
encodeOutput forall a b. (a -> b) -> a -> b
$ Script -> ScriptOutput
toP2WSH Script
theScript
, txRedeemScript :: Maybe Script
txRedeemScript = forall a. Maybe a
Nothing
, txWitnessScript :: Maybe Script
txWitnessScript = forall a. a -> Maybe a
Just Script
theScript
}
WrappedWPkh KeyDescriptor
kd -> do
Script
theRedeemScript <- ScriptOutput -> Script
encodeOutput forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> ScriptOutput
PayWitnessPKHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ByteArrayAccess b => b -> Hash160
addressHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
S.encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
kd
forall (f :: * -> *) a. Applicative f => a -> f a
pure
TransactionScripts
{ txScriptPubKey :: Script
txScriptPubKey = ScriptOutput -> Script
encodeOutput forall a b. (a -> b) -> a -> b
$ Script -> ScriptOutput
toP2SH Script
theRedeemScript
, txRedeemScript :: Maybe Script
txRedeemScript = forall a. a -> Maybe a
Just Script
theRedeemScript
, txWitnessScript :: Maybe Script
txWitnessScript = forall a. Maybe a
Nothing
}
WrappedWSh ScriptDescriptor
sd ->
ScriptDescriptor -> Maybe Script
compile ScriptDescriptor
sd forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Script
theScript ->
let theRedeemScript :: Script
theRedeemScript = ScriptOutput -> Script
encodeOutput forall a b. (a -> b) -> a -> b
$ Script -> ScriptOutput
toP2WSH Script
theScript
in TransactionScripts
{ txScriptPubKey :: Script
txScriptPubKey = ScriptOutput -> Script
encodeOutput forall a b. (a -> b) -> a -> b
$ Script -> ScriptOutput
toP2SH Script
theRedeemScript
, txRedeemScript :: Maybe Script
txRedeemScript = forall a. a -> Maybe a
Just Script
theRedeemScript
, txWitnessScript :: Maybe Script
txWitnessScript = forall a. a -> Maybe a
Just Script
theScript
}
Combo KeyDescriptor
_kd -> forall a. Maybe a
Nothing
Addr Address
_ad -> forall a. Maybe a
Nothing
keyAtIndex :: Word32 -> Key -> Key
keyAtIndex :: KeyIndex -> Key -> Key
keyAtIndex KeyIndex
ix = \case
XPub XPubKey
xpub DerivPath
path KeyCollection
HardKeys -> XPubKey -> DerivPath -> KeyCollection -> Key
XPub XPubKey
xpub (DerivPath
path forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
ix) KeyCollection
Single
XPub XPubKey
xpub DerivPath
path KeyCollection
SoftKeys -> XPubKey -> DerivPath -> KeyCollection -> Key
XPub XPubKey
xpub (DerivPath
path forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
ix) KeyCollection
Single
Key
key -> Key
key
outputDescriptorAtIndex :: KeyIndex -> OutputDescriptor -> OutputDescriptor
outputDescriptorAtIndex :: KeyIndex -> OutputDescriptor -> OutputDescriptor
outputDescriptorAtIndex KeyIndex
ix = \case
o :: OutputDescriptor
o@ScriptPubKey{} -> OutputDescriptor
o
P2SH ScriptDescriptor
sd -> ScriptDescriptor -> OutputDescriptor
P2SH forall a b. (a -> b) -> a -> b
$ KeyIndex -> ScriptDescriptor -> ScriptDescriptor
scriptDescriptorAtIndex KeyIndex
ix ScriptDescriptor
sd
P2WPKH KeyDescriptor
kd -> KeyDescriptor -> OutputDescriptor
P2WPKH forall a b. (a -> b) -> a -> b
$ KeyIndex -> KeyDescriptor -> KeyDescriptor
keyDescriptorAtIndex KeyIndex
ix KeyDescriptor
kd
P2WSH ScriptDescriptor
sd -> ScriptDescriptor -> OutputDescriptor
P2WSH forall a b. (a -> b) -> a -> b
$ KeyIndex -> ScriptDescriptor -> ScriptDescriptor
scriptDescriptorAtIndex KeyIndex
ix ScriptDescriptor
sd
WrappedWPkh KeyDescriptor
kd -> KeyDescriptor -> OutputDescriptor
WrappedWPkh forall a b. (a -> b) -> a -> b
$ KeyIndex -> KeyDescriptor -> KeyDescriptor
keyDescriptorAtIndex KeyIndex
ix KeyDescriptor
kd
WrappedWSh ScriptDescriptor
sd -> ScriptDescriptor -> OutputDescriptor
WrappedWSh forall a b. (a -> b) -> a -> b
$ KeyIndex -> ScriptDescriptor -> ScriptDescriptor
scriptDescriptorAtIndex KeyIndex
ix ScriptDescriptor
sd
Combo KeyDescriptor
kd -> KeyDescriptor -> OutputDescriptor
Combo forall a b. (a -> b) -> a -> b
$ KeyIndex -> KeyDescriptor -> KeyDescriptor
keyDescriptorAtIndex KeyIndex
ix KeyDescriptor
kd
a :: OutputDescriptor
a@Addr{} -> OutputDescriptor
a
scriptDescriptorAtIndex :: KeyIndex -> ScriptDescriptor -> ScriptDescriptor
scriptDescriptorAtIndex :: KeyIndex -> ScriptDescriptor -> ScriptDescriptor
scriptDescriptorAtIndex KeyIndex
ix = \case
Pk KeyDescriptor
kd -> KeyDescriptor -> ScriptDescriptor
Pk forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> KeyDescriptor
specialize KeyDescriptor
kd
Pkh KeyDescriptor
kd -> KeyDescriptor -> ScriptDescriptor
Pkh forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> KeyDescriptor
specialize KeyDescriptor
kd
Multi Int
k [KeyDescriptor]
ks -> Int -> [KeyDescriptor] -> ScriptDescriptor
Multi Int
k forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> KeyDescriptor
specialize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks
SortedMulti Int
k [KeyDescriptor]
ks -> Int -> [KeyDescriptor] -> ScriptDescriptor
SortedMulti Int
k forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> KeyDescriptor
specialize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks
r :: ScriptDescriptor
r@Raw{} -> ScriptDescriptor
r
where
specialize :: KeyDescriptor -> KeyDescriptor
specialize = KeyIndex -> KeyDescriptor -> KeyDescriptor
keyDescriptorAtIndex KeyIndex
ix
keyDescriptorAtIndex :: KeyIndex -> KeyDescriptor -> KeyDescriptor
keyDescriptorAtIndex :: KeyIndex -> KeyDescriptor -> KeyDescriptor
keyDescriptorAtIndex KeyIndex
ix KeyDescriptor
keyDescriptor = KeyDescriptor
keyDescriptor{keyDef :: Key
keyDef = KeyIndex -> Key -> Key
keyAtIndex KeyIndex
ix forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Key
keyDef KeyDescriptor
keyDescriptor}
toPsbtInput ::
Tx ->
Int ->
OutputDescriptor ->
Either PsbtInputError Input
toPsbtInput :: Tx -> Int -> OutputDescriptor -> Either PsbtInputError Input
toPsbtInput Tx
tx Int
ix OutputDescriptor
descriptor = case OutputDescriptor
descriptor of
ScriptPubKey ScriptDescriptor
sd ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Input
emptyInput
{ nonWitnessUtxo :: Maybe Tx
nonWitnessUtxo = forall a. a -> Maybe a
Just Tx
tx
, inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = ScriptDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPaths ScriptDescriptor
sd
}
P2SH ScriptDescriptor
sd -> do
Script
script <- ScriptDescriptor -> Either PsbtInputError Script
compileForInput ScriptDescriptor
sd
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Input
emptyInput
{ nonWitnessUtxo :: Maybe Tx
nonWitnessUtxo = forall a. a -> Maybe a
Just Tx
tx
, inputRedeemScript :: Maybe Script
inputRedeemScript = forall a. a -> Maybe a
Just Script
script
, inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = ScriptDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPaths ScriptDescriptor
sd
}
P2WPKH KeyDescriptor
kd -> do
TxOut
output <- Tx -> [TxOut]
txOut Tx
tx forall {t} {a}.
(Num t, Ord t) =>
[a] -> t -> Either PsbtInputError a
`safeIndex` Int
ix
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Input
emptyInput
{ witnessUtxo :: Maybe TxOut
witnessUtxo = forall a. a -> Maybe a
Just TxOut
output
, inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = KeyDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPath KeyDescriptor
kd
}
P2WSH ScriptDescriptor
sd -> do
TxOut
output <- Tx -> [TxOut]
txOut Tx
tx forall {t} {a}.
(Num t, Ord t) =>
[a] -> t -> Either PsbtInputError a
`safeIndex` Int
ix
Script
script <- ScriptDescriptor -> Either PsbtInputError Script
compileForInput ScriptDescriptor
sd
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Input
emptyInput
{ witnessUtxo :: Maybe TxOut
witnessUtxo = forall a. a -> Maybe a
Just TxOut
output
, inputWitnessScript :: Maybe Script
inputWitnessScript = forall a. a -> Maybe a
Just Script
script
, inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = ScriptDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPaths ScriptDescriptor
sd
}
WrappedWPkh KeyDescriptor
kd -> do
TxOut
output <- Tx -> [TxOut]
txOut Tx
tx forall {t} {a}.
(Num t, Ord t) =>
[a] -> t -> Either PsbtInputError a
`safeIndex` Int
ix
PubKeyI
k <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> PsbtInputError
KeyNotAvailable KeyDescriptor
kd) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
kd
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Input
emptyInput
{ witnessUtxo :: Maybe TxOut
witnessUtxo = forall a. a -> Maybe a
Just TxOut
output
, inputRedeemScript :: Maybe Script
inputRedeemScript =
forall a. a -> Maybe a
Just
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> Script
encodeOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> ScriptOutput
PayWitnessPKHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ByteArrayAccess b => b -> Hash160
addressHash
forall a b. (a -> b) -> a -> b
$ forall a. Serialize a => a -> ByteString
encode PubKeyI
k
, inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = KeyDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPath KeyDescriptor
kd
}
WrappedWSh ScriptDescriptor
sd -> do
TxOut
output <- Tx -> [TxOut]
txOut Tx
tx forall {t} {a}.
(Num t, Ord t) =>
[a] -> t -> Either PsbtInputError a
`safeIndex` Int
ix
Script
script <- ScriptDescriptor -> Either PsbtInputError Script
compileForInput ScriptDescriptor
sd
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Input
emptyInput
{ witnessUtxo :: Maybe TxOut
witnessUtxo = forall a. a -> Maybe a
Just TxOut
output
, inputRedeemScript :: Maybe Script
inputRedeemScript = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> Script
encodeOutput forall a b. (a -> b) -> a -> b
$ Script -> ScriptOutput
toP2WSH Script
script
, inputWitnessScript :: Maybe Script
inputWitnessScript = forall a. a -> Maybe a
Just Script
script
, inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = ScriptDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPaths ScriptDescriptor
sd
}
o :: OutputDescriptor
o@Combo{} -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ OutputDescriptor -> PsbtInputError
InvalidOutput OutputDescriptor
o
o :: OutputDescriptor
o@Addr{} -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ OutputDescriptor -> PsbtInputError
InvalidOutput OutputDescriptor
o
where
hdPaths :: ScriptDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPaths = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap KeyDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDescriptor -> [KeyDescriptor]
scriptKeys
compileForInput :: ScriptDescriptor -> Either PsbtInputError Script
compileForInput ScriptDescriptor
sd = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> PsbtInputError
CompileError ScriptDescriptor
sd) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Maybe Script
compile ScriptDescriptor
sd
safeIndex :: [a] -> t -> Either PsbtInputError a
safeIndex (a
x : [a]
xs) t
n
| t
n forall a. Eq a => a -> a -> Bool
== t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
| t
n forall a. Ord a => a -> a -> Bool
> t
0 = [a] -> t -> Either PsbtInputError a
safeIndex [a]
xs (t
n forall a. Num a => a -> a -> a
- t
1)
safeIndex [a]
_ t
_ = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Tx -> Int -> PsbtInputError
OutputIndexOOB Tx
tx Int
ix
data PsbtInputError
= OutputIndexOOB Tx Int
| CompileError ScriptDescriptor
| KeyNotAvailable KeyDescriptor
| InvalidOutput OutputDescriptor
deriving (PsbtInputError -> PsbtInputError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PsbtInputError -> PsbtInputError -> Bool
$c/= :: PsbtInputError -> PsbtInputError -> Bool
== :: PsbtInputError -> PsbtInputError -> Bool
$c== :: PsbtInputError -> PsbtInputError -> Bool
Eq, Int -> PsbtInputError -> ShowS
[PsbtInputError] -> ShowS
PsbtInputError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PsbtInputError] -> ShowS
$cshowList :: [PsbtInputError] -> ShowS
show :: PsbtInputError -> String
$cshow :: PsbtInputError -> String
showsPrec :: Int -> PsbtInputError -> ShowS
$cshowsPrec :: Int -> PsbtInputError -> ShowS
Show)
instance Exception PsbtInputError
hdPath :: KeyDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPath :: KeyDescriptor -> HashMap PubKeyI (Fingerprint, [KeyIndex])
hdPath k :: KeyDescriptor
k@(KeyDescriptor Maybe Origin
origin Key
theKeyDef) = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ do
PubKeyI
pubKey <- KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
k
forall {k}.
Hashable k =>
k -> Maybe (HashMap k (Fingerprint, [KeyIndex]))
fromOrigin PubKeyI
pubKey forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {k}.
Hashable k =>
k -> Maybe (HashMap k (Fingerprint, [KeyIndex]))
fromKey PubKeyI
pubKey
where
fromOrigin :: k -> Maybe (HashMap k (Fingerprint, [KeyIndex]))
fromOrigin k
pubKey = do
Origin
theOrigin <- Maybe Origin
origin
DerivPath
theKeyPath <- Key -> Maybe DerivPath
keyPath Key
theKeyDef
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton
k
pubKey
( Origin -> Fingerprint
fingerprint Origin
theOrigin
, forall t. DerivPathI t -> [KeyIndex]
pathToList forall a b. (a -> b) -> a -> b
$ Origin -> DerivPath
derivation Origin
theOrigin forall t1 t2. DerivPathI t1 -> DerivPathI t2 -> DerivPath
++/ DerivPath
theKeyPath
)
fromKey :: k -> Maybe (HashMap k (Fingerprint, [KeyIndex]))
fromKey k
pubKey =
case Key
theKeyDef of
XPub XPubKey
xpub DerivPath
path KeyCollection
Single ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton
k
pubKey
( XPubKey -> Fingerprint
xPubFP XPubKey
xpub
, forall t. DerivPathI t -> [KeyIndex]
pathToList DerivPath
path
)
Key
_ -> forall a. Maybe a
Nothing
keyPath :: Key -> Maybe DerivPath
keyPath :: Key -> Maybe DerivPath
keyPath = \case
XPub XPubKey
_ DerivPath
path KeyCollection
Single -> forall a. a -> Maybe a
Just DerivPath
path
Key
_ -> forall a. Maybe a
Nothing
scriptKeys :: ScriptDescriptor -> [KeyDescriptor]
scriptKeys :: ScriptDescriptor -> [KeyDescriptor]
scriptKeys = \case
Pk KeyDescriptor
k -> [KeyDescriptor
k]
Pkh KeyDescriptor
k -> [KeyDescriptor
k]
Multi Int
_ [KeyDescriptor]
ks -> [KeyDescriptor]
ks
SortedMulti Int
_ [KeyDescriptor]
ks -> [KeyDescriptor]
ks
Raw{} -> forall a. Monoid a => a
mempty
outputDescriptorPubKeys :: OutputDescriptor -> [PubKeyI]
outputDescriptorPubKeys :: OutputDescriptor -> [PubKeyI]
outputDescriptorPubKeys = \case
ScriptPubKey ScriptDescriptor
sd -> ScriptDescriptor -> [PubKeyI]
scriptDescriptorPubKeys ScriptDescriptor
sd
P2SH ScriptDescriptor
sd -> ScriptDescriptor -> [PubKeyI]
scriptDescriptorPubKeys ScriptDescriptor
sd
P2WPKH KeyDescriptor
kd -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
kd
P2WSH ScriptDescriptor
sd -> ScriptDescriptor -> [PubKeyI]
scriptDescriptorPubKeys ScriptDescriptor
sd
WrappedWPkh KeyDescriptor
kd -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
kd
WrappedWSh ScriptDescriptor
sd -> ScriptDescriptor -> [PubKeyI]
scriptDescriptorPubKeys ScriptDescriptor
sd
Combo KeyDescriptor
kd -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Maybe PubKeyI
keyDescPubKey KeyDescriptor
kd
Addr Address
_ad -> forall a. Monoid a => a
mempty
scriptDescriptorPubKeys :: ScriptDescriptor -> [PubKeyI]
scriptDescriptorPubKeys :: ScriptDescriptor -> [PubKeyI]
scriptDescriptorPubKeys = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe KeyDescriptor -> Maybe PubKeyI
keyDescPubKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDescriptor -> [KeyDescriptor]
scriptKeys