Copyright | No rights reserved |
---|---|
License | MIT |
Maintainer | jprupp@protonmail.ch |
Stability | experimental |
Portability | POSIX |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Code to simplify transaction creation, signing, fee calculation and coin selection.
Synopsis
- buildAddrTx :: Network -> Ctx -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
- buildTx :: Ctx -> [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
- buildInput :: Network -> Ctx -> Tx -> Int -> ScriptOutput -> Word64 -> Maybe RedeemScript -> TxSignature -> PublicKey -> Either String ScriptInput
- data SigInput = SigInput {}
- signTx :: Network -> Ctx -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
- signNestedWitnessTx :: Network -> Ctx -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
- makeSignature :: Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> TxSignature
- signInput :: Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
- signNestedInput :: Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
- verifyStdTx :: Network -> Ctx -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
- mergeTxs :: Network -> Ctx -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
- sigKeys :: Ctx -> ScriptOutput -> Maybe RedeemScript -> [SecKey] -> Either String [PrivateKey]
- mergeTxInput :: Network -> Ctx -> [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx
- findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)]
- verifyStdInput :: Network -> Ctx -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
- class Coin c where
- chooseCoins :: Coin c => Word64 -> Word64 -> Int -> Bool -> [c] -> Either String ([c], Word64)
- chooseCoinsSink :: (Monad m, Coin c) => Word64 -> Word64 -> Int -> Bool -> ConduitT c Void m (Either String ([c], Word64))
- chooseMSCoins :: Coin c => Word64 -> Word64 -> (Int, Int) -> Int -> Bool -> [c] -> Either String ([c], Word64)
- chooseMSCoinsSink :: (Monad m, Coin c) => Word64 -> Word64 -> (Int, Int) -> Int -> Bool -> ConduitT c Void m (Either String ([c], Word64))
- countMulSig :: Network -> Ctx -> Tx -> Script -> Word64 -> Int -> [PubKey] -> [TxSignature] -> Int
- greedyAddSink :: (Monad m, Coin c) => Word64 -> (Int -> Word64) -> Bool -> ConduitT c Void m (Maybe ([c], Word64))
- guessTxFee :: Word64 -> Int -> Int -> Word64
- guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
- guessTxSize :: Int -> [(Int, Int)] -> Int -> Int -> Int
- guessMSSize :: (Int, Int) -> Int
Transaction Builder
buildAddrTx :: Network -> Ctx -> [OutPoint] -> [(Text, Word64)] -> Either String Tx Source #
Build a transaction by providing a list of outpoints as inputs and a list of recipient addresses and amounts as outputs.
buildTx :: Ctx -> [OutPoint] -> [(ScriptOutput, Word64)] -> Tx Source #
Build a transaction by providing a list of outpoints as inputs
and a list of ScriptOutput
and amounts as outputs.
:: Network | |
-> Ctx | |
-> Tx | transaction where input will be added |
-> Int | input index where signature will go |
-> ScriptOutput | output script being spent |
-> Word64 | amount of previous output |
-> Maybe RedeemScript | redeem script if pay-to-script-hash |
-> TxSignature | |
-> PublicKey | |
-> Either String ScriptInput |
Construct an input for a transaction given a signature, public key and data about the previous output.
Data type used to specify the signing parameters of a transaction input. To sign an input, the previous output script, outpoint and sighash are required. When signing a pay to script hash output, an additional redeem script is required.
Instances
:: Network | |
-> Ctx | |
-> Tx | transaction to sign |
-> [SigInput] | signing parameters |
-> [SecKey] | private keys to sign with |
-> Either String Tx | signed transaction |
Sign a transaction by providing the SigInput
signing parameters and a
list of private keys. The signature is computed deterministically as defined
in RFC-6979.
Example: P2SH-P2WKH
sigIn = SigInput (PayWitnessPKHash h) 100000 op sigHashAll Nothing signedTx = signTx btc unsignedTx [sigIn] [key]
Example: P2SH-P2WSH multisig
sigIn = SigInput (PayWitnessScriptHash h) 100000 op sigHashAll (Just $ PayMulSig [p1,p2,p3] 2) signedTx = signTx btc unsignedTx [sigIn] [k1,k3]
makeSignature :: Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> TxSignature Source #
Produce a structured representation of a deterministic (RFC-6979) signature over an input.
signInput :: Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx Source #
Sign a single input in a transaction deterministically (RFC-6979).
signNestedInput :: Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx Source #
Like signInput
but treat segwit inputs as nested
verifyStdTx :: Network -> Ctx -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool Source #
Verify if a transaction is valid and all of its inputs are standard.
mergeTxs :: Network -> Ctx -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx Source #
Merge partially-signed multisig transactions. This function does not support segwit and P2SH-segwit inputs. Use PSBTs to merge transactions with segwit inputs.
sigKeys :: Ctx -> ScriptOutput -> Maybe RedeemScript -> [SecKey] -> Either String [PrivateKey] Source #
Find from the list of provided private keys which one is required to sign
the ScriptOutput
.
mergeTxInput :: Network -> Ctx -> [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx Source #
Merge input from partially-signed multisig transactions. This function does not support segwit and P2SH-segwit inputs.
verifyStdInput :: Network -> Ctx -> Tx -> Int -> ScriptOutput -> Word64 -> Bool Source #
Verify if a transaction input is valid and standard.
Coin Selection
Any type can be used as a Coin if it can provide a value in Satoshi. The value is used in coin selection algorithms.
:: Coin c | |
=> Word64 | value to send |
-> Word64 | fee per byte |
-> Int | number of outputs (including change) |
-> Bool | try to find better solutions |
-> [c] | list of ordered coins to choose from |
-> Either String ([c], Word64) | coin selection and change |
Coin selection algorithm for normal (non-multisig) transactions. This function returns the selected coins together with the amount of change to send back to yourself, taking the fee into account.
:: (Monad m, Coin c) | |
=> Word64 | value to send |
-> Word64 | fee per byte |
-> Int | number of outputs (including change) |
-> Bool | try to find better solution |
-> ConduitT c Void m (Either String ([c], Word64)) | coin selection and change |
Coin selection algorithm for normal (non-multisig) transactions. This function returns the selected coins together with the amount of change to send back to yourself, taking the fee into account. This version uses a Sink for conduit-based coin selection.
:: Coin c | |
=> Word64 | value to send |
-> Word64 | fee per byte |
-> (Int, Int) | m of n multisig |
-> Int | number of outputs (including change) |
-> Bool | try to find better solution |
-> [c] | |
-> Either String ([c], Word64) | coin selection change amount |
Coin selection algorithm for multisig transactions. This function returns the selected coins together with the amount of change to send back to yourself, taking the fee into account. This function assumes all the coins are script hash outputs that send funds to a multisignature address.
:: (Monad m, Coin c) | |
=> Word64 | value to send |
-> Word64 | fee per byte |
-> (Int, Int) | m of n multisig |
-> Int | number of outputs (including change) |
-> Bool | try to find better solution |
-> ConduitT c Void m (Either String ([c], Word64)) | coin selection and change |
Coin selection algorithm for multisig transactions. This function returns the selected coins together with the amount of change to send back to yourself, taking the fee into account. This function assumes all the coins are script hash outputs that send funds to a multisignature address. This version uses a Sink if you need conduit-based coin selection.
countMulSig :: Network -> Ctx -> Tx -> Script -> Word64 -> Int -> [PubKey] -> [TxSignature] -> Int Source #
Count the number of valid signatures for a multi-signature transaction.
:: (Monad m, Coin c) | |
=> Word64 | value to send |
-> (Int -> Word64) | coin count to fee function |
-> Bool | try to find better solutions |
-> ConduitT c Void m (Maybe ([c], Word64)) | coin selection and change |
Select coins greedily by starting from an empty solution. If the continue
flag is set, the algorithm will try to find a better solution in the stream
after a solution is found. If the next solution found is not strictly better
than the previously found solution, the algorithm stops and returns the
previous solution. If the continue flag is not set, the algorithm will return
the first solution it finds in the stream.
guessTxFee :: Word64 -> Int -> Int -> Word64 Source #
Estimate tranasction fee to pay based on transaction size estimation.
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64 Source #
Same as guessTxFee
but for multisig transactions.