{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- 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
    PSBT (..),
    getPSBT,
    putPSBT,
    Input (..),
    getInput,
    putInput,
    Output (..),
    getOutput,
    putOutput,
    UnknownMap (..),
    Key (..),
    merge,
    mergeMany,
    mergeInput,
    mergeOutput,
    complete,
    finalTransaction,
    emptyPSBT,
    emptyInput,
    emptyOutput,

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

import Control.Applicative ((<|>))
import Control.DeepSeq (NFData)
import Control.Monad (foldM, guard, replicateM, unless, void)
import Crypto.Secp256k1
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial (Serial (..))
import Data.Either (fromRight)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Hashable (Hashable)
import Data.List (foldl')
import Data.Maybe (fromMaybe, isJust)
import Data.Serialize (Get, Put, Serialize (..))
import Data.Serialize qualified as S
import Data.String.Conversions (cs)
import GHC.Generics (Generic)
import GHC.Word (Word32, Word8)
import Haskoin.Address (Address (..), pubKeyAddr)
import Haskoin.Crypto.Keys.Common
import Haskoin.Crypto.Keys.Extended
import Haskoin.Network.Common
import Haskoin.Network.Data
import Haskoin.Script.Common
import Haskoin.Script.SigHash
import Haskoin.Script.Standard
import Haskoin.Transaction.Builder.Sign
import Haskoin.Transaction.Common
import Haskoin.Transaction.Segwit
import Haskoin.Util
import Numeric (showHex)

-- | 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
-- 'PSBT' line up by index with the inputs and outputs in
-- the unsigned transaction.
data PSBT = PSBT
  { PSBT -> Tx
unsignedTransaction :: Tx,
    PSBT -> UnknownMap
globalUnknown :: UnknownMap,
    PSBT -> [Input]
inputs :: [Input],
    PSBT -> [Output]
outputs :: [Output]
  }
  deriving (Int -> PSBT -> ShowS
[PSBT] -> ShowS
PSBT -> String
(Int -> PSBT -> ShowS)
-> (PSBT -> String) -> ([PSBT] -> ShowS) -> Show PSBT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PSBT -> ShowS
showsPrec :: Int -> PSBT -> ShowS
$cshow :: PSBT -> String
show :: PSBT -> String
$cshowList :: [PSBT] -> ShowS
showList :: [PSBT] -> ShowS
Show, ReadPrec [PSBT]
ReadPrec PSBT
Int -> ReadS PSBT
ReadS [PSBT]
(Int -> ReadS PSBT)
-> ReadS [PSBT] -> ReadPrec PSBT -> ReadPrec [PSBT] -> Read PSBT
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PSBT
readsPrec :: Int -> ReadS PSBT
$creadList :: ReadS [PSBT]
readList :: ReadS [PSBT]
$creadPrec :: ReadPrec PSBT
readPrec :: ReadPrec PSBT
$creadListPrec :: ReadPrec [PSBT]
readListPrec :: ReadPrec [PSBT]
Read, PSBT -> PSBT -> Bool
(PSBT -> PSBT -> Bool) -> (PSBT -> PSBT -> Bool) -> Eq PSBT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSBT -> PSBT -> Bool
== :: PSBT -> PSBT -> Bool
$c/= :: PSBT -> PSBT -> Bool
/= :: PSBT -> PSBT -> Bool
Eq, (forall x. PSBT -> Rep PSBT x)
-> (forall x. Rep PSBT x -> PSBT) -> Generic PSBT
forall x. Rep PSBT x -> PSBT
forall x. PSBT -> Rep PSBT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PSBT -> Rep PSBT x
from :: forall x. PSBT -> Rep PSBT x
$cto :: forall x. Rep PSBT x -> PSBT
to :: forall x. Rep PSBT x -> PSBT
Generic)
  deriving anyclass (PSBT -> ()
(PSBT -> ()) -> NFData PSBT
forall a. (a -> ()) -> NFData a
$crnf :: PSBT -> ()
rnf :: PSBT -> ()
NFData)

-- | 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 PublicKey WitnessStackItem
partialSigs :: HashMap PublicKey ByteString,
    Input -> Maybe SigHash
sigHashType :: Maybe SigHash,
    Input -> Maybe Script
inputRedeemScript :: Maybe Script,
    Input -> Maybe Script
inputWitnessScript :: Maybe Script,
    Input -> HashMap PublicKey (Fingerprint, [KeyIndex])
inputHDKeypaths :: HashMap PublicKey (Fingerprint, [KeyIndex]),
    Input -> Maybe Script
finalScriptSig :: Maybe Script,
    Input -> Maybe [WitnessStackItem]
finalScriptWitness :: Maybe WitnessStack,
    Input -> UnknownMap
inputUnknown :: UnknownMap
  }
  deriving (Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> String
show :: Input -> String
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show, ReadPrec [Input]
ReadPrec Input
Int -> ReadS Input
ReadS [Input]
(Int -> ReadS Input)
-> ReadS [Input]
-> ReadPrec Input
-> ReadPrec [Input]
-> Read Input
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Input
readsPrec :: Int -> ReadS Input
$creadList :: ReadS [Input]
readList :: ReadS [Input]
$creadPrec :: ReadPrec Input
readPrec :: ReadPrec Input
$creadListPrec :: ReadPrec [Input]
readListPrec :: ReadPrec [Input]
Read, Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
/= :: Input -> Input -> Bool
Eq, (forall x. Input -> Rep Input x)
-> (forall x. Rep Input x -> Input) -> Generic Input
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
$cfrom :: forall x. Input -> Rep Input x
from :: forall x. Input -> Rep Input x
$cto :: forall x. Rep Input x -> Input
to :: forall x. Rep Input x -> Input
Generic)
  deriving anyclass (Input -> ()
(Input -> ()) -> NFData Input
forall a. (a -> ()) -> NFData a
$crnf :: Input -> ()
rnf :: Input -> ()
NFData)

-- | 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 PublicKey (Fingerprint, [KeyIndex])
outputHDKeypaths :: HashMap PublicKey (Fingerprint, [KeyIndex]),
    Output -> UnknownMap
outputUnknown :: UnknownMap
  }
  deriving (Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> String
show :: Output -> String
$cshowList :: [Output] -> ShowS
showList :: [Output] -> ShowS
Show, ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
(Int -> ReadS Output)
-> ReadS [Output]
-> ReadPrec Output
-> ReadPrec [Output]
-> Read Output
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Output
readsPrec :: Int -> ReadS Output
$creadList :: ReadS [Output]
readList :: ReadS [Output]
$creadPrec :: ReadPrec Output
readPrec :: ReadPrec Output
$creadListPrec :: ReadPrec [Output]
readListPrec :: ReadPrec [Output]
Read, Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
/= :: Output -> Output -> Bool
Eq, (forall x. Output -> Rep Output x)
-> (forall x. Rep Output x -> Output) -> Generic Output
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
$cfrom :: forall x. Output -> Rep Output x
from :: forall x. Output -> Rep Output x
$cto :: forall x. Rep Output x -> Output
to :: forall x. Rep Output x -> Output
Generic)
  deriving anyclass (Output -> ()
(Output -> ()) -> NFData Output
forall a. (a -> ()) -> NFData a
$crnf :: Output -> ()
rnf :: Output -> ()
NFData)

-- | 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 WitnessStackItem
unknownMap :: HashMap Key ByteString}
  deriving (Int -> UnknownMap -> ShowS
[UnknownMap] -> ShowS
UnknownMap -> String
(Int -> UnknownMap -> ShowS)
-> (UnknownMap -> String)
-> ([UnknownMap] -> ShowS)
-> Show UnknownMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnknownMap -> ShowS
showsPrec :: Int -> UnknownMap -> ShowS
$cshow :: UnknownMap -> String
show :: UnknownMap -> String
$cshowList :: [UnknownMap] -> ShowS
showList :: [UnknownMap] -> ShowS
Show, ReadPrec [UnknownMap]
ReadPrec UnknownMap
Int -> ReadS UnknownMap
ReadS [UnknownMap]
(Int -> ReadS UnknownMap)
-> ReadS [UnknownMap]
-> ReadPrec UnknownMap
-> ReadPrec [UnknownMap]
-> Read UnknownMap
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnknownMap
readsPrec :: Int -> ReadS UnknownMap
$creadList :: ReadS [UnknownMap]
readList :: ReadS [UnknownMap]
$creadPrec :: ReadPrec UnknownMap
readPrec :: ReadPrec UnknownMap
$creadListPrec :: ReadPrec [UnknownMap]
readListPrec :: ReadPrec [UnknownMap]
Read, UnknownMap -> UnknownMap -> Bool
(UnknownMap -> UnknownMap -> Bool)
-> (UnknownMap -> UnknownMap -> Bool) -> Eq UnknownMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnknownMap -> UnknownMap -> Bool
== :: UnknownMap -> UnknownMap -> Bool
$c/= :: UnknownMap -> UnknownMap -> Bool
/= :: UnknownMap -> UnknownMap -> Bool
Eq, (forall x. UnknownMap -> Rep UnknownMap x)
-> (forall x. Rep UnknownMap x -> UnknownMap) -> Generic UnknownMap
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
$cfrom :: forall x. UnknownMap -> Rep UnknownMap x
from :: forall x. UnknownMap -> Rep UnknownMap x
$cto :: forall x. Rep UnknownMap x -> UnknownMap
to :: forall x. Rep UnknownMap x -> UnknownMap
Generic)
  deriving newtype (NonEmpty UnknownMap -> UnknownMap
UnknownMap -> UnknownMap -> UnknownMap
(UnknownMap -> UnknownMap -> UnknownMap)
-> (NonEmpty UnknownMap -> UnknownMap)
-> (forall b. Integral b => b -> UnknownMap -> UnknownMap)
-> Semigroup 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
$c<> :: UnknownMap -> UnknownMap -> UnknownMap
<> :: UnknownMap -> UnknownMap -> UnknownMap
$csconcat :: NonEmpty UnknownMap -> UnknownMap
sconcat :: NonEmpty UnknownMap -> UnknownMap
$cstimes :: forall b. Integral b => b -> UnknownMap -> UnknownMap
stimes :: forall b. Integral b => b -> UnknownMap -> UnknownMap
Semigroup, Semigroup UnknownMap
UnknownMap
Semigroup UnknownMap =>
UnknownMap
-> (UnknownMap -> UnknownMap -> UnknownMap)
-> ([UnknownMap] -> UnknownMap)
-> Monoid UnknownMap
[UnknownMap] -> UnknownMap
UnknownMap -> UnknownMap -> UnknownMap
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: UnknownMap
mempty :: UnknownMap
$cmappend :: UnknownMap -> UnknownMap -> UnknownMap
mappend :: UnknownMap -> UnknownMap -> UnknownMap
$cmconcat :: [UnknownMap] -> UnknownMap
mconcat :: [UnknownMap] -> UnknownMap
Monoid, UnknownMap -> ()
(UnknownMap -> ()) -> NFData UnknownMap
forall a. (a -> ()) -> NFData a
$crnf :: UnknownMap -> ()
rnf :: UnknownMap -> ()
NFData)

-- | Raw keys for the map type used in PSBTs.
data Key = Key
  { Key -> Word8
keyType :: Word8,
    Key -> WitnessStackItem
key :: ByteString
  }
  deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Key
readsPrec :: Int -> ReadS Key
$creadList :: ReadS [Key]
readList :: ReadS [Key]
$creadPrec :: ReadPrec Key
readPrec :: ReadPrec Key
$creadListPrec :: ReadPrec [Key]
readListPrec :: ReadPrec [Key]
Read, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
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
$cfrom :: forall x. Key -> Rep Key x
from :: forall x. Key -> Rep Key x
$cto :: forall x. Rep Key x -> Key
to :: forall x. Rep Key x -> Key
Generic, Key -> ()
(Key -> ()) -> NFData Key
forall a. (a -> ()) -> NFData a
$crnf :: Key -> ()
rnf :: Key -> ()
NFData, Eq Key
Eq Key => (Int -> Key -> Int) -> (Key -> Int) -> Hashable Key
Int -> Key -> Int
Key -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Key -> Int
hashWithSalt :: Int -> Key -> Int
$chash :: Key -> Int
hash :: Key -> Int
Hashable)

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

-- | A version of 'merge' for a collection of PSBTs.
--
-- @since 0.21.0
mergeMany :: [PSBT] -> Maybe PSBT
mergeMany :: [PSBT] -> Maybe PSBT
mergeMany (PSBT
psbt : [PSBT]
psbts) = (PSBT -> PSBT -> Maybe PSBT) -> PSBT -> [PSBT] -> Maybe PSBT
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM PSBT -> PSBT -> Maybe PSBT
merge PSBT
psbt [PSBT]
psbts
mergeMany [PSBT]
_ = Maybe PSBT
forall a. Maybe a
Nothing

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

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

-- | 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
-> PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
unPSBTSigner ::
      PublicKey ->
      Maybe (Fingerprint, DerivPath) ->
      Maybe SecKey
  }

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

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

-- | Fetch the secret key for the given 'PublicKey' if possible.
--
-- @since 0.21@
getSignerKey :: PSBTSigner -> PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
getSignerKey :: PSBTSigner
-> PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
getSignerKey = (.unPSBTSigner)

-- | This signer can sign for one key.
--
-- @since 0.21@
secKeySigner :: Ctx -> SecKey -> PSBTSigner
secKeySigner :: Ctx -> SecKey -> PSBTSigner
secKeySigner Ctx
ctx SecKey
theSecKey =
  (PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> PSBTSigner
PSBTSigner PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
forall {r} {p}. HasField "point" r PubKey => r -> p -> Maybe SecKey
signer
  where
    signer :: r -> p -> Maybe SecKey
signer r
requiredKey p
_
      | r
requiredKey.point PubKey -> PubKey -> Bool
forall a. Eq a => a -> a -> Bool
== Ctx -> SecKey -> PubKey
derivePubKey Ctx
ctx SecKey
theSecKey = SecKey -> Maybe SecKey
forall a. a -> Maybe a
Just SecKey
theSecKey
      | Bool
otherwise = Maybe SecKey
forall a. Maybe a
Nothing

-- | This signer can sign with any child key, provided that derivation information is present.
--
-- @since 0.21@
xPrvSigner ::
  Ctx ->
  XPrvKey ->
  -- | Origin data, if the input key is explicitly a child key
  Maybe (Fingerprint, DerivPath) ->
  PSBTSigner
xPrvSigner :: Ctx -> XPrvKey -> Maybe (Fingerprint, DerivPath) -> PSBTSigner
xPrvSigner Ctx
ctx XPrvKey
xprv Maybe (Fingerprint, DerivPath)
origin = (PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> PSBTSigner
PSBTSigner PublicKey -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
forall {r} {t}.
HasField "point" r PubKey =>
r -> Maybe (Fingerprint, DerivPathI t) -> Maybe SecKey
signer
  where
    signer :: r -> Maybe (Fingerprint, DerivPathI t) -> Maybe SecKey
signer r
pubKey (Just (Fingerprint, DerivPathI t)
hdData)
      | result :: Maybe SecKey
result@(Just SecKey
theSecKey) <- ((Fingerprint, DerivPathI t) -> Maybe SecKey)
-> ((Fingerprint, DerivPath)
    -> (Fingerprint, DerivPathI t) -> Maybe SecKey)
-> Maybe (Fingerprint, DerivPath)
-> (Fingerprint, DerivPathI t)
-> Maybe SecKey
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Fingerprint, DerivPathI t) -> Maybe SecKey
forall {t}. (Fingerprint, DerivPathI t) -> Maybe SecKey
noOrigin (Fingerprint, DerivPath)
-> (Fingerprint, DerivPathI t) -> Maybe SecKey
forall {t} {t}.
(Fingerprint, DerivPathI t)
-> (Fingerprint, DerivPathI t) -> Maybe SecKey
onOrigin Maybe (Fingerprint, DerivPath)
origin (Fingerprint, DerivPathI t)
hdData,
        r
pubKey.point PubKey -> PubKey -> Bool
forall a. Eq a => a -> a -> Bool
== Ctx -> SecKey -> PubKey
derivePubKey Ctx
ctx SecKey
theSecKey =
          Maybe SecKey
result
    signer r
_ Maybe (Fingerprint, DerivPathI t)
_ = Maybe SecKey
forall a. Maybe a
Nothing

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

    deriveSecKey :: DerivPathI t -> SecKey
deriveSecKey DerivPathI t
path = (Ctx -> DerivPathI t -> XPrvKey -> XPrvKey
forall t. Ctx -> DerivPathI t -> XPrvKey -> XPrvKey
derivePath Ctx
ctx DerivPathI t
path XPrvKey
xprv).key

    thisFP :: Fingerprint
thisFP = Ctx -> XPubKey -> Fingerprint
xPubFP Ctx
ctx (XPubKey -> Fingerprint) -> XPubKey -> Fingerprint
forall a b. (a -> b) -> a -> b
$ Ctx -> XPrvKey -> XPubKey
deriveXPubKey Ctx
ctx 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 KeyIndex -> KeyIndex -> Bool
forall a. Eq a => a -> a -> Bool
== KeyIndex
thisIx = [KeyIndex] -> [KeyIndex] -> Maybe DerivPath
adjustPath [KeyIndex]
originTail [KeyIndex]
thisTail
      | Bool
otherwise = Maybe DerivPath
forall a. Maybe a
Nothing
    adjustPath [] [KeyIndex]
thePath = DerivPath -> Maybe DerivPath
forall a. a -> Maybe a
Just (DerivPath -> Maybe DerivPath) -> DerivPath -> Maybe DerivPath
forall a b. (a -> b) -> a -> b
$ [KeyIndex] -> DerivPath
listToPath [KeyIndex]
thePath
    adjustPath [KeyIndex]
_ [KeyIndex]
_ = Maybe DerivPath
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 ->
  Ctx ->
  PSBTSigner ->
  PSBT ->
  PSBT
signPSBT :: Network -> Ctx -> PSBTSigner -> PSBT -> PSBT
signPSBT Network
net Ctx
ctx PSBTSigner
signer PSBT {[Output]
[Input]
Tx
UnknownMap
$sel:unsignedTransaction:PSBT :: PSBT -> Tx
$sel:globalUnknown:PSBT :: PSBT -> UnknownMap
$sel:inputs:PSBT :: PSBT -> [Input]
$sel:outputs:PSBT :: PSBT -> [Output]
unsignedTransaction :: Tx
globalUnknown :: UnknownMap
inputs :: [Input]
outputs :: [Output]
..} =
  PSBT {$sel:inputs:PSBT :: [Input]
inputs = (Int, Input) -> Input
f ((Int, Input) -> Input) -> [(Int, Input)] -> [Input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Input] -> [(Int, Input)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Input]
inputs, [Output]
Tx
UnknownMap
$sel:unsignedTransaction:PSBT :: Tx
$sel:globalUnknown:PSBT :: UnknownMap
$sel:outputs:PSBT :: [Output]
unsignedTransaction :: Tx
globalUnknown :: UnknownMap
outputs :: [Output]
..}
  where
    f :: (Int, Input) -> Input
f = Network -> Ctx -> PSBTSigner -> Tx -> (Int, Input) -> Input
addSigsForInput Network
net Ctx
ctx PSBTSigner
signer Tx
unsignedTransaction

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

onPrevTxOut ::
  Network ->
  Ctx ->
  PSBTSigner ->
  Tx ->
  Int ->
  Input ->
  Either Tx TxOut ->
  Input
onPrevTxOut :: Network
-> Ctx
-> PSBTSigner
-> Tx
-> Int
-> Input
-> Either Tx TxOut
-> Input
onPrevTxOut Network
net Ctx
ctx PSBTSigner
signer Tx
tx Int
ix Input
input Either Tx TxOut
prevTxData =
  Input
input
    { partialSigs = newSigs <> input.partialSigs
    }
  where
    newSigs :: HashMap PublicKey WitnessStackItem
newSigs = (PublicKey -> SecKey -> WitnessStackItem)
-> HashMap PublicKey SecKey -> HashMap PublicKey WitnessStackItem
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey PublicKey -> SecKey -> WitnessStackItem
forall {r}.
HasField "compress" r Bool =>
r -> SecKey -> WitnessStackItem
sigForInput HashMap PublicKey SecKey
sigKeys
    sigForInput :: r -> SecKey -> WitnessStackItem
sigForInput r
thePubKey SecKey
theSecKey =
      Network -> Ctx -> TxSignature -> WitnessStackItem
encodeTxSig Network
net Ctx
ctx (TxSignature -> WitnessStackItem)
-> (PrivateKey -> TxSignature) -> PrivateKey -> WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network
-> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> TxSignature
makeSignature Network
net Ctx
ctx Tx
tx Int
ix SigInput
theSigInput (PrivateKey -> WitnessStackItem) -> PrivateKey -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$
        SecKey -> Bool -> PrivateKey
PrivateKey SecKey
theSecKey r
thePubKey.compress

    theSigInput :: SigInput
theSigInput =
      SigInput
        { -- Must be the segwit input script for segwit spends (even nested)
          $sel:script:SigInput :: ScriptOutput
script = ScriptOutput -> Maybe ScriptOutput -> ScriptOutput
forall a. a -> Maybe a -> a
fromMaybe ScriptOutput
theInputScript Maybe ScriptOutput
segwitInput,
          $sel:value:SigInput :: Word64
value = TxOut
prevTxOut.value,
          $sel:outpoint:SigInput :: OutPoint
outpoint = OutPoint
thePrevOutPoint,
          $sel:sighash:SigInput :: SigHash
sighash = SigHash -> Maybe SigHash -> SigHash
forall a. a -> Maybe a -> a
fromMaybe SigHash
sigHashAll Input
input.sigHashType,
          -- Must be the witness script for segwit spends (even nested)
          $sel:redeem:SigInput :: Maybe ScriptOutput
redeem = Maybe ScriptOutput
theWitnessScript Maybe ScriptOutput -> Maybe ScriptOutput -> Maybe ScriptOutput
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ScriptOutput
theRedeemScript
        }

    prevTxOut :: TxOut
prevTxOut =
      let rf :: Tx -> TxOut
rf = (([TxOut] -> Int -> TxOut
forall a. HasCallStack => [a] -> Int -> a
!! (KeyIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KeyIndex -> Int) -> (OutPoint -> KeyIndex) -> OutPoint -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.index)) OutPoint
thePrevOutPoint) ([TxOut] -> TxOut) -> (Tx -> [TxOut]) -> Tx -> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.outputs))
       in (Tx -> TxOut) -> (TxOut -> TxOut) -> Either Tx TxOut -> TxOut
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Tx -> TxOut
rf TxOut -> TxOut
forall a. a -> a
id Either Tx TxOut
prevTxData
    thePrevOutPoint :: OutPoint
thePrevOutPoint = (Tx
tx.inputs [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
ix).outpoint

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

    theInputScript :: ScriptOutput
theInputScript = ScriptOutput -> Either String ScriptOutput -> ScriptOutput
forall b a. b -> Either a b -> b
fromRight ScriptOutput
forall {a}. a
inputScriptErr (Either String ScriptOutput -> ScriptOutput)
-> Either String ScriptOutput -> ScriptOutput
forall a b. (a -> b) -> a -> b
$ (Ctx -> WitnessStackItem -> Either String ScriptOutput
forall s a. Marshal s a => s -> WitnessStackItem -> Either String a
unmarshal Ctx
ctx (WitnessStackItem -> Either String ScriptOutput)
-> (TxOut -> WitnessStackItem)
-> TxOut
-> Either String ScriptOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script)) TxOut
prevTxOut
    inputScriptErr :: a
inputScriptErr = String -> a
forall a. HasCallStack => String -> a
error String
"addSigsForInput: Unable to decode input script"

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

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

    sigKeys :: HashMap PublicKey SecKey
sigKeys = (PublicKey -> (Fingerprint, [KeyIndex]) -> Maybe SecKey)
-> HashMap PublicKey (Fingerprint, [KeyIndex])
-> HashMap PublicKey SecKey
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapMaybeWithKey PublicKey -> (Fingerprint, [KeyIndex]) -> Maybe SecKey
getSignerKey Input
input.inputHDKeypaths
    getSignerKey :: PublicKey -> (Fingerprint, [KeyIndex]) -> Maybe SecKey
getSignerKey PublicKey
pubKey (Fingerprint
fp, [KeyIndex]
ixs) = (.unPSBTSigner) PSBTSigner
signer PublicKey
pubKey (Maybe (Fingerprint, DerivPath) -> Maybe SecKey)
-> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
forall a b. (a -> b) -> a -> b
$ (Fingerprint, DerivPath) -> Maybe (Fingerprint, DerivPath)
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 ::
  Ctx ->
  PSBT ->
  PSBT
complete :: Ctx -> PSBT -> PSBT
complete Ctx
ctx PSBT {[Output]
[Input]
Tx
UnknownMap
$sel:unsignedTransaction:PSBT :: PSBT -> Tx
$sel:globalUnknown:PSBT :: PSBT -> UnknownMap
$sel:inputs:PSBT :: PSBT -> [Input]
$sel:outputs:PSBT :: PSBT -> [Output]
unsignedTransaction :: Tx
globalUnknown :: UnknownMap
inputs :: [Input]
outputs :: [Output]
..} =
  PSBT {$sel:inputs:PSBT :: [Input]
inputs = ((KeyIndex, Input) -> Input) -> [(KeyIndex, Input)] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe ScriptOutput, Input) -> Input
completeInput ((Maybe ScriptOutput, Input) -> Input)
-> ((KeyIndex, Input) -> (Maybe ScriptOutput, Input))
-> (KeyIndex, Input)
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyIndex, Input) -> (Maybe ScriptOutput, Input)
forall {a} {b}.
(HasField "outputs" a [TxOut],
 HasField "nonWitnessUtxo" b (Maybe a),
 HasField "witnessUtxo" b (Maybe TxOut)) =>
(KeyIndex, b) -> (Maybe ScriptOutput, b)
analyzeInputs) ([Input] -> [(KeyIndex, Input)]
forall a. [a] -> [(KeyIndex, a)]
indexed [Input]
inputs), [Output]
Tx
UnknownMap
$sel:unsignedTransaction:PSBT :: Tx
$sel:globalUnknown:PSBT :: UnknownMap
$sel:outputs:PSBT :: [Output]
unsignedTransaction :: Tx
globalUnknown :: UnknownMap
outputs :: [Output]
..}
  where
    analyzeInputs :: (KeyIndex, b) -> (Maybe ScriptOutput, b)
analyzeInputs (KeyIndex
i, b
input) =
      (,)
        (TxOut -> Maybe ScriptOutput
outputScript (TxOut -> Maybe ScriptOutput) -> Maybe TxOut -> Maybe ScriptOutput
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b
input.witnessUtxo Maybe TxOut -> Maybe TxOut -> Maybe TxOut
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TxOut
nonWitScript)
        b
input
      where
        nonWitScript :: Maybe TxOut
nonWitScript = KeyIndex -> a -> Maybe TxOut
forall {r} {b}.
HasField "outputs" r [b] =>
KeyIndex -> r -> Maybe b
getPrevOut KeyIndex
i (a -> Maybe TxOut) -> Maybe a -> Maybe TxOut
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b
input.nonWitnessUtxo

    getPrevOut :: KeyIndex -> r -> Maybe b
getPrevOut KeyIndex
i r
tx =
      (r
tx.outputs [b] -> KeyIndex -> Maybe b
forall {b}. [b] -> KeyIndex -> Maybe b
!!?) (KeyIndex -> Maybe b) -> (TxIn -> KeyIndex) -> TxIn -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> KeyIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KeyIndex -> KeyIndex) -> (TxIn -> KeyIndex) -> TxIn -> KeyIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.outpoint.index)
        (TxIn -> Maybe b) -> Maybe TxIn -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Tx
unsignedTransaction.inputs [TxIn] -> KeyIndex -> Maybe TxIn
forall {b}. [b] -> KeyIndex -> Maybe b
!!? KeyIndex
i
    [b]
xs !!? :: [b] -> KeyIndex -> Maybe b
!!? KeyIndex
i = KeyIndex -> [(KeyIndex, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup KeyIndex
i ([(KeyIndex, b)] -> Maybe b) -> [(KeyIndex, b)] -> Maybe b
forall a b. (a -> b) -> a -> b
$ [b] -> [(KeyIndex, b)]
forall a. [a] -> [(KeyIndex, a)]
indexed [b]
xs

    outputScript :: TxOut -> Maybe ScriptOutput
outputScript = Either String ScriptOutput -> Maybe ScriptOutput
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ScriptOutput -> Maybe ScriptOutput)
-> (TxOut -> Either String ScriptOutput)
-> TxOut
-> Maybe ScriptOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> WitnessStackItem -> Either String ScriptOutput
forall s a. Marshal s a => s -> WitnessStackItem -> Either String a
unmarshal Ctx
ctx (WitnessStackItem -> Either String ScriptOutput)
-> (TxOut -> WitnessStackItem)
-> TxOut
-> Either String ScriptOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script)

    completeInput :: (Maybe ScriptOutput, Input) -> Input
completeInput (Maybe ScriptOutput
Nothing, Input
input) = Input
input
    completeInput (Just ScriptOutput
script, Input
input) = Input -> Input
pruneInputFields (Input -> Input) -> Input -> Input
forall a b. (a -> b) -> a -> b
$ Ctx -> Input -> ScriptOutput -> Input
completeSig Ctx
ctx 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
      | Maybe Script -> Bool
forall a. Maybe a -> Bool
isJust Input
input.finalScriptSig Bool -> Bool -> Bool
|| Maybe [WitnessStackItem] -> Bool
forall a. Maybe a -> Bool
isJust Input
input.finalScriptWitness =
          Input
input
            { partialSigs = mempty,
              inputHDKeypaths = mempty,
              inputRedeemScript = Nothing,
              inputWitnessScript = Nothing,
              sigHashType = Nothing
            }
      | Bool
otherwise = Input
input

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

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

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

completeWitnessSig :: Ctx -> Input -> ScriptOutput -> Input
completeWitnessSig :: Ctx -> Input -> ScriptOutput -> Input
completeWitnessSig Ctx
ctx Input
input script :: ScriptOutput
script@(PayMulSig [PublicKey]
pubKeys Int
m)
  | [WitnessStackItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WitnessStackItem]
sigs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m =
      Input
input {finalScriptWitness = Just finalWit}
  where
    sigs :: [WitnessStackItem]
sigs = Int -> [PublicKey] -> Input -> [WitnessStackItem]
collectSigs Int
m [PublicKey]
pubKeys Input
input
    finalWit :: [WitnessStackItem]
finalWit = WitnessStackItem
forall a. Monoid a => a
mempty WitnessStackItem -> [WitnessStackItem] -> [WitnessStackItem]
forall a. a -> [a] -> [a]
: [WitnessStackItem]
sigs [WitnessStackItem] -> [WitnessStackItem] -> [WitnessStackItem]
forall a. Semigroup a => a -> a -> a
<> [Ctx -> ScriptOutput -> WitnessStackItem
forall s a. Marshal s a => s -> a -> WitnessStackItem
marshal Ctx
ctx ScriptOutput
script]
completeWitnessSig Ctx
_ Input
input ScriptOutput
_ = Input
input

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

-- | Take a finalized 'PSBT' and produce the signed final
-- transaction. You may need to call 'complete' on the
-- 'PSBT' before producing the final transaction.
finalTransaction :: PSBT -> Tx
finalTransaction :: PSBT -> Tx
finalTransaction PSBT
psbt =
  ([TxIn], [[WitnessStackItem]]) -> Tx
setInputs
    (([TxIn], [[WitnessStackItem]]) -> Tx)
-> ([(TxIn, Input)] -> ([TxIn], [[WitnessStackItem]]))
-> [(TxIn, Input)]
-> Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([TxIn], [[WitnessStackItem]])
 -> (TxIn, Input) -> ([TxIn], [[WitnessStackItem]]))
-> ([TxIn], [[WitnessStackItem]])
-> [(TxIn, Input)]
-> ([TxIn], [[WitnessStackItem]])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([TxIn], [[WitnessStackItem]])
-> (TxIn, Input) -> ([TxIn], [[WitnessStackItem]])
forall {a} {r} {a}.
(Serial a, HasField "finalScriptSig" r (Maybe a),
 HasField "finalScriptWitness" r (Maybe [a])) =>
([TxIn], [[a]]) -> (TxIn, r) -> ([TxIn], [[a]])
finalizeInput ([], [])
    ([(TxIn, Input)] -> Tx) -> [(TxIn, Input)] -> Tx
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [Input] -> [(TxIn, Input)]
forall a b. [a] -> [b] -> [(a, b)]
zip Tx
tx.inputs PSBT
psbt.inputs
  where
    tx :: Tx
tx = PSBT
psbt.unsignedTransaction
    hasWitness :: Bool
hasWitness = (Input -> Bool) -> [Input] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe [WitnessStackItem] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [WitnessStackItem] -> Bool)
-> (Input -> Maybe [WitnessStackItem]) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.finalScriptWitness)) PSBT
psbt.inputs
    setInputs :: ([TxIn], [[WitnessStackItem]]) -> Tx
setInputs ([TxIn]
ins, [[WitnessStackItem]]
witData) =
      Tx
tx
        { inputs = reverse ins,
          witness = if hasWitness then reverse witData else []
        }
    finalizeInput :: ([TxIn], [[a]]) -> (TxIn, r) -> ([TxIn], [[a]])
finalizeInput ([TxIn]
ins, [[a]]
witData) (TxIn {KeyIndex
WitnessStackItem
OutPoint
outpoint :: OutPoint
script :: WitnessStackItem
sequence :: KeyIndex
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> WitnessStackItem
$sel:sequence:TxIn :: TxIn -> KeyIndex
..}, r
psbtInput) =
      ( TxIn
          { $sel:script:TxIn :: WitnessStackItem
script =
              WitnessStackItem
-> (a -> WitnessStackItem) -> Maybe a -> WitnessStackItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                WitnessStackItem
forall a. Monoid a => a
mempty
                (Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> (a -> Put) -> a -> WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize)
                r
psbtInput.finalScriptSig,
            KeyIndex
OutPoint
outpoint :: OutPoint
sequence :: KeyIndex
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: KeyIndex
..
          }
          TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: [TxIn]
ins,
        [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] r
psbtInput.finalScriptWitness [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
witData
      )

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

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

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

getPSBT :: (MonadGet m) => Ctx -> m PSBT
getPSBT :: forall (m :: * -> *). MonadGet m => Ctx -> m PSBT
getPSBT Ctx
ctx = do
  WitnessStackItem
magic <- Int -> m WitnessStackItem
forall (m :: * -> *). MonadGet m => Int -> m WitnessStackItem
getBytes Int
4
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WitnessStackItem
magic WitnessStackItem -> WitnessStackItem -> Bool
forall a. Eq a => a -> a -> Bool
== WitnessStackItem
"psbt") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Expected magic = 'psbt' but got '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ WitnessStackItem -> String
forall a b. ConvertibleStrings a b => a -> b
cs WitnessStackItem
magic String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
  Word8
headerSep <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
headerSep Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Expected headerSep = 0xff but got 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word8
headerSep String
""

  Word8
keySize <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
keySize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Expected keySize = 1 but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
keySize
  Word8
globalUnsignedTxType <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
globalUnsignedTxType Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Expected globalUnsignedTxType = 0x00 but got 0x"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word8
globalUnsignedTxType String
""
  Tx
unsignedTransaction <- Get Tx -> m Tx
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes Get Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Tx
deserialize
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((TxIn -> Bool) -> [TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (WitnessStackItem -> Bool
B.null (WitnessStackItem -> Bool)
-> (TxIn -> WitnessStackItem) -> TxIn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script)) Tx
unsignedTransaction.inputs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Not all inputs from unsignedTransaction have empty scripts"
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[WitnessStackItem]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Tx
unsignedTransaction.witness) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Not all witnesses from unsignedTransaction are empty"

  UnknownMap
globalUnknown <- m UnknownMap
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m UnknownMap
deserialize
  Word8
globalEnd <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
globalEnd Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Expected globalEnd == 0x00 but got 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word8
globalEnd String
""

  [Input]
inputs <-
    Int -> m Input -> m [Input]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
      ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
unsignedTransaction.inputs)
      (Ctx -> m Input
forall (m :: * -> *). MonadGet m => Ctx -> m Input
getInput Ctx
ctx)
  [Output]
outputs <-
    Int -> m Output -> m [Output]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
      ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
unsignedTransaction.outputs)
      (Ctx -> m Output
forall (m :: * -> *). MonadGet m => Ctx -> m Output
getOutput Ctx
ctx)

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

putPSBT :: (MonadPut m) => Ctx -> PSBT -> m ()
putPSBT :: forall (m :: * -> *). MonadPut m => Ctx -> PSBT -> m ()
putPSBT
  Ctx
ctx
  PSBT
    { Tx
$sel:unsignedTransaction:PSBT :: PSBT -> Tx
unsignedTransaction :: Tx
unsignedTransaction,
      UnknownMap
$sel:globalUnknown:PSBT :: PSBT -> UnknownMap
globalUnknown :: UnknownMap
globalUnknown,
      [Input]
$sel:inputs:PSBT :: PSBT -> [Input]
inputs :: [Input]
inputs,
      [Output]
$sel:outputs:PSBT :: PSBT -> [Output]
outputs :: [Output]
outputs
    } = do
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString WitnessStackItem
"psbt"
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0xff -- Header separator
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01 -- Key size
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00 -- Unsigned Transaction type
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putSizedBytes (WitnessStackItem -> m ()) -> WitnessStackItem -> m ()
forall a b. (a -> b) -> a -> b
$ Tx -> WitnessStackItem
forall a. Serialize a => a -> WitnessStackItem
S.encode Tx
unsignedTransaction
    UnknownMap -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => UnknownMap -> m ()
serialize UnknownMap
globalUnknown
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00 -- Global end
    (Input -> m ()) -> [Input] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ctx -> Input -> m ()
forall (m :: * -> *). MonadPut m => Ctx -> Input -> m ()
putInput Ctx
ctx) [Input]
inputs
    (Output -> m ()) -> [Output] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ctx -> Output -> m ()
forall (m :: * -> *). MonadPut m => Ctx -> Output -> m ()
putOutput Ctx
ctx) [Output]
outputs

instance Serial Key where
  deserialize :: forall (m :: * -> *). MonadGet m => m Key
deserialize = do
    VarInt Word64
keySize <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
keySize Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
        String
"Expected keySize > 0 but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
keySize
    Word8
t <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    WitnessStackItem
k <- Int -> m WitnessStackItem
forall (m :: * -> *). MonadGet m => Int -> m WitnessStackItem
getBytes (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
keySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    Key -> m Key
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> WitnessStackItem -> Key
Key Word8
t WitnessStackItem
k)

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

instance Binary Key where
  put :: Key -> Put
put = Key -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Key -> m ()
serialize
  get :: Get Key
get = Get Key
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Key
deserialize

instance Serialize Key where
  put :: Putter Key
put = Putter Key
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Key -> m ()
serialize
  get :: Get Key
get = Get Key
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Key
deserialize

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

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

getInput :: (MonadGet m) => Ctx -> m Input
getInput :: forall (m :: * -> *). MonadGet m => Ctx -> m Input
getInput Ctx
ctx =
  (Int -> Input -> InputType -> m Input)
-> ((HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
    -> Input -> Input)
-> Input
-> m Input
forall t (m :: * -> *) a.
(Bounded t, Enum t, MonadGet m) =>
(Int -> a -> t -> m a)
-> ((HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
    -> a -> a)
-> a
-> m a
getMap (Ctx -> Int -> Input -> InputType -> m Input
forall (m :: * -> *).
MonadGet m =>
Ctx -> Int -> Input -> InputType -> m Input
getInputItem Ctx
ctx) (HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
-> Input -> Input
setInputUnknown Input
emptyInput
  where
    setInputUnknown :: (HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
-> Input -> Input
setInputUnknown HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem
f Input
input =
      Input
input
        { inputUnknown =
            UnknownMap (f input.inputUnknown.unknownMap)
        }

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

getOutput :: (MonadGet m) => Ctx -> m Output
getOutput :: forall (m :: * -> *). MonadGet m => Ctx -> m Output
getOutput Ctx
ctx = (Int -> Output -> OutputType -> m Output)
-> ((HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
    -> Output -> Output)
-> Output
-> m Output
forall t (m :: * -> *) a.
(Bounded t, Enum t, MonadGet m) =>
(Int -> a -> t -> m a)
-> ((HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
    -> a -> a)
-> a
-> m a
getMap (Ctx -> Int -> Output -> OutputType -> m Output
forall (m :: * -> *).
MonadGet m =>
Ctx -> Int -> Output -> OutputType -> m Output
getOutputItem Ctx
ctx) (HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
-> Output -> Output
setOutputUnknown Output
emptyOutput
  where
    setOutputUnknown :: (HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem)
-> Output -> Output
setOutputUnknown HashMap Key WitnessStackItem -> HashMap Key WitnessStackItem
f Output
output =
      Output
output
        { outputUnknown =
            UnknownMap (f output.outputUnknown.unknownMap)
        }

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

putSizedBytes :: (MonadPut m) => ByteString -> m ()
putSizedBytes :: forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putSizedBytes WitnessStackItem
bs = do
  Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (WitnessStackItem -> Int
B.length WitnessStackItem
bs)
  WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString WitnessStackItem
bs

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

putKeyValue :: (Enum t, MonadPut m) => t -> ByteString -> m ()
putKeyValue :: forall t (m :: * -> *).
(Enum t, MonadPut m) =>
t -> WitnessStackItem -> m ()
putKeyValue t
t WitnessStackItem
v = do
  t -> m ()
forall t (m :: * -> *). (Enum t, MonadPut m) => t -> m ()
putKey t
t
  WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putSizedBytes WitnessStackItem
v

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

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

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

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

getInputItem ::
  (MonadGet m) =>
  Ctx ->
  Int ->
  Input ->
  InputType ->
  m Input
getInputItem :: forall (m :: * -> *).
MonadGet m =>
Ctx -> Int -> Input -> InputType -> m Input
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:nonWitnessUtxo:Input :: Input -> Maybe Tx
nonWitnessUtxo = Maybe Tx
Nothing} InputType
InNonWitnessUtxo = do
  Tx
utxo <- Get Tx -> m Tx
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes Get Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Tx
deserialize
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Input
input {nonWitnessUtxo = Just utxo}
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:witnessUtxo:Input :: Input -> Maybe TxOut
witnessUtxo = Maybe TxOut
Nothing} InputType
InWitnessUtxo = do
  TxOut
utxo <- Get TxOut -> m TxOut
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes Get TxOut
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxOut
deserialize
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Input
input {witnessUtxo = Just utxo}
getInputItem Ctx
ctx Int
keySize Input
input InputType
InPartialSig = do
  (PublicKey
k, WitnessStackItem
v) <- m (PublicKey, WitnessStackItem)
getPartialSig
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Input
input
      { partialSigs = HashMap.insert k v input.partialSigs
      }
  where
    getPartialSig :: m (PublicKey, WitnessStackItem)
getPartialSig =
      (,)
        (PublicKey -> WitnessStackItem -> (PublicKey, WitnessStackItem))
-> m PublicKey
-> m (WitnessStackItem -> (PublicKey, WitnessStackItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get PublicKey -> m PublicKey
forall (m :: * -> *) a. MonadGet m => Int -> Get a -> m a
isolate Int
keySize (Ctx -> Get PublicKey
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => Ctx -> m PublicKey
marshalGet Ctx
ctx :: Get PublicKey)
        m (WitnessStackItem -> (PublicKey, WitnessStackItem))
-> m WitnessStackItem -> m (PublicKey, WitnessStackItem)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\(VarString WitnessStackItem
s) -> WitnessStackItem
s) (VarString -> WitnessStackItem)
-> m VarString -> m WitnessStackItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarString
deserialize)
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:sigHashType:Input :: Input -> Maybe SigHash
sigHashType = Maybe SigHash
Nothing} InputType
InSigHashType = do
  VarInt Word64
size <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
size Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x04) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"Expected size == 0x04 but got 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word64
size String
""
  SigHash
sigHash <- KeyIndex -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KeyIndex -> SigHash) -> m KeyIndex -> m SigHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32le
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Input -> m Input) -> Input -> m Input
forall a b. (a -> b) -> a -> b
$ Input
input {sigHashType = Just sigHash}
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:inputRedeemScript:Input :: Input -> Maybe Script
inputRedeemScript = Maybe Script
Nothing} InputType
InRedeemScript = do
  Script
script <- Get Script -> m Script
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Script
deserialize
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Input -> m Input) -> Input -> m Input
forall a b. (a -> b) -> a -> b
$ Input
input {inputRedeemScript = Just script}
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:inputWitnessScript:Input :: Input -> Maybe Script
inputWitnessScript = Maybe Script
Nothing} InputType
InWitnessScript = do
  Script
script <- Get Script -> m Script
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Script
deserialize
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Input -> m Input) -> Input -> m Input
forall a b. (a -> b) -> a -> b
$ Input
input {inputWitnessScript = Just script}
getInputItem Ctx
ctx Int
keySize Input
input InputType
InBIP32Derivation = do
  (PublicKey
k, (Fingerprint, [KeyIndex])
v) <- Ctx -> Int -> m (PublicKey, (Fingerprint, [KeyIndex]))
forall (m :: * -> *).
MonadGet m =>
Ctx -> Int -> m (PublicKey, (Fingerprint, [KeyIndex]))
getHDPath Ctx
ctx Int
keySize
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Input
input
      { inputHDKeypaths = HashMap.insert k v input.inputHDKeypaths
      }
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:finalScriptSig:Input :: Input -> Maybe Script
finalScriptSig = Maybe Script
Nothing} InputType
InFinalScriptSig = do
  Script
script <- Get Script -> m Script
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Script
deserialize
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Input -> m Input) -> Input -> m Input
forall a b. (a -> b) -> a -> b
$ Input
input {finalScriptSig = Just script}
getInputItem Ctx
ctx Int
0 input :: Input
input@Input {$sel:finalScriptWitness:Input :: Input -> Maybe [WitnessStackItem]
finalScriptWitness = Maybe [WitnessStackItem]
Nothing} InputType
InFinalScriptWitness = do
  [WitnessStackItem]
scripts <- (VarString -> WitnessStackItem)
-> [VarString] -> [WitnessStackItem]
forall a b. (a -> b) -> [a] -> [b]
map (\(VarString WitnessStackItem
s) -> WitnessStackItem
s) ([VarString] -> [WitnessStackItem])
-> m [VarString] -> m [WitnessStackItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [VarString]
getVarIntList
  Input -> m Input
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Input -> m Input) -> Input -> m Input
forall a b. (a -> b) -> a -> b
$ Input
input {finalScriptWitness = Just scripts}
  where
    getVarIntList :: m [VarString]
getVarIntList = Get [VarString] -> m [VarString]
forall (m :: * -> *) a. MonadGet m => Get a -> m a
getSizedBytes (Get [VarString] -> m [VarString])
-> Get [VarString] -> m [VarString]
forall a b. (a -> b) -> a -> b
$ do
      VarInt Word64
n <- Get VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize -- Item count
      Int -> Get VarString -> Get [VarString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) Get VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarString
deserialize
getInputItem Ctx
ctx Int
keySize Input
input InputType
inputType =
  String -> m Input
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Incorrect key size for input item or item already existed"

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

getHDPath ::
  forall m.
  (MonadGet m) =>
  Ctx ->
  Int ->
  m (PublicKey, (Fingerprint, [KeyIndex]))
getHDPath :: forall (m :: * -> *).
MonadGet m =>
Ctx -> Int -> m (PublicKey, (Fingerprint, [KeyIndex]))
getHDPath Ctx
ctx Int
keySize =
  (,)
    (PublicKey
 -> (Fingerprint, [KeyIndex])
 -> (PublicKey, (Fingerprint, [KeyIndex])))
-> m PublicKey
-> m ((Fingerprint, [KeyIndex])
      -> (PublicKey, (Fingerprint, [KeyIndex])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get PublicKey -> m PublicKey
forall (m :: * -> *) a. MonadGet m => Int -> Get a -> m a
isolate Int
keySize (Ctx -> Get PublicKey
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => Ctx -> m PublicKey
marshalGet Ctx
ctx :: Get PublicKey)
    m ((Fingerprint, [KeyIndex])
   -> (PublicKey, (Fingerprint, [KeyIndex])))
-> m (Fingerprint, [KeyIndex])
-> m (PublicKey, (Fingerprint, [KeyIndex]))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\(PSBTHDPath (Fingerprint, [KeyIndex])
s) -> (Fingerprint, [KeyIndex])
s) (PSBTHDPath -> (Fingerprint, [KeyIndex]))
-> m PSBTHDPath -> m (Fingerprint, [KeyIndex])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PSBTHDPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m PSBTHDPath
deserialize)

putHDPath ::
  (Enum t, MonadPut m) =>
  Ctx ->
  t ->
  HashMap PublicKey (Fingerprint, [KeyIndex]) ->
  m ()
putHDPath :: forall t (m :: * -> *).
(Enum t, MonadPut m) =>
Ctx -> t -> HashMap PublicKey (Fingerprint, [KeyIndex]) -> m ()
putHDPath Ctx
ctx t
t = Ctx
-> (PSBTHDPath -> m ())
-> t
-> HashMap PublicKey PSBTHDPath
-> m ()
forall t (m :: * -> *) a.
(Enum t, MonadPut m) =>
Ctx -> (a -> m ()) -> t -> HashMap PublicKey a -> m ()
putPubKeyMap Ctx
ctx PSBTHDPath -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => PSBTHDPath -> m ()
serialize t
t (HashMap PublicKey PSBTHDPath -> m ())
-> (HashMap PublicKey (Fingerprint, [KeyIndex])
    -> HashMap PublicKey PSBTHDPath)
-> HashMap PublicKey (Fingerprint, [KeyIndex])
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Fingerprint, [KeyIndex]) -> PSBTHDPath)
-> HashMap PublicKey (Fingerprint, [KeyIndex])
-> HashMap PublicKey PSBTHDPath
forall a b. (a -> b) -> HashMap PublicKey a -> HashMap PublicKey b
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
(Int -> PSBTHDPath -> ShowS)
-> (PSBTHDPath -> String)
-> ([PSBTHDPath] -> ShowS)
-> Show PSBTHDPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PSBTHDPath -> ShowS
showsPrec :: Int -> PSBTHDPath -> ShowS
$cshow :: PSBTHDPath -> String
show :: PSBTHDPath -> String
$cshowList :: [PSBTHDPath] -> ShowS
showList :: [PSBTHDPath] -> ShowS
Show, PSBTHDPath -> PSBTHDPath -> Bool
(PSBTHDPath -> PSBTHDPath -> Bool)
-> (PSBTHDPath -> PSBTHDPath -> Bool) -> Eq PSBTHDPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSBTHDPath -> PSBTHDPath -> Bool
== :: PSBTHDPath -> PSBTHDPath -> Bool
$c/= :: PSBTHDPath -> PSBTHDPath -> Bool
/= :: PSBTHDPath -> PSBTHDPath -> Bool
Eq, (forall x. PSBTHDPath -> Rep PSBTHDPath x)
-> (forall x. Rep PSBTHDPath x -> PSBTHDPath) -> Generic PSBTHDPath
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
$cfrom :: forall x. PSBTHDPath -> Rep PSBTHDPath x
from :: forall x. PSBTHDPath -> Rep PSBTHDPath x
$cto :: forall x. Rep PSBTHDPath x -> PSBTHDPath
to :: forall x. Rep PSBTHDPath x -> PSBTHDPath
Generic)
  deriving newtype (PSBTHDPath -> ()
(PSBTHDPath -> ()) -> NFData PSBTHDPath
forall a. (a -> ()) -> NFData a
$crnf :: PSBTHDPath -> ()
rnf :: PSBTHDPath -> ()
NFData)

instance Serial PSBTHDPath where
  deserialize :: forall (m :: * -> *). MonadGet m => m PSBTHDPath
deserialize = do
    VarInt Word64
valueSize <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
valueSize Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
4 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
        String
"Expected valueSize = 4 but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
valueSize
    let numIndices :: Int
numIndices = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
valueSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
    (Fingerprint, [KeyIndex]) -> PSBTHDPath
PSBTHDPath
      ((Fingerprint, [KeyIndex]) -> PSBTHDPath)
-> m (Fingerprint, [KeyIndex]) -> m PSBTHDPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Fingerprint, [KeyIndex]) -> m (Fingerprint, [KeyIndex])
forall (m :: * -> *) a. MonadGet m => Int -> Get a -> m a
isolate
        (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
valueSize)
        ((,) (Fingerprint -> [KeyIndex] -> (Fingerprint, [KeyIndex]))
-> Get Fingerprint -> Get ([KeyIndex] -> (Fingerprint, [KeyIndex]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize Get ([KeyIndex] -> (Fingerprint, [KeyIndex]))
-> Get [KeyIndex] -> Get (Fingerprint, [KeyIndex])
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get [KeyIndex]
forall {m :: * -> *}. MonadGet m => Int -> m [KeyIndex]
getKeyIndexList Int
numIndices)
    where
      getKeyIndexList :: Int -> m [KeyIndex]
getKeyIndexList Int
n = Int -> m KeyIndex -> m [KeyIndex]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32le

  serialize :: forall (m :: * -> *). MonadPut m => PSBTHDPath -> m ()
serialize (PSBTHDPath (Fingerprint
fp, [KeyIndex]
kis)) = do
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (WitnessStackItem -> Int
B.length WitnessStackItem
bs)
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString WitnessStackItem
bs
    where
      bs :: WitnessStackItem
bs = Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ Fingerprint -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize Fingerprint
fp Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (KeyIndex -> Put) -> [KeyIndex] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ KeyIndex -> Put
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32le [KeyIndex]
kis

instance Binary PSBTHDPath where
  put :: PSBTHDPath -> Put
put = PSBTHDPath -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => PSBTHDPath -> m ()
serialize
  get :: Get PSBTHDPath
get = Get PSBTHDPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m PSBTHDPath
deserialize

instance Serialize PSBTHDPath where
  put :: Putter PSBTHDPath
put = Putter PSBTHDPath
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => PSBTHDPath -> m ()
serialize
  get :: Get PSBTHDPath
get = Get PSBTHDPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m PSBTHDPath
deserialize

putPubKeyMap ::
  (Enum t, MonadPut m) =>
  Ctx ->
  (a -> m ()) ->
  t ->
  HashMap PublicKey a ->
  m ()
putPubKeyMap :: forall t (m :: * -> *) a.
(Enum t, MonadPut m) =>
Ctx -> (a -> m ()) -> t -> HashMap PublicKey a -> m ()
putPubKeyMap Ctx
ctx a -> m ()
f t
t =
  m (HashMap PublicKey ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (HashMap PublicKey ()) -> m ())
-> (HashMap PublicKey a -> m (HashMap PublicKey ()))
-> HashMap PublicKey a
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PublicKey -> a -> m ())
-> HashMap PublicKey a -> m (HashMap PublicKey ())
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey PublicKey -> a -> m ()
forall {a}. Marshal Ctx a => a -> a -> m ()
putItem
  where
    putItem :: a -> a -> m ()
putItem a
k a
v = do
      Key -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Key -> m ()
serialize (Key -> m ()) -> Key -> m ()
forall a b. (a -> b) -> a -> b
$ Word8 -> WitnessStackItem -> Key
Key (t -> Word8
forall a. Enum a => a -> Word8
enumWord8 t
t) (Ctx -> a -> WitnessStackItem
forall s a. Marshal s a => s -> a -> WitnessStackItem
marshal Ctx
ctx a
k)
      a -> m ()
f a
v

enumWord8 :: (Enum a) => a -> Word8
enumWord8 :: forall a. Enum a => a -> Word8
enumWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (a -> Int) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Word8
forall a. Enum a => a -> Word8
enumWord8 (a
forall a. Bounded a => a
maxBound :: a) = a -> Either Word8 a
forall a b. b -> Either a b
Right (a -> Either Word8 a) -> (Int -> a) -> Int -> Either Word8 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> Either Word8 a) -> Int -> Either Word8 a
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n
word8Enum Word8
n = Word8 -> Either Word8 a
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 = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
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 a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing

isolate :: (MonadGet m) => Int -> Get a -> m a
isolate :: forall (m :: * -> *) a. MonadGet m => Int -> Get a -> m a
isolate Int
length Get a
getVal = do
  WitnessStackItem
bs <- Int -> m WitnessStackItem
forall (m :: * -> *). MonadGet m => Int -> m WitnessStackItem
getByteString Int
length
  (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Get a -> WitnessStackItem -> Either String a
forall a. Get a -> WitnessStackItem -> Either String a
runGetS Get a
getVal WitnessStackItem
bs)

getNested :: (MonadGet m) => m Int -> Get a -> m a
getNested :: forall (m :: * -> *) a. MonadGet m => m Int -> Get a -> m a
getNested m Int
getLength Get a
getVal = do
  Int
length <- m Int
getLength
  Int -> Get a -> m a
forall (m :: * -> *) a. MonadGet m => Int -> Get a -> m a
isolate Int
length Get a
getVal