{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- |
Module      : Haskoin.Transaction.Partial
Copyright   : No rights reserved
License     : MIT
Maintainer  : matt@bitnomial.com
Stability   : experimental
Portability : POSIX

Code related to PSBT parsing and serialization.
-}
module Haskoin.Transaction.Partial (
    -- * Partially-Signed Transactions
    PartiallySignedTransaction (..),
    Input (..),
    Output (..),
    UnknownMap (..),
    Key (..),
    merge,
    mergeMany,
    mergeInput,
    mergeOutput,
    complete,
    finalTransaction,
    emptyPSBT,
    emptyInput,
    emptyOutput,

    -- ** Signing
    PsbtSigner,
    getSignerKey,
    secKeySigner,
    xPrvSigner,
    signPSBT,
) where

import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Monad (foldM, guard, replicateM, void)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Bytes.Get (runGetS)
import Data.Bytes.Put (runPutS)
import Data.Bytes.Serial (Serial (..))
import Data.Either (fromRight)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable (Hashable)
import Data.List (foldl')
import Data.Maybe (fromMaybe, isJust)
import Data.Serialize (Get, Put, Serialize)
import qualified Data.Serialize as S
import GHC.Generics (Generic)
import GHC.Word (Word32, Word8)
import Haskoin.Address (Address (..), pubKeyAddr)
import Haskoin.Crypto (SecKey, derivePubKey)
import Haskoin.Data (Network)
import Haskoin.Keys (
    DerivPath,
    DerivPathI (Deriv),
    Fingerprint,
    KeyIndex,
    PubKeyI,
    SecKeyI (SecKeyI),
    XPrvKey,
    derivePath,
    deriveXPubKey,
    listToPath,
    pathToList,
    pubKeyCompressed,
    pubKeyPoint,
    xPrvKey,
    xPubFP,
 )
import Haskoin.Network (
    VarInt (..),
    VarString (..),
    putVarInt,
 )
import Haskoin.Script (
    Script (..),
    ScriptOp (..),
    ScriptOutput (..),
    SigHash,
    decodeOutput,
    decodeOutputBS,
    encodeOutputBS,
    encodeTxSig,
    isPayScriptHash,
    opPushData,
    sigHashAll,
    toP2SH,
    toP2WSH,
 )
import Haskoin.Transaction.Builder (SigInput (..), makeSignature)
import Haskoin.Transaction.Common (
    Tx (..),
    TxOut,
    WitnessStack,
    outPointIndex,
    outValue,
    prevOutput,
    scriptInput,
    scriptOutput,
 )
import Haskoin.Transaction.Segwit (isSegwit)
import Haskoin.Util (eitherToMaybe)

{- | PSBT data type as specified in
 [BIP-174](https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki).
 This contains an unsigned transaction, inputs and outputs, and unspecified
 extra data. There is one input per input in the unsigned transaction, and one
 output per output in the unsigned transaction. The inputs and outputs in the
 'PartiallySignedTransaction' line up by index with the inputs and outputs in
 the unsigned transaction.
-}
data PartiallySignedTransaction = PartiallySignedTransaction
    { PartiallySignedTransaction -> Tx
unsignedTransaction :: Tx
    , PartiallySignedTransaction -> UnknownMap
globalUnknown :: UnknownMap
    , PartiallySignedTransaction -> [Input]
inputs :: [Input]
    , PartiallySignedTransaction -> [Output]
outputs :: [Output]
    }
    deriving (Int -> PartiallySignedTransaction -> ShowS
[PartiallySignedTransaction] -> ShowS
PartiallySignedTransaction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartiallySignedTransaction] -> ShowS
$cshowList :: [PartiallySignedTransaction] -> ShowS
show :: PartiallySignedTransaction -> String
$cshow :: PartiallySignedTransaction -> String
showsPrec :: Int -> PartiallySignedTransaction -> ShowS
$cshowsPrec :: Int -> PartiallySignedTransaction -> ShowS
Show, PartiallySignedTransaction -> PartiallySignedTransaction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartiallySignedTransaction -> PartiallySignedTransaction -> Bool
$c/= :: PartiallySignedTransaction -> PartiallySignedTransaction -> Bool
== :: PartiallySignedTransaction -> PartiallySignedTransaction -> Bool
$c== :: PartiallySignedTransaction -> PartiallySignedTransaction -> Bool
Eq, forall x.
Rep PartiallySignedTransaction x -> PartiallySignedTransaction
forall x.
PartiallySignedTransaction -> Rep PartiallySignedTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PartiallySignedTransaction x -> PartiallySignedTransaction
$cfrom :: forall x.
PartiallySignedTransaction -> Rep PartiallySignedTransaction x
Generic)

instance NFData PartiallySignedTransaction

{- | Inputs contain all of the data needed to sign a transaction and all of the
 resulting signature data after signing.
-}
data Input = Input
    { Input -> Maybe Tx
nonWitnessUtxo :: Maybe Tx
    , Input -> Maybe TxOut
witnessUtxo :: Maybe TxOut
    , Input -> HashMap PubKeyI ByteString
partialSigs :: HashMap PubKeyI ByteString
    , Input -> Maybe SigHash
sigHashType :: Maybe SigHash
    , Input -> Maybe Script
inputRedeemScript :: Maybe Script
    , Input -> Maybe Script
inputWitnessScript :: Maybe Script
    , Input -> HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
    , Input -> Maybe Script
finalScriptSig :: Maybe Script
    , Input -> Maybe WitnessStack
finalScriptWitness :: Maybe WitnessStack
    , Input -> UnknownMap
inputUnknown :: UnknownMap
    }
    deriving (Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show, Input -> Input -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c== :: Input -> Input -> Bool
Eq, forall x. Rep Input x -> Input
forall x. Input -> Rep Input x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Input x -> Input
$cfrom :: forall x. Input -> Rep Input x
Generic)

instance NFData Input

-- | Outputs can contain information needed to spend the output at a later date.
data Output = Output
    { Output -> Maybe Script
outputRedeemScript :: Maybe Script
    , Output -> Maybe Script
outputWitnessScript :: Maybe Script
    , Output -> HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
    , Output -> UnknownMap
outputUnknown :: UnknownMap
    }
    deriving (Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show, Output -> Output -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c== :: Output -> Output -> Bool
Eq, forall x. Rep Output x -> Output
forall x. Output -> Rep Output x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Output x -> Output
$cfrom :: forall x. Output -> Rep Output x
Generic)

instance NFData Output

{- | A map of raw PSBT keys to byte strings for extra data. The 'keyType' field
 cannot overlap with any of the reserved 'keyType' fields specified in the
 PSBT specification.
-}
newtype UnknownMap = UnknownMap {UnknownMap -> HashMap Key ByteString
unknownMap :: HashMap Key ByteString}
    deriving (Int -> UnknownMap -> ShowS
[UnknownMap] -> ShowS
UnknownMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownMap] -> ShowS
$cshowList :: [UnknownMap] -> ShowS
show :: UnknownMap -> String
$cshow :: UnknownMap -> String
showsPrec :: Int -> UnknownMap -> ShowS
$cshowsPrec :: Int -> UnknownMap -> ShowS
Show, UnknownMap -> UnknownMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnknownMap -> UnknownMap -> Bool
$c/= :: UnknownMap -> UnknownMap -> Bool
== :: UnknownMap -> UnknownMap -> Bool
$c== :: UnknownMap -> UnknownMap -> Bool
Eq, NonEmpty UnknownMap -> UnknownMap
UnknownMap -> UnknownMap -> UnknownMap
forall b. Integral b => b -> UnknownMap -> UnknownMap
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> UnknownMap -> UnknownMap
$cstimes :: forall b. Integral b => b -> UnknownMap -> UnknownMap
sconcat :: NonEmpty UnknownMap -> UnknownMap
$csconcat :: NonEmpty UnknownMap -> UnknownMap
<> :: UnknownMap -> UnknownMap -> UnknownMap
$c<> :: UnknownMap -> UnknownMap -> UnknownMap
Semigroup, Semigroup UnknownMap
UnknownMap
[UnknownMap] -> UnknownMap
UnknownMap -> UnknownMap -> UnknownMap
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [UnknownMap] -> UnknownMap
$cmconcat :: [UnknownMap] -> UnknownMap
mappend :: UnknownMap -> UnknownMap -> UnknownMap
$cmappend :: UnknownMap -> UnknownMap -> UnknownMap
mempty :: UnknownMap
$cmempty :: UnknownMap
Monoid, forall x. Rep UnknownMap x -> UnknownMap
forall x. UnknownMap -> Rep UnknownMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnknownMap x -> UnknownMap
$cfrom :: forall x. UnknownMap -> Rep UnknownMap x
Generic)

instance NFData UnknownMap

-- | Raw keys for the map type used in PSBTs.
data Key = Key
    { Key -> Word8
keyType :: Word8
    , Key -> ByteString
key :: ByteString
    }
    deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)

instance NFData Key

instance Hashable Key

{- | Take two 'PartiallySignedTransaction's and merge them. The
 'unsignedTransaction' field in both must be the same.
-}
merge ::
    PartiallySignedTransaction ->
    PartiallySignedTransaction ->
    Maybe PartiallySignedTransaction
merge :: PartiallySignedTransaction
-> PartiallySignedTransaction -> Maybe PartiallySignedTransaction
merge PartiallySignedTransaction
psbt1 PartiallySignedTransaction
psbt2
    | PartiallySignedTransaction -> Tx
unsignedTransaction PartiallySignedTransaction
psbt1 forall a. Eq a => a -> a -> Bool
== PartiallySignedTransaction -> Tx
unsignedTransaction PartiallySignedTransaction
psbt2 =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            PartiallySignedTransaction
psbt1
                { globalUnknown :: UnknownMap
globalUnknown = PartiallySignedTransaction -> UnknownMap
globalUnknown PartiallySignedTransaction
psbt1 forall a. Semigroup a => a -> a -> a
<> PartiallySignedTransaction -> UnknownMap
globalUnknown PartiallySignedTransaction
psbt2
                , inputs :: [Input]
inputs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Input -> Input -> Input
mergeInput (PartiallySignedTransaction -> [Input]
inputs PartiallySignedTransaction
psbt1) (PartiallySignedTransaction -> [Input]
inputs PartiallySignedTransaction
psbt2)
                , outputs :: [Output]
outputs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Output -> Output -> Output
mergeOutput (PartiallySignedTransaction -> [Output]
outputs PartiallySignedTransaction
psbt1) (PartiallySignedTransaction -> [Output]
outputs PartiallySignedTransaction
psbt2)
                }
merge PartiallySignedTransaction
_ PartiallySignedTransaction
_ = forall a. Maybe a
Nothing

{- | A version of 'merge' for a collection of PSBTs.

 @since 0.21.0
-}
mergeMany :: [PartiallySignedTransaction] -> Maybe PartiallySignedTransaction
mergeMany :: [PartiallySignedTransaction] -> Maybe PartiallySignedTransaction
mergeMany (PartiallySignedTransaction
psbt : [PartiallySignedTransaction]
psbts) = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM PartiallySignedTransaction
-> PartiallySignedTransaction -> Maybe PartiallySignedTransaction
merge PartiallySignedTransaction
psbt [PartiallySignedTransaction]
psbts
mergeMany [PartiallySignedTransaction]
_ = forall a. Maybe a
Nothing

mergeInput :: Input -> Input -> Input
mergeInput :: Input -> Input -> Input
mergeInput Input
a Input
b =
    Input
        { nonWitnessUtxo :: Maybe Tx
nonWitnessUtxo =
            if forall a. Maybe a -> Bool
isJust Maybe TxOut
witUtx
                then forall a. Maybe a
Nothing
                else Input -> Maybe Tx
nonWitnessUtxo Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe Tx
nonWitnessUtxo Input
b
        , witnessUtxo :: Maybe TxOut
witnessUtxo =
            Maybe TxOut
witUtx
        , sigHashType :: Maybe SigHash
sigHashType =
            Input -> Maybe SigHash
sigHashType Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe SigHash
sigHashType Input
b
        , partialSigs :: HashMap PubKeyI ByteString
partialSigs =
            Input -> HashMap PubKeyI ByteString
partialSigs Input
a forall a. Semigroup a => a -> a -> a
<> Input -> HashMap PubKeyI ByteString
partialSigs Input
b
        , inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths =
            Input -> HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths Input
a forall a. Semigroup a => a -> a -> a
<> Input -> HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths Input
b
        , inputUnknown :: UnknownMap
inputUnknown =
            Input -> UnknownMap
inputUnknown Input
a forall a. Semigroup a => a -> a -> a
<> Input -> UnknownMap
inputUnknown Input
b
        , inputRedeemScript :: Maybe Script
inputRedeemScript =
            Input -> Maybe Script
inputRedeemScript Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe Script
inputRedeemScript Input
b
        , inputWitnessScript :: Maybe Script
inputWitnessScript =
            Input -> Maybe Script
inputWitnessScript Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe Script
inputWitnessScript Input
b
        , finalScriptSig :: Maybe Script
finalScriptSig =
            Input -> Maybe Script
finalScriptSig Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe Script
finalScriptSig Input
b
        , finalScriptWitness :: Maybe WitnessStack
finalScriptWitness =
            Input -> Maybe WitnessStack
finalScriptWitness Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe WitnessStack
finalScriptWitness Input
b
        }
  where
    witUtx :: Maybe TxOut
witUtx = Input -> Maybe TxOut
witnessUtxo Input
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Maybe TxOut
witnessUtxo Input
b

mergeOutput :: Output -> Output -> Output
mergeOutput :: Output -> Output -> Output
mergeOutput Output
a Output
b =
    Output
        { outputRedeemScript :: Maybe Script
outputRedeemScript =
            Output -> Maybe Script
outputRedeemScript Output
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Output -> Maybe Script
outputRedeemScript Output
b
        , outputWitnessScript :: Maybe Script
outputWitnessScript =
            Output -> Maybe Script
outputWitnessScript Output
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Output -> Maybe Script
outputWitnessScript Output
b
        , outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths =
            Output -> HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths Output
a forall a. Semigroup a => a -> a -> a
<> Output -> HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths Output
b
        , outputUnknown :: UnknownMap
outputUnknown =
            Output -> UnknownMap
outputUnknown Output
a forall a. Semigroup a => a -> a -> a
<> Output -> UnknownMap
outputUnknown Output
b
        }

{- | A abstraction which covers varying key configurations.  Use the 'Semigroup'
 instance to create signers for sets of keys: `signerA <> signerB` can sign
 anything for which `signerA` or `signerB` could sign.

 @since 0.21@
-}
newtype PsbtSigner = PsbtSigner
    { PsbtSigner
-> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
unPsbtSigner ::
        PubKeyI ->
        Maybe (Fingerprint, DerivPath) ->
        Maybe SecKey
    }

instance Semigroup PsbtSigner where
    PsbtSigner PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
signer1 <> :: PsbtSigner -> PsbtSigner -> PsbtSigner
<> PsbtSigner PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
signer2 =
        (PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> PsbtSigner
PsbtSigner forall a b. (a -> b) -> a -> b
$ \PubKeyI
pubKey Maybe (Fingerprint, DerivPath)
origin ->
            PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
signer1 PubKeyI
pubKey Maybe (Fingerprint, DerivPath)
origin forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
signer2 PubKeyI
pubKey Maybe (Fingerprint, DerivPath)
origin

instance Monoid PsbtSigner where
    mempty :: PsbtSigner
mempty = (PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> PsbtSigner
PsbtSigner forall a b. (a -> b) -> a -> b
$ \PubKeyI
_ Maybe (Fingerprint, DerivPath)
_ -> forall a. Maybe a
Nothing

{- | Fetch the secret key for the given 'PubKeyI' if possible.

 @since 0.21@
-}
getSignerKey :: PsbtSigner -> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
getSignerKey :: PsbtSigner
-> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
getSignerKey = PsbtSigner
-> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
unPsbtSigner

{- | This signer can sign for one key.

 @since 0.21@
-}
secKeySigner :: SecKey -> PsbtSigner
secKeySigner :: SecKey -> PsbtSigner
secKeySigner SecKey
theSecKey = (PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> PsbtSigner
PsbtSigner forall {p}. PubKeyI -> p -> Maybe SecKey
signer
  where
    signer :: PubKeyI -> p -> Maybe SecKey
signer PubKeyI
requiredKey p
_
        | PubKeyI -> PubKey
pubKeyPoint PubKeyI
requiredKey forall a. Eq a => a -> a -> Bool
== SecKey -> PubKey
derivePubKey SecKey
theSecKey = forall a. a -> Maybe a
Just SecKey
theSecKey
        | Bool
otherwise = forall a. Maybe a
Nothing

{- | This signer can sign with any child key, provided that derivation information is present.

 @since 0.21@
-}
xPrvSigner ::
    XPrvKey ->
    -- | Origin data, if the input key is explicitly a child key
    Maybe (Fingerprint, DerivPath) ->
    PsbtSigner
xPrvSigner :: XPrvKey -> Maybe (Fingerprint, DerivPath) -> PsbtSigner
xPrvSigner XPrvKey
xprv Maybe (Fingerprint, DerivPath)
origin = (PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> PsbtSigner
PsbtSigner forall {t}.
PubKeyI -> Maybe (Fingerprint, DerivPathI t) -> Maybe SecKey
signer
  where
    signer :: PubKeyI -> Maybe (Fingerprint, DerivPathI t) -> Maybe SecKey
signer PubKeyI
pubKey (Just (Fingerprint, DerivPathI t)
hdData)
        | result :: Maybe SecKey
result@(Just SecKey
theSecKey) <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {t}. (Fingerprint, DerivPathI t) -> Maybe SecKey
noOrigin forall {t} {t}.
(Fingerprint, DerivPathI t)
-> (Fingerprint, DerivPathI t) -> Maybe SecKey
onOrigin Maybe (Fingerprint, DerivPath)
origin (Fingerprint, DerivPathI t)
hdData
          , PubKeyI -> PubKey
pubKeyPoint PubKeyI
pubKey forall a. Eq a => a -> a -> Bool
== SecKey -> PubKey
derivePubKey SecKey
theSecKey =
            Maybe SecKey
result
    signer PubKeyI
_ Maybe (Fingerprint, DerivPathI t)
_ = forall a. Maybe a
Nothing

    noOrigin :: (Fingerprint, DerivPathI t) -> Maybe SecKey
noOrigin (Fingerprint
fp, DerivPathI t
path)
        | Fingerprint
thisFP forall a. Eq a => a -> a -> Bool
== Fingerprint
fp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t}. DerivPathI t -> SecKey
deriveSecKey DerivPathI t
path
        | Bool
otherwise = forall a. Maybe a
Nothing

    onOrigin :: (Fingerprint, DerivPathI t)
-> (Fingerprint, DerivPathI t) -> Maybe SecKey
onOrigin (Fingerprint
originFP, DerivPathI t
originPath) (Fingerprint
fp, DerivPathI t
path)
        | Fingerprint
thisFP forall a. Eq a => a -> a -> Bool
== Fingerprint
fp = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t}. DerivPathI t -> SecKey
deriveSecKey DerivPathI t
path
        | Fingerprint
originFP forall a. Eq a => a -> a -> Bool
== Fingerprint
fp =
            forall {t}. DerivPathI t -> SecKey
deriveSecKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyIndex] -> [KeyIndex] -> Maybe DerivPath
adjustPath (forall t. DerivPathI t -> [KeyIndex]
pathToList DerivPathI t
originPath) (forall t. DerivPathI t -> [KeyIndex]
pathToList DerivPathI t
path)
        | Bool
otherwise = forall a. Maybe a
Nothing

    deriveSecKey :: DerivPathI t -> SecKey
deriveSecKey DerivPathI t
path = XPrvKey -> SecKey
xPrvKey forall a b. (a -> b) -> a -> b
$ forall t. DerivPathI t -> XPrvKey -> XPrvKey
derivePath DerivPathI t
path XPrvKey
xprv

    thisFP :: Fingerprint
thisFP = XPubKey -> Fingerprint
xPubFP forall a b. (a -> b) -> a -> b
$ XPrvKey -> XPubKey
deriveXPubKey XPrvKey
xprv

    -- The origin path should be a prefix of the target path if we match the
    -- origin fingerprint.  We need to remove this prefix.
    adjustPath :: [KeyIndex] -> [KeyIndex] -> Maybe DerivPath
    adjustPath :: [KeyIndex] -> [KeyIndex] -> Maybe DerivPath
adjustPath (KeyIndex
originIx : [KeyIndex]
originTail) (KeyIndex
thisIx : [KeyIndex]
thisTail)
        | KeyIndex
originIx forall a. Eq a => a -> a -> Bool
== KeyIndex
thisIx = [KeyIndex] -> [KeyIndex] -> Maybe DerivPath
adjustPath [KeyIndex]
originTail [KeyIndex]
thisTail
        | Bool
otherwise = forall a. Maybe a
Nothing
    adjustPath [] [KeyIndex]
thePath = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [KeyIndex] -> DerivPath
listToPath [KeyIndex]
thePath
    adjustPath [KeyIndex]
_ [KeyIndex]
_ = forall a. Maybe a
Nothing

{- | Update a PSBT with signatures when possible.  This function uses
 'inputHDKeypaths' in order to calculate secret keys.

 @since 0.21@
-}
signPSBT ::
    Network ->
    PsbtSigner ->
    PartiallySignedTransaction ->
    PartiallySignedTransaction
signPSBT :: Network
-> PsbtSigner
-> PartiallySignedTransaction
-> PartiallySignedTransaction
signPSBT Network
net PsbtSigner
signer PartiallySignedTransaction
psbt =
    PartiallySignedTransaction
psbt
        { inputs :: [Input]
inputs = Network -> PsbtSigner -> Tx -> (Int, Input) -> Input
addSigsForInput Network
net PsbtSigner
signer Tx
tx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] (PartiallySignedTransaction -> [Input]
inputs PartiallySignedTransaction
psbt)
        }
  where
    tx :: Tx
tx = PartiallySignedTransaction -> Tx
unsignedTransaction PartiallySignedTransaction
psbt

addSigsForInput :: Network -> PsbtSigner -> Tx -> (Int, Input) -> Input
addSigsForInput :: Network -> PsbtSigner -> Tx -> (Int, Input) -> Input
addSigsForInput Network
net PsbtSigner
signer Tx
tx (Int
ix, Input
input) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Input
input (Network
-> PsbtSigner -> Tx -> Int -> Input -> Either Tx TxOut -> Input
onPrevTxOut Network
net PsbtSigner
signer Tx
tx Int
ix Input
input) forall a b. (a -> b) -> a -> b
$
        forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> Maybe Tx
nonWitnessUtxo Input
input forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> Maybe TxOut
witnessUtxo Input
input

onPrevTxOut ::
    Network ->
    PsbtSigner ->
    Tx ->
    Int ->
    Input ->
    Either Tx TxOut ->
    Input
onPrevTxOut :: Network
-> PsbtSigner -> Tx -> Int -> Input -> Either Tx TxOut -> Input
onPrevTxOut Network
net PsbtSigner
signer Tx
tx Int
ix Input
input Either Tx TxOut
prevTxData =
    Input
input
        { partialSigs :: HashMap PubKeyI ByteString
partialSigs = HashMap PubKeyI ByteString
newSigs forall a. Semigroup a => a -> a -> a
<> Input -> HashMap PubKeyI ByteString
partialSigs Input
input
        }
  where
    newSigs :: HashMap PubKeyI ByteString
newSigs = forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey PubKeyI -> SecKey -> ByteString
sigForInput HashMap PubKeyI SecKey
sigKeys
    sigForInput :: PubKeyI -> SecKey -> ByteString
sigForInput PubKeyI
thePubKey SecKey
theSecKey =
        TxSignature -> ByteString
encodeTxSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature
makeSignature Network
net Tx
tx Int
ix SigInput
theSigInput forall a b. (a -> b) -> a -> b
$
            SecKey -> Bool -> SecKeyI
SecKeyI SecKey
theSecKey (PubKeyI -> Bool
pubKeyCompressed PubKeyI
thePubKey)

    theSigInput :: SigInput
theSigInput =
        SigInput
            { -- Must be the segwit input script for segwit spends (even nested)
              sigInputScript :: ScriptOutput
sigInputScript = forall a. a -> Maybe a -> a
fromMaybe ScriptOutput
theInputScript Maybe ScriptOutput
segwitInput
            , sigInputValue :: Word64
sigInputValue = TxOut -> Word64
outValue TxOut
prevTxOut
            , sigInputOP :: OutPoint
sigInputOP = OutPoint
thePrevOutPoint
            , sigInputSH :: SigHash
sigInputSH = forall a. a -> Maybe a -> a
fromMaybe SigHash
sigHashAll forall a b. (a -> b) -> a -> b
$ Input -> Maybe SigHash
sigHashType Input
input
            , -- Must be the witness script for segwit spends (even nested)
              sigInputRedeem :: Maybe ScriptOutput
sigInputRedeem = Maybe ScriptOutput
theWitnessScript forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ScriptOutput
theRedeemScript
            }

    prevTxOut :: TxOut
prevTxOut = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((forall a. [a] -> Int -> a
!! (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> KeyIndex
outPointIndex) OutPoint
thePrevOutPoint) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxOut]
txOut) forall a. a -> a
id Either Tx TxOut
prevTxData
    thePrevOutPoint :: OutPoint
thePrevOutPoint = TxIn -> OutPoint
prevOutput forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx forall a. [a] -> Int -> a
!! Int
ix

    segwitInput :: Maybe ScriptOutput
segwitInput = forall a. (a -> Bool) -> a -> Maybe a
justWhen ScriptOutput -> Bool
isSegwit ScriptOutput
theInputScript forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. (a -> Bool) -> a -> Maybe a
justWhen ScriptOutput -> Bool
isSegwit forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ScriptOutput
theRedeemScript)

    theInputScript :: ScriptOutput
theInputScript = forall b a. b -> Either a b -> b
fromRight forall {a}. a
inputScriptErr forall a b. (a -> b) -> a -> b
$ (ByteString -> Either String ScriptOutput
decodeOutputBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput) TxOut
prevTxOut
    inputScriptErr :: a
inputScriptErr = forall a. HasCallStack => String -> a
error String
"addSigsForInput: Unable to decode input script"

    theRedeemScript :: Maybe ScriptOutput
theRedeemScript = case Script -> Either String ScriptOutput
decodeOutput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> Maybe Script
inputRedeemScript Input
input of
        Just (Right ScriptOutput
script) -> forall a. a -> Maybe a
Just ScriptOutput
script
        Just Left{} -> forall a. HasCallStack => String -> a
error String
"addSigsForInput: Unable to decode redeem script"
        Maybe (Either String ScriptOutput)
_ -> forall a. Maybe a
Nothing

    theWitnessScript :: Maybe ScriptOutput
theWitnessScript = case Script -> Either String ScriptOutput
decodeOutput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> Maybe Script
inputWitnessScript Input
input of
        Just (Right ScriptOutput
script) -> forall a. a -> Maybe a
Just ScriptOutput
script
        Just Left{} -> forall a. HasCallStack => String -> a
error String
"addSigsForInput: Unable to decode witness script"
        Maybe (Either String ScriptOutput)
_ -> forall a. Maybe a
Nothing

    sigKeys :: HashMap PubKeyI SecKey
sigKeys = forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybeWithKey PubKeyI -> (Fingerprint, [KeyIndex]) -> Maybe SecKey
getSignerKey forall a b. (a -> b) -> a -> b
$ Input -> HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths Input
input
    getSignerKey :: PubKeyI -> (Fingerprint, [KeyIndex]) -> Maybe SecKey
getSignerKey PubKeyI
pubKey (Fingerprint
fp, [KeyIndex]
ixs) = PsbtSigner
-> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
unPsbtSigner PsbtSigner
signer PubKeyI
pubKey forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Fingerprint
fp, [KeyIndex] -> DerivPath
listToPath [KeyIndex]
ixs)

-- | Take partial signatures from all of the 'Input's and finalize the signature.
complete ::
    PartiallySignedTransaction ->
    PartiallySignedTransaction
complete :: PartiallySignedTransaction -> PartiallySignedTransaction
complete PartiallySignedTransaction
psbt =
    PartiallySignedTransaction
psbt
        { inputs :: [Input]
inputs =
            forall a b. (a -> b) -> [a] -> [b]
map
                ((Maybe ScriptOutput, Input) -> Input
completeInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyIndex, Input) -> (Maybe ScriptOutput, Input)
analyzeInputs)
                (forall a. [a] -> [(KeyIndex, a)]
indexed forall a b. (a -> b) -> a -> b
$ PartiallySignedTransaction -> [Input]
inputs PartiallySignedTransaction
psbt)
        }
  where
    analyzeInputs :: (KeyIndex, Input) -> (Maybe ScriptOutput, Input)
analyzeInputs (KeyIndex
i, Input
input) =
        (,)
            (TxOut -> Maybe ScriptOutput
outputScript forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Input -> Maybe TxOut
witnessUtxo Input
input forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TxOut
nonWitScript)
            Input
input
      where
        nonWitScript :: Maybe TxOut
nonWitScript = KeyIndex -> Tx -> Maybe TxOut
getPrevOut KeyIndex
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Input -> Maybe Tx
nonWitnessUtxo Input
input

    getPrevOut :: KeyIndex -> Tx -> Maybe TxOut
getPrevOut KeyIndex
i Tx
tx =
        (Tx -> [TxOut]
txOut Tx
tx forall {b}. [b] -> KeyIndex -> Maybe b
!!?)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> KeyIndex
outPointIndex
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
prevOutput
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Tx -> [TxIn]
txIn (PartiallySignedTransaction -> Tx
unsignedTransaction PartiallySignedTransaction
psbt) forall {b}. [b] -> KeyIndex -> Maybe b
!!? KeyIndex
i
    [b]
xs !!? :: [b] -> KeyIndex -> Maybe b
!!? KeyIndex
i = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup KeyIndex
i forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(KeyIndex, a)]
indexed [b]
xs

    outputScript :: TxOut -> Maybe ScriptOutput
outputScript = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ScriptOutput
decodeOutputBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput

    completeInput :: (Maybe ScriptOutput, Input) -> Input
completeInput (Maybe ScriptOutput
Nothing, Input
input) = Input
input
    completeInput (Just ScriptOutput
script, Input
input) = Input -> Input
pruneInputFields forall a b. (a -> b) -> a -> b
$ Input -> ScriptOutput -> Input
completeSig Input
input ScriptOutput
script

    -- If we have final scripts, we can get rid of data for signing following
    -- the Bitcoin Core implementation.
    pruneInputFields :: Input -> Input
pruneInputFields Input
input
        | forall a. Maybe a -> Bool
isJust (Input -> Maybe Script
finalScriptSig Input
input) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (Input -> Maybe WitnessStack
finalScriptWitness Input
input) =
            Input
input
                { partialSigs :: HashMap PubKeyI ByteString
partialSigs = forall a. Monoid a => a
mempty
                , inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = forall a. Monoid a => a
mempty
                , inputRedeemScript :: Maybe Script
inputRedeemScript = forall a. Maybe a
Nothing
                , inputWitnessScript :: Maybe Script
inputWitnessScript = forall a. Maybe a
Nothing
                , sigHashType :: Maybe SigHash
sigHashType = forall a. Maybe a
Nothing
                }
        | Bool
otherwise = Input
input

    indexed :: [a] -> [(Word32, a)]
    indexed :: forall a. [a] -> [(KeyIndex, a)]
indexed = forall a b. [a] -> [b] -> [(a, b)]
zip [KeyIndex
0 ..]

completeSig :: Input -> ScriptOutput -> Input
completeSig :: Input -> ScriptOutput -> Input
completeSig Input
input (PayPK PubKeyI
k) =
    Input
input
        { finalScriptSig :: Maybe Script
finalScriptSig =
            forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
                forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup PubKeyI
k (Input -> HashMap PubKeyI ByteString
partialSigs Input
input)
        }
completeSig Input
input (PayPKHash Hash160
h)
    | [(PubKeyI
k, ByteString
sig)] <- forall k v. HashMap k v -> [(k, v)]
HashMap.toList (Input -> HashMap PubKeyI ByteString
partialSigs Input
input)
      , Hash160 -> Address
PubKeyAddress Hash160
h forall a. Eq a => a -> a -> Bool
== PubKeyI -> Address
pubKeyAddr PubKeyI
k =
        Input
input
            { finalScriptSig :: Maybe Script
finalScriptSig =
                forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                    [ScriptOp] -> Script
Script
                        [ ByteString -> ScriptOp
opPushData ByteString
sig
                        , ByteString -> ScriptOp
opPushData (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
k))
                        ]
            }
completeSig Input
input (PayMulSig [PubKeyI]
pubKeys Int
m)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length WitnessStack
sigs forall a. Ord a => a -> a -> Bool
>= Int
m =
        Input
input{finalScriptSig :: Maybe Script
finalScriptSig = forall a. a -> Maybe a
Just Script
finalSig}
  where
    sigs :: WitnessStack
sigs = Int -> [PubKeyI] -> Input -> WitnessStack
collectSigs Int
m [PubKeyI]
pubKeys Input
input
    finalSig :: Script
finalSig = [ScriptOp] -> Script
Script forall a b. (a -> b) -> a -> b
$ ScriptOp
OP_0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ScriptOp
opPushData WitnessStack
sigs
completeSig Input
input (PayScriptHash Hash160
h)
    | Just Script
rdmScript <- Input -> Maybe Script
inputRedeemScript Input
input
      , Hash160 -> ScriptOutput
PayScriptHash Hash160
h forall a. Eq a => a -> a -> Bool
== Script -> ScriptOutput
toP2SH Script
rdmScript
      , Right ScriptOutput
decodedScript <- Script -> Either String ScriptOutput
decodeOutput Script
rdmScript
      , Bool -> Bool
not (ScriptOutput -> Bool
isPayScriptHash ScriptOutput
decodedScript) =
        Script -> Input -> Input
pushScript Script
rdmScript forall a b. (a -> b) -> a -> b
$ Input -> ScriptOutput -> Input
completeSig Input
input ScriptOutput
decodedScript
  where
    pushScript :: Script -> Input -> Input
pushScript Script
rdmScript Input
updatedInput =
        Input
updatedInput
            { finalScriptSig :: Maybe Script
finalScriptSig =
                forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                    forall a. a -> Maybe a -> a
fromMaybe ([ScriptOp] -> Script
Script forall a. Monoid a => a
mempty) (Input -> Maybe Script
finalScriptSig Input
updatedInput)
                        Script -> Script -> Script
`scriptAppend` Script -> Script
serializedRedeemScript Script
rdmScript
            }
    scriptAppend :: Script -> Script -> Script
scriptAppend (Script [ScriptOp]
script1) (Script [ScriptOp]
script2) = [ScriptOp] -> Script
Script forall a b. (a -> b) -> a -> b
$ [ScriptOp]
script1 forall a. Semigroup a => a -> a -> a
<> [ScriptOp]
script2
completeSig Input
input (PayWitnessPKHash Hash160
h)
    | [(PubKeyI
k, ByteString
sig)] <- forall k v. HashMap k v -> [(k, v)]
HashMap.toList (Input -> HashMap PubKeyI ByteString
partialSigs Input
input)
      , Hash160 -> Address
PubKeyAddress Hash160
h forall a. Eq a => a -> a -> Bool
== PubKeyI -> Address
pubKeyAddr PubKeyI
k =
        Input
input{finalScriptWitness :: Maybe WitnessStack
finalScriptWitness = forall a. a -> Maybe a
Just [ByteString
sig, Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
k]}
completeSig Input
input (PayWitnessScriptHash Hash256
h)
    | Just Script
witScript <- Input -> Maybe Script
inputWitnessScript Input
input
      , Hash256 -> ScriptOutput
PayWitnessScriptHash Hash256
h forall a. Eq a => a -> a -> Bool
== Script -> ScriptOutput
toP2WSH Script
witScript
      , Right ScriptOutput
decodedScript <- Script -> Either String ScriptOutput
decodeOutput Script
witScript =
        Input -> ScriptOutput -> Input
completeWitnessSig Input
input ScriptOutput
decodedScript
completeSig Input
input ScriptOutput
_ = Input
input

serializedRedeemScript :: Script -> Script
serializedRedeemScript :: Script -> Script
serializedRedeemScript = [ScriptOp] -> Script
Script forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScriptOp
opPushData forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

completeWitnessSig :: Input -> ScriptOutput -> Input
completeWitnessSig :: Input -> ScriptOutput -> Input
completeWitnessSig Input
input script :: ScriptOutput
script@(PayMulSig [PubKeyI]
pubKeys Int
m)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length WitnessStack
sigs forall a. Ord a => a -> a -> Bool
>= Int
m =
        Input
input{finalScriptWitness :: Maybe WitnessStack
finalScriptWitness = forall a. a -> Maybe a
Just WitnessStack
finalWit}
  where
    sigs :: WitnessStack
sigs = Int -> [PubKeyI] -> Input -> WitnessStack
collectSigs Int
m [PubKeyI]
pubKeys Input
input
    finalWit :: WitnessStack
finalWit = forall a. Monoid a => a
mempty forall a. a -> [a] -> [a]
: WitnessStack
sigs forall a. Semigroup a => a -> a -> a
<> [ScriptOutput -> ByteString
encodeOutputBS ScriptOutput
script]
completeWitnessSig Input
input ScriptOutput
_ = Input
input

collectSigs :: Int -> [PubKeyI] -> Input -> [ByteString]
collectSigs :: Int -> [PubKeyI] -> Input -> WitnessStack
collectSigs Int
m [PubKeyI]
pubKeys Input
input =
    forall a. Int -> [a] -> [a]
take Int
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' WitnessStack -> PubKeyI -> WitnessStack
lookupKey [] [PubKeyI]
pubKeys
  where
    lookupKey :: WitnessStack -> PubKeyI -> WitnessStack
lookupKey WitnessStack
sigs PubKeyI
key =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe WitnessStack
sigs (forall a. a -> [a] -> [a]
: WitnessStack
sigs) forall a b. (a -> b) -> a -> b
$
            forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup PubKeyI
key (Input -> HashMap PubKeyI ByteString
partialSigs Input
input)

{- | Take a finalized 'PartiallySignedTransaction' and produce the signed final
 transaction. You may need to call 'complete' on the
 'PartiallySignedTransaction' before producing the final transaction.
-}
finalTransaction :: PartiallySignedTransaction -> Tx
finalTransaction :: PartiallySignedTransaction -> Tx
finalTransaction PartiallySignedTransaction
psbt =
    ([TxIn], [WitnessStack]) -> Tx
setInputs
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([TxIn], [WitnessStack])
-> (TxIn, Input) -> ([TxIn], [WitnessStack])
finalizeInput ([], [])
        forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (Tx -> [TxIn]
txIn Tx
tx) (PartiallySignedTransaction -> [Input]
inputs PartiallySignedTransaction
psbt)
  where
    tx :: Tx
tx = PartiallySignedTransaction -> Tx
unsignedTransaction PartiallySignedTransaction
psbt
    hasWitness :: Bool
hasWitness =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
            (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Maybe WitnessStack
finalScriptWitness)
            (PartiallySignedTransaction -> [Input]
inputs PartiallySignedTransaction
psbt)
    setInputs :: ([TxIn], [WitnessStack]) -> Tx
setInputs ([TxIn]
ins, [WitnessStack]
witData) =
        Tx
tx
            { txIn :: [TxIn]
txIn = forall a. [a] -> [a]
reverse [TxIn]
ins
            , txWitness :: [WitnessStack]
txWitness = if Bool
hasWitness then forall a. [a] -> [a]
reverse [WitnessStack]
witData else []
            }
    finalizeInput :: ([TxIn], [WitnessStack])
-> (TxIn, Input) -> ([TxIn], [WitnessStack])
finalizeInput ([TxIn]
ins, [WitnessStack]
witData) (TxIn
txInput, Input
psbtInput) =
        ( TxIn
txInput{scriptInput :: ByteString
scriptInput = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) forall a b. (a -> b) -> a -> b
$ Input -> Maybe Script
finalScriptSig Input
psbtInput} forall a. a -> [a] -> [a]
: [TxIn]
ins
        , forall a. a -> Maybe a -> a
fromMaybe [] (Input -> Maybe WitnessStack
finalScriptWitness Input
psbtInput) forall a. a -> [a] -> [a]
: [WitnessStack]
witData
        )

{- | Take an unsigned transaction and produce an empty
 'PartiallySignedTransaction'
-}
emptyPSBT :: Tx -> PartiallySignedTransaction
emptyPSBT :: Tx -> PartiallySignedTransaction
emptyPSBT Tx
tx =
    PartiallySignedTransaction
        { unsignedTransaction :: Tx
unsignedTransaction = Tx
tx
        , globalUnknown :: UnknownMap
globalUnknown = forall a. Monoid a => a
mempty
        , inputs :: [Input]
inputs = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxIn]
txIn Tx
tx)) Input
emptyInput
        , outputs :: [Output]
outputs = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxOut]
txOut Tx
tx)) Output
emptyOutput
        }

emptyInput :: Input
emptyInput :: Input
emptyInput =
    Maybe Tx
-> Maybe TxOut
-> HashMap PubKeyI ByteString
-> Maybe SigHash
-> Maybe Script
-> Maybe Script
-> HashMap PubKeyI (Fingerprint, [KeyIndex])
-> Maybe Script
-> Maybe WitnessStack
-> UnknownMap
-> Input
Input
        forall a. Maybe a
Nothing
        forall a. Maybe a
Nothing
        forall k v. HashMap k v
HashMap.empty
        forall a. Maybe a
Nothing
        forall a. Maybe a
Nothing
        forall a. Maybe a
Nothing
        forall k v. HashMap k v
HashMap.empty
        forall a. Maybe a
Nothing
        forall a. Maybe a
Nothing
        (HashMap Key ByteString -> UnknownMap
UnknownMap forall k v. HashMap k v
HashMap.empty)

emptyOutput :: Output
emptyOutput :: Output
emptyOutput = Maybe Script
-> Maybe Script
-> HashMap PubKeyI (Fingerprint, [KeyIndex])
-> UnknownMap
-> Output
Output forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall k v. HashMap k v
HashMap.empty (HashMap Key ByteString -> UnknownMap
UnknownMap forall k v. HashMap k v
HashMap.empty)

instance Serialize PartiallySignedTransaction where
    get :: Get PartiallySignedTransaction
get = do
        ByteString
magic <- Int -> Get ByteString
S.getBytes Int
4
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString
magic forall a. Eq a => a -> a -> Bool
== ByteString
"psbt"
        Word8
headerSep <- Get Word8
S.getWord8
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word8
headerSep forall a. Eq a => a -> a -> Bool
== Word8
0xff

        Word8
keySize <- Get Word8
S.getWord8
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word8
keySize forall a. Eq a => a -> a -> Bool
== Word8
1
        Word8
globalUnsignedTxType <- Get Word8
S.getWord8
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word8
globalUnsignedTxType forall a. Eq a => a -> a -> Bool
== Word8
0x00
        Tx
unsignedTransaction <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ByteString -> Bool
B.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> ByteString
scriptInput) (Tx -> [TxIn]
txIn Tx
unsignedTransaction)
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tx -> [WitnessStack]
txWitness Tx
unsignedTransaction)

        UnknownMap
globalUnknown <- forall t. Serialize t => Get t
S.get
        Word8
globalEnd <- Get Word8
S.getWord8
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word8
globalEnd forall a. Eq a => a -> a -> Bool
== Word8
0x00

        [Input]
inputs <-
            forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
                (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxIn]
txIn Tx
unsignedTransaction))
                forall t. Serialize t => Get t
S.get
        [Output]
outputs <-
            forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
                (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxOut]
txOut Tx
unsignedTransaction))
                forall t. Serialize t => Get t
S.get

        forall (m :: * -> *) a. Monad m => a -> m a
return
            PartiallySignedTransaction
                { Tx
unsignedTransaction :: Tx
unsignedTransaction :: Tx
unsignedTransaction
                , UnknownMap
globalUnknown :: UnknownMap
globalUnknown :: UnknownMap
globalUnknown
                , [Input]
inputs :: [Input]
inputs :: [Input]
inputs
                , [Output]
outputs :: [Output]
outputs :: [Output]
outputs
                }

    put :: Putter PartiallySignedTransaction
put
        PartiallySignedTransaction
            { Tx
unsignedTransaction :: Tx
unsignedTransaction :: PartiallySignedTransaction -> Tx
unsignedTransaction
            , UnknownMap
globalUnknown :: UnknownMap
globalUnknown :: PartiallySignedTransaction -> UnknownMap
globalUnknown
            , [Input]
inputs :: [Input]
inputs :: PartiallySignedTransaction -> [Input]
inputs
            , [Output]
outputs :: [Output]
outputs :: PartiallySignedTransaction -> [Output]
outputs
            } = do
            Putter ByteString
S.putByteString ByteString
"psbt"
            Putter Word8
S.putWord8 Word8
0xff -- Header separator
            Putter Word8
S.putWord8 Word8
0x01 -- Key size
            Putter Word8
S.putWord8 Word8
0x00 -- Unsigned Transaction type
            Put -> Put
putSizedBytes forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Tx
unsignedTransaction
            forall t. Serialize t => Putter t
S.put UnknownMap
globalUnknown
            Putter Word8
S.putWord8 Word8
0x00 -- Global end
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Serialize t => Putter t
S.put [Input]
inputs
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Serialize t => Putter t
S.put [Output]
outputs

instance Serialize Key where
    get :: Get Key
get = do
        VarInt Word64
keySize <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word64
keySize forall a. Ord a => a -> a -> Bool
> Word64
0
        Word8
t <- Get Word8
S.getWord8
        ByteString
k <- Int -> Get ByteString
S.getBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
keySize forall a. Num a => a -> a -> a
- Int
1)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ByteString -> Key
Key Word8
t ByteString
k)

    put :: Putter Key
put (Key Word8
t ByteString
k) = do
        forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
k
        Putter Word8
S.putWord8 Word8
t
        Putter ByteString
S.putByteString ByteString
k

instance Serialize UnknownMap where
    get :: Get UnknownMap
get = HashMap Key ByteString -> Get UnknownMap
go forall k v. HashMap k v
HashMap.empty
      where
        getItem :: HashMap Key ByteString -> Get UnknownMap
getItem HashMap Key ByteString
m = do
            Key
k <- forall t. Serialize t => Get t
S.get
            VarString ByteString
v <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            HashMap Key ByteString -> Get UnknownMap
go forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Key
k ByteString
v HashMap Key ByteString
m
        go :: HashMap Key ByteString -> Get UnknownMap
go HashMap Key ByteString
m = do
            Word8
isEnd <- forall a. Get a -> Get a
S.lookAhead Get Word8
S.getWord8
            if Word8
isEnd forall a. Eq a => a -> a -> Bool
== Word8
0x00
                then forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Key ByteString -> UnknownMap
UnknownMap HashMap Key ByteString
m)
                else HashMap Key ByteString -> Get UnknownMap
getItem HashMap Key ByteString
m

    put :: Putter UnknownMap
put (UnknownMap HashMap Key ByteString
m) =
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey
                (\Key
k ByteString
v -> forall t. Serialize t => Putter t
S.put Key
k forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ByteString -> VarString
VarString ByteString
v))
                HashMap Key ByteString
m

instance Serialize Input where
    get :: Get Input
get =
        forall t a.
(Bounded t, Enum t) =>
(Int -> a -> t -> Get a)
-> ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a)
-> a
-> Get a
getMap Int -> Input -> InputType -> Get Input
getInputItem (HashMap Key ByteString -> HashMap Key ByteString)
-> Input -> Input
setInputUnknown Input
emptyInput
      where
        setInputUnknown :: (HashMap Key ByteString -> HashMap Key ByteString)
-> Input -> Input
setInputUnknown HashMap Key ByteString -> HashMap Key ByteString
f Input
input =
            Input
input
                { inputUnknown :: UnknownMap
inputUnknown =
                    HashMap Key ByteString -> UnknownMap
UnknownMap (HashMap Key ByteString -> HashMap Key ByteString
f (UnknownMap -> HashMap Key ByteString
unknownMap (Input -> UnknownMap
inputUnknown Input
input)))
                }

    put :: Putter Input
put
        Input
            { Maybe Tx
nonWitnessUtxo :: Maybe Tx
nonWitnessUtxo :: Input -> Maybe Tx
nonWitnessUtxo
            , Maybe TxOut
witnessUtxo :: Maybe TxOut
witnessUtxo :: Input -> Maybe TxOut
witnessUtxo
            , HashMap PubKeyI ByteString
partialSigs :: HashMap PubKeyI ByteString
partialSigs :: Input -> HashMap PubKeyI ByteString
partialSigs
            , Maybe SigHash
sigHashType :: Maybe SigHash
sigHashType :: Input -> Maybe SigHash
sigHashType
            , Maybe Script
inputRedeemScript :: Maybe Script
inputRedeemScript :: Input -> Maybe Script
inputRedeemScript
            , Maybe Script
inputWitnessScript :: Maybe Script
inputWitnessScript :: Input -> Maybe Script
inputWitnessScript
            , HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths :: Input -> HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths
            , Maybe Script
finalScriptSig :: Maybe Script
finalScriptSig :: Input -> Maybe Script
finalScriptSig
            , Maybe WitnessStack
finalScriptWitness :: Maybe WitnessStack
finalScriptWitness :: Input -> Maybe WitnessStack
finalScriptWitness
            , UnknownMap
inputUnknown :: UnknownMap
inputUnknown :: Input -> UnknownMap
inputUnknown
            } = do
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue InputType
InNonWitnessUtxo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe Tx
nonWitnessUtxo
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue InputType
InWitnessUtxo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe TxOut
witnessUtxo
            HashMap PubKeyI ByteString -> Put
putPartialSig HashMap PubKeyI ByteString
partialSigs
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                forall {a}. Integral a => a -> Put
putSigHash
                Maybe SigHash
sigHashType
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue InputType
InRedeemScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe Script
inputRedeemScript
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue InputType
InWitnessScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe Script
inputWitnessScript
            forall t.
Enum t =>
t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put
putHDPath InputType
InBIP32Derivation HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue InputType
InFinalScriptSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe Script
finalScriptSig
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue InputType
InFinalScriptWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => t ByteString -> Put
putFinalScriptWitness)
                Maybe WitnessStack
finalScriptWitness
            forall t. Serialize t => Putter t
S.put UnknownMap
inputUnknown
            Putter Word8
S.putWord8 Word8
0x00
          where
            putPartialSig :: HashMap PubKeyI ByteString -> Put
putPartialSig =
                forall t a. Enum t => (a -> Put) -> t -> HashMap PubKeyI a -> Put
putPubKeyMap forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize InputType
InPartialSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> VarString
VarString
            putSigHash :: a -> Put
putSigHash a
sigHash = do
                forall t. Enum t => t -> Put
putKey InputType
InSigHashType
                Putter Word8
S.putWord8 Word8
0x04
                Putter KeyIndex
S.putWord32le (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
sigHash)
            putFinalScriptWitness :: t ByteString -> Put
putFinalScriptWitness t ByteString
witnessStack = do
                forall t. Serialize t => Putter t
S.put forall a b. (a -> b) -> a -> b
$ (Word64 -> VarInt
VarInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) t ByteString
witnessStack
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> VarString
VarString) t ByteString
witnessStack

instance Serialize Output where
    get :: Get Output
get = forall t a.
(Bounded t, Enum t) =>
(Int -> a -> t -> Get a)
-> ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a)
-> a
-> Get a
getMap Int -> Output -> OutputType -> Get Output
getOutputItem (HashMap Key ByteString -> HashMap Key ByteString)
-> Output -> Output
setOutputUnknown Output
emptyOutput
      where
        setOutputUnknown :: (HashMap Key ByteString -> HashMap Key ByteString)
-> Output -> Output
setOutputUnknown HashMap Key ByteString -> HashMap Key ByteString
f Output
output =
            Output
output
                { outputUnknown :: UnknownMap
outputUnknown =
                    HashMap Key ByteString -> UnknownMap
UnknownMap (HashMap Key ByteString -> HashMap Key ByteString
f (UnknownMap -> HashMap Key ByteString
unknownMap (Output -> UnknownMap
outputUnknown Output
output)))
                }

    put :: Putter Output
put
        Output
            { Maybe Script
outputRedeemScript :: Maybe Script
outputRedeemScript :: Output -> Maybe Script
outputRedeemScript
            , Maybe Script
outputWitnessScript :: Maybe Script
outputWitnessScript :: Output -> Maybe Script
outputWitnessScript
            , HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths :: Output -> HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths
            , UnknownMap
outputUnknown :: UnknownMap
outputUnknown :: Output -> UnknownMap
outputUnknown
            } = do
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue OutputType
OutRedeemScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe Script
outputRedeemScript
            forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust
                (forall t. Enum t => t -> Put -> Put
putKeyValue OutputType
OutWitnessScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)
                Maybe Script
outputWitnessScript
            forall t.
Enum t =>
t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put
putHDPath
                OutputType
OutBIP32Derivation
                HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths
            forall t. Serialize t => Putter t
S.put UnknownMap
outputUnknown
            Putter Word8
S.putWord8 Word8
0x00

putSizedBytes :: Put -> Put
putSizedBytes :: Put -> Put
putSizedBytes Put
f = do
    forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (ByteString -> Int
B.length ByteString
bs)
    Putter ByteString
S.putByteString ByteString
bs
  where
    bs :: ByteString
bs = Put -> ByteString
S.runPut Put
f

getSizedBytes :: Get a -> Get a
getSizedBytes :: forall a. Get a -> Get a
getSizedBytes =
    forall a. Get Int -> Get a -> Get a
S.getNested
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Word64
getVarInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)

putKeyValue :: Enum t => t -> Put -> Put
putKeyValue :: forall t. Enum t => t -> Put -> Put
putKeyValue t
t Put
v = do
    forall t. Enum t => t -> Put
putKey t
t
    Put -> Put
putSizedBytes Put
v

putKey :: Enum t => t -> Put
putKey :: forall t. Enum t => t -> Put
putKey t
t = do
    forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Word8
1 :: Word8)
    Putter Word8
S.putWord8 (forall a. Enum a => a -> Word8
enumWord8 t
t)

getMap ::
    (Bounded t, Enum t) =>
    (Int -> a -> t -> Get a) ->
    ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a) ->
    a ->
    Get a
getMap :: forall t a.
(Bounded t, Enum t) =>
(Int -> a -> t -> Get a)
-> ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a)
-> a
-> Get a
getMap Int -> a -> t -> Get a
getMapItem (HashMap Key ByteString -> HashMap Key ByteString) -> a -> a
setUnknown = a -> Get a
go
  where
    getItem :: Word64 -> a -> Either Word8 t -> Get a
getItem Word64
keySize a
m (Right t
t) =
        Int -> a -> t -> Get a
getMapItem (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
keySize forall a. Num a => a -> a -> a
- Int
1) a
m t
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Get a
go
    getItem Word64
keySize a
m (Left Word8
t) = do
        ByteString
k <- Int -> Get ByteString
S.getBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
keySize forall a. Num a => a -> a -> a
- Int
1)
        VarString ByteString
v <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        a -> Get a
go forall a b. (a -> b) -> a -> b
$ (HashMap Key ByteString -> HashMap Key ByteString) -> a -> a
setUnknown (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Word8 -> ByteString -> Key
Key Word8
t ByteString
k) ByteString
v) a
m
    go :: a -> Get a
go a
m = do
        Word64
keySize <- VarInt -> Word64
getVarInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        if Word64
keySize forall a. Eq a => a -> a -> Bool
== Word64
0
            then forall (m :: * -> *) a. Monad m => a -> m a
return a
m
            else Word64 -> a -> Either Word8 t -> Get a
getItem Word64
keySize a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Bounded a, Enum a) => Word8 -> Either Word8 a
word8Enum forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
S.getWord8

data InputType
    = InNonWitnessUtxo
    | InWitnessUtxo
    | InPartialSig
    | InSigHashType
    | InRedeemScript
    | InWitnessScript
    | InBIP32Derivation
    | InFinalScriptSig
    | InFinalScriptWitness
    deriving (Int -> InputType -> ShowS
[InputType] -> ShowS
InputType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputType] -> ShowS
$cshowList :: [InputType] -> ShowS
show :: InputType -> String
$cshow :: InputType -> String
showsPrec :: Int -> InputType -> ShowS
$cshowsPrec :: Int -> InputType -> ShowS
Show, InputType -> InputType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputType -> InputType -> Bool
$c/= :: InputType -> InputType -> Bool
== :: InputType -> InputType -> Bool
$c== :: InputType -> InputType -> Bool
Eq, Int -> InputType
InputType -> Int
InputType -> [InputType]
InputType -> InputType
InputType -> InputType -> [InputType]
InputType -> InputType -> InputType -> [InputType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InputType -> InputType -> InputType -> [InputType]
$cenumFromThenTo :: InputType -> InputType -> InputType -> [InputType]
enumFromTo :: InputType -> InputType -> [InputType]
$cenumFromTo :: InputType -> InputType -> [InputType]
enumFromThen :: InputType -> InputType -> [InputType]
$cenumFromThen :: InputType -> InputType -> [InputType]
enumFrom :: InputType -> [InputType]
$cenumFrom :: InputType -> [InputType]
fromEnum :: InputType -> Int
$cfromEnum :: InputType -> Int
toEnum :: Int -> InputType
$ctoEnum :: Int -> InputType
pred :: InputType -> InputType
$cpred :: InputType -> InputType
succ :: InputType -> InputType
$csucc :: InputType -> InputType
Enum, InputType
forall a. a -> a -> Bounded a
maxBound :: InputType
$cmaxBound :: InputType
minBound :: InputType
$cminBound :: InputType
Bounded, forall x. Rep InputType x -> InputType
forall x. InputType -> Rep InputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputType x -> InputType
$cfrom :: forall x. InputType -> Rep InputType x
Generic)

instance NFData InputType

data OutputType
    = OutRedeemScript
    | OutWitnessScript
    | OutBIP32Derivation
    deriving (Int -> OutputType -> ShowS
[OutputType] -> ShowS
OutputType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputType] -> ShowS
$cshowList :: [OutputType] -> ShowS
show :: OutputType -> String
$cshow :: OutputType -> String
showsPrec :: Int -> OutputType -> ShowS
$cshowsPrec :: Int -> OutputType -> ShowS
Show, OutputType -> OutputType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputType -> OutputType -> Bool
$c/= :: OutputType -> OutputType -> Bool
== :: OutputType -> OutputType -> Bool
$c== :: OutputType -> OutputType -> Bool
Eq, Int -> OutputType
OutputType -> Int
OutputType -> [OutputType]
OutputType -> OutputType
OutputType -> OutputType -> [OutputType]
OutputType -> OutputType -> OutputType -> [OutputType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OutputType -> OutputType -> OutputType -> [OutputType]
$cenumFromThenTo :: OutputType -> OutputType -> OutputType -> [OutputType]
enumFromTo :: OutputType -> OutputType -> [OutputType]
$cenumFromTo :: OutputType -> OutputType -> [OutputType]
enumFromThen :: OutputType -> OutputType -> [OutputType]
$cenumFromThen :: OutputType -> OutputType -> [OutputType]
enumFrom :: OutputType -> [OutputType]
$cenumFrom :: OutputType -> [OutputType]
fromEnum :: OutputType -> Int
$cfromEnum :: OutputType -> Int
toEnum :: Int -> OutputType
$ctoEnum :: Int -> OutputType
pred :: OutputType -> OutputType
$cpred :: OutputType -> OutputType
succ :: OutputType -> OutputType
$csucc :: OutputType -> OutputType
Enum, OutputType
forall a. a -> a -> Bounded a
maxBound :: OutputType
$cmaxBound :: OutputType
minBound :: OutputType
$cminBound :: OutputType
Bounded, forall x. Rep OutputType x -> OutputType
forall x. OutputType -> Rep OutputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutputType x -> OutputType
$cfrom :: forall x. OutputType -> Rep OutputType x
Generic)

instance NFData OutputType

getInputItem :: Int -> Input -> InputType -> Get Input
getInputItem :: Int -> Input -> InputType -> Get Input
getInputItem Int
0 input :: Input
input@Input{nonWitnessUtxo :: Input -> Maybe Tx
nonWitnessUtxo = Maybe Tx
Nothing} InputType
InNonWitnessUtxo = do
    Tx
utxo <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return Input
input{nonWitnessUtxo :: Maybe Tx
nonWitnessUtxo = forall a. a -> Maybe a
Just Tx
utxo}
getInputItem Int
0 input :: Input
input@Input{witnessUtxo :: Input -> Maybe TxOut
witnessUtxo = Maybe TxOut
Nothing} InputType
InWitnessUtxo = do
    TxOut
utxo <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return Input
input{witnessUtxo :: Maybe TxOut
witnessUtxo = forall a. a -> Maybe a
Just TxOut
utxo}
getInputItem Int
keySize Input
input InputType
InPartialSig = do
    (PubKeyI
k, ByteString
v) <- Get (PubKeyI, ByteString)
getPartialSig
    forall (m :: * -> *) a. Monad m => a -> m a
return
        Input
input
            { partialSigs :: HashMap PubKeyI ByteString
partialSigs = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert PubKeyI
k ByteString
v (Input -> HashMap PubKeyI ByteString
partialSigs Input
input)
            }
  where
    getPartialSig :: Get (PubKeyI, ByteString)
getPartialSig =
        (,)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get a -> Get a
S.isolate Int
keySize forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarString -> ByteString
getVarString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
getInputItem Int
0 input :: Input
input@Input{sigHashType :: Input -> Maybe SigHash
sigHashType = Maybe SigHash
Nothing} InputType
InSigHashType = do
    VarInt Word64
size <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word64
size forall a. Eq a => a -> a -> Bool
== Word64
0x04
    SigHash
sigHash <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get KeyIndex
S.getWord32le
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
input{sigHashType :: Maybe SigHash
sigHashType = forall a. a -> Maybe a
Just SigHash
sigHash}
getInputItem Int
0 input :: Input
input@Input{inputRedeemScript :: Input -> Maybe Script
inputRedeemScript = Maybe Script
Nothing} InputType
InRedeemScript = do
    Script
script <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
input{inputRedeemScript :: Maybe Script
inputRedeemScript = forall a. a -> Maybe a
Just Script
script}
getInputItem Int
0 input :: Input
input@Input{inputWitnessScript :: Input -> Maybe Script
inputWitnessScript = Maybe Script
Nothing} InputType
InWitnessScript = do
    Script
script <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
input{inputWitnessScript :: Maybe Script
inputWitnessScript = forall a. a -> Maybe a
Just Script
script}
getInputItem Int
keySize Input
input InputType
InBIP32Derivation = do
    (PubKeyI
k, (Fingerprint, [KeyIndex])
v) <- Int -> Get (PubKeyI, (Fingerprint, [KeyIndex]))
getHDPath Int
keySize
    forall (m :: * -> *) a. Monad m => a -> m a
return
        Input
input
            { inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert PubKeyI
k (Fingerprint, [KeyIndex])
v (Input -> HashMap PubKeyI (Fingerprint, [KeyIndex])
inputHDKeypaths Input
input)
            }
getInputItem Int
0 input :: Input
input@Input{finalScriptSig :: Input -> Maybe Script
finalScriptSig = Maybe Script
Nothing} InputType
InFinalScriptSig = do
    Script
script <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
input{finalScriptSig :: Maybe Script
finalScriptSig = forall a. a -> Maybe a
Just Script
script}
getInputItem Int
0 input :: Input
input@Input{finalScriptWitness :: Input -> Maybe WitnessStack
finalScriptWitness = Maybe WitnessStack
Nothing} InputType
InFinalScriptWitness = do
    WitnessStack
scripts <- forall a b. (a -> b) -> [a] -> [b]
map VarString -> ByteString
getVarString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [VarString]
getVarIntList
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
input{finalScriptWitness :: Maybe WitnessStack
finalScriptWitness = forall a. a -> Maybe a
Just WitnessStack
scripts}
  where
    getVarIntList :: Get [VarString]
getVarIntList = forall a. Get a -> Get a
getSizedBytes forall a b. (a -> b) -> a -> b
$ do
        VarInt Word64
n <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize -- Item count
        forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
getInputItem Int
keySize Input
input InputType
inputType =
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"Incorrect key size for input item or item already existed: "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
keySize, Input
input, InputType
inputType)

getOutputItem :: Int -> Output -> OutputType -> Get Output
getOutputItem :: Int -> Output -> OutputType -> Get Output
getOutputItem Int
0 output :: Output
output@Output{outputRedeemScript :: Output -> Maybe Script
outputRedeemScript = Maybe Script
Nothing} OutputType
OutRedeemScript = do
    Script
script <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Output
output{outputRedeemScript :: Maybe Script
outputRedeemScript = forall a. a -> Maybe a
Just Script
script}
getOutputItem Int
0 output :: Output
output@Output{outputWitnessScript :: Output -> Maybe Script
outputWitnessScript = Maybe Script
Nothing} OutputType
OutWitnessScript = do
    Script
script <- forall a. Get a -> Get a
getSizedBytes forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Output
output{outputWitnessScript :: Maybe Script
outputWitnessScript = forall a. a -> Maybe a
Just Script
script}
getOutputItem Int
keySize Output
output OutputType
OutBIP32Derivation = do
    (PubKeyI
k, (Fingerprint, [KeyIndex])
v) <- Int -> Get (PubKeyI, (Fingerprint, [KeyIndex]))
getHDPath Int
keySize
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Output
output{outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert PubKeyI
k (Fingerprint, [KeyIndex])
v (Output -> HashMap PubKeyI (Fingerprint, [KeyIndex])
outputHDKeypaths Output
output)}
getOutputItem Int
keySize Output
output OutputType
outputType =
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"Incorrect key size for output item or item already existed: "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
keySize, Output
output, OutputType
outputType)

getHDPath :: Int -> Get (PubKeyI, (Fingerprint, [KeyIndex]))
getHDPath :: Int -> Get (PubKeyI, (Fingerprint, [KeyIndex]))
getHDPath Int
keySize =
    (,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get a -> Get a
S.isolate Int
keySize forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PSBTHDPath -> (Fingerprint, [KeyIndex])
unPSBTHDPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
S.get)

putHDPath :: Enum t => t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put
putHDPath :: forall t.
Enum t =>
t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put
putHDPath t
t = forall t a. Enum t => (a -> Put) -> t -> HashMap PubKeyI a -> Put
putPubKeyMap forall t. Serialize t => Putter t
S.put t
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Fingerprint, [KeyIndex]) -> PSBTHDPath
PSBTHDPath

newtype PSBTHDPath = PSBTHDPath {PSBTHDPath -> (Fingerprint, [KeyIndex])
unPSBTHDPath :: (Fingerprint, [KeyIndex])}
    deriving (Int -> PSBTHDPath -> ShowS
[PSBTHDPath] -> ShowS
PSBTHDPath -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSBTHDPath] -> ShowS
$cshowList :: [PSBTHDPath] -> ShowS
show :: PSBTHDPath -> String
$cshow :: PSBTHDPath -> String
showsPrec :: Int -> PSBTHDPath -> ShowS
$cshowsPrec :: Int -> PSBTHDPath -> ShowS
Show, PSBTHDPath -> PSBTHDPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PSBTHDPath -> PSBTHDPath -> Bool
$c/= :: PSBTHDPath -> PSBTHDPath -> Bool
== :: PSBTHDPath -> PSBTHDPath -> Bool
$c== :: PSBTHDPath -> PSBTHDPath -> Bool
Eq, forall x. Rep PSBTHDPath x -> PSBTHDPath
forall x. PSBTHDPath -> Rep PSBTHDPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PSBTHDPath x -> PSBTHDPath
$cfrom :: forall x. PSBTHDPath -> Rep PSBTHDPath x
Generic)

instance NFData PSBTHDPath

instance Serialize PSBTHDPath where
    get :: Get PSBTHDPath
get = do
        VarInt Word64
valueSize <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word64
valueSize forall a. Integral a => a -> a -> a
`mod` Word64
4 forall a. Eq a => a -> a -> Bool
== Word64
0
        let numIndices :: Int
numIndices = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
valueSize forall a. Num a => a -> a -> a
- Int
4) forall a. Integral a => a -> a -> a
`div` Int
4
        (Fingerprint, [KeyIndex]) -> PSBTHDPath
PSBTHDPath
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get a -> Get a
S.isolate
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
valueSize)
                ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
S.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get [KeyIndex]
getKeyIndexList Int
numIndices)
      where
        getKeyIndexList :: Int -> Get [KeyIndex]
getKeyIndexList Int
n = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Get KeyIndex
S.getWord32le

    put :: Putter PSBTHDPath
put (PSBTHDPath (Fingerprint
fp, [KeyIndex]
kis)) = do
        forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (ByteString -> Int
B.length ByteString
bs)
        Putter ByteString
S.putByteString ByteString
bs
      where
        bs :: ByteString
bs = Put -> ByteString
S.runPut forall a b. (a -> b) -> a -> b
$ forall t. Serialize t => Putter t
S.put Fingerprint
fp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter KeyIndex
S.putWord32le [KeyIndex]
kis

putPubKeyMap :: Enum t => (a -> Put) -> t -> HashMap PubKeyI a -> Put
putPubKeyMap :: forall t a. Enum t => (a -> Put) -> t -> HashMap PubKeyI a -> Put
putPubKeyMap a -> Put
f t
t =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey forall {a}. Serial a => a -> a -> Put
putItem
  where
    putItem :: a -> a -> Put
putItem a
k a
v = do
        forall t. Serialize t => Putter t
S.put forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> Key
Key (forall a. Enum a => a -> Word8
enumWord8 t
t) (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
k))
        a -> Put
f a
v

enumWord8 :: Enum a => a -> Word8
enumWord8 :: forall a. Enum a => a -> Word8
enumWord8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

word8Enum :: forall a. (Bounded a, Enum a) => Word8 -> Either Word8 a
word8Enum :: forall a. (Bounded a, Enum a) => Word8 -> Either Word8 a
word8Enum Word8
n | Word8
n forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> Word8
enumWord8 (forall a. Bounded a => a
maxBound :: a) = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n
word8Enum Word8
n = forall a b. a -> Either a b
Left Word8
n

whenJust :: Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
whenJust = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())

justWhen :: (a -> Bool) -> a -> Maybe a
justWhen :: forall a. (a -> Bool) -> a -> Maybe a
justWhen a -> Bool
test a
x = if a -> Bool
test a
x then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing