{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
module Bitcoin.Prim.Tx.Sighash (
SighashType(..)
, sighash_legacy
, sighash_segwit
) where
import Bitcoin.Prim.Tx
( Tx(..)
, TxIn(..)
, TxOut(..)
, put_word32_le
, put_word64_le
, put_compact
, put_outpoint
, put_txout
, to_strict
)
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.List.NonEmpty as NE
import Data.Word (Word8, Word64)
import GHC.Generics (Generic)
data SighashType
= SIGHASH_ALL
| SIGHASH_NONE
| SIGHASH_SINGLE
| SIGHASH_ALL_ANYONECANPAY
| SIGHASH_NONE_ANYONECANPAY
| SIGHASH_SINGLE_ANYONECANPAY
deriving (SighashType -> SighashType -> Bool
(SighashType -> SighashType -> Bool)
-> (SighashType -> SighashType -> Bool) -> Eq SighashType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SighashType -> SighashType -> Bool
== :: SighashType -> SighashType -> Bool
$c/= :: SighashType -> SighashType -> Bool
/= :: SighashType -> SighashType -> Bool
Eq, Int -> SighashType -> ShowS
[SighashType] -> ShowS
SighashType -> String
(Int -> SighashType -> ShowS)
-> (SighashType -> String)
-> ([SighashType] -> ShowS)
-> Show SighashType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SighashType -> ShowS
showsPrec :: Int -> SighashType -> ShowS
$cshow :: SighashType -> String
show :: SighashType -> String
$cshowList :: [SighashType] -> ShowS
showList :: [SighashType] -> ShowS
Show, (forall x. SighashType -> Rep SighashType x)
-> (forall x. Rep SighashType x -> SighashType)
-> Generic SighashType
forall x. Rep SighashType x -> SighashType
forall x. SighashType -> Rep SighashType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SighashType -> Rep SighashType x
from :: forall x. SighashType -> Rep SighashType x
$cto :: forall x. Rep SighashType x -> SighashType
to :: forall x. Rep SighashType x -> SighashType
Generic)
sighash_byte :: SighashType -> Word8
sighash_byte :: SighashType -> Word8
sighash_byte !SighashType
st = case SighashType
st of
SighashType
SIGHASH_ALL -> Word8
0x01
SighashType
SIGHASH_NONE -> Word8
0x02
SighashType
SIGHASH_SINGLE -> Word8
0x03
SighashType
SIGHASH_ALL_ANYONECANPAY -> Word8
0x81
SighashType
SIGHASH_NONE_ANYONECANPAY -> Word8
0x82
SighashType
SIGHASH_SINGLE_ANYONECANPAY -> Word8
0x83
{-# INLINE sighash_byte #-}
is_anyonecanpay :: SighashType -> Bool
is_anyonecanpay :: SighashType -> Bool
is_anyonecanpay !SighashType
st = case SighashType
st of
SighashType
SIGHASH_ALL_ANYONECANPAY -> Bool
True
SighashType
SIGHASH_NONE_ANYONECANPAY -> Bool
True
SighashType
SIGHASH_SINGLE_ANYONECANPAY -> Bool
True
SighashType
_ -> Bool
False
{-# INLINE is_anyonecanpay #-}
base_type :: SighashType -> SighashType
base_type :: SighashType -> SighashType
base_type !SighashType
st = case SighashType
st of
SighashType
SIGHASH_ALL_ANYONECANPAY -> SighashType
SIGHASH_ALL
SighashType
SIGHASH_NONE_ANYONECANPAY -> SighashType
SIGHASH_NONE
SighashType
SIGHASH_SINGLE_ANYONECANPAY -> SighashType
SIGHASH_SINGLE
SighashType
other -> SighashType
other
{-# INLINE base_type #-}
zero32 :: BS.ByteString
zero32 :: ByteString
zero32 = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00
{-# NOINLINE zero32 #-}
sighash_single_bug :: BS.ByteString
sighash_single_bug :: ByteString
sighash_single_bug = Word8 -> ByteString -> ByteString
BS.cons Word8
0x01 (Int -> Word8 -> ByteString
BS.replicate Int
31 Word8
0x00)
{-# NOINLINE sighash_single_bug #-}
hash256 :: BS.ByteString -> BS.ByteString
hash256 :: ByteString -> ByteString
hash256 = ByteString -> ByteString
SHA256.hash (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hash
{-# INLINE hash256 #-}
sighash_legacy
:: Tx
-> Int
-> BS.ByteString
-> SighashType
-> BS.ByteString
sighash_legacy :: Tx -> Int -> ByteString -> SighashType -> ByteString
sighash_legacy !Tx
tx !Int
idx !ByteString
script_pubkey !SighashType
sighash_type
| SighashType
base SighashType -> SighashType -> Bool
forall a. Eq a => a -> a -> Bool
== SighashType
SIGHASH_SINGLE Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= NonEmpty TxOut -> Int
forall a. NonEmpty a -> Int
NE.length (Tx -> NonEmpty TxOut
tx_outputs Tx
tx) =
ByteString
sighash_single_bug
| Bool
otherwise =
let !serialized :: ByteString
serialized = Tx -> Int -> ByteString -> SighashType -> ByteString
serialize_legacy_sighash Tx
tx Int
idx ByteString
script_pubkey SighashType
sighash_type
in ByteString -> ByteString
hash256 ByteString
serialized
where
!base :: SighashType
base = SighashType -> SighashType
base_type SighashType
sighash_type
serialize_legacy_sighash
:: Tx
-> Int
-> BS.ByteString
-> SighashType
-> BS.ByteString
serialize_legacy_sighash :: Tx -> Int -> ByteString -> SighashType -> ByteString
serialize_legacy_sighash Tx{[Witness]
Word32
NonEmpty TxOut
NonEmpty TxIn
tx_outputs :: Tx -> NonEmpty TxOut
tx_version :: Word32
tx_inputs :: NonEmpty TxIn
tx_outputs :: NonEmpty TxOut
tx_witnesses :: [Witness]
tx_locktime :: Word32
tx_locktime :: Tx -> Word32
tx_witnesses :: Tx -> [Witness]
tx_inputs :: Tx -> NonEmpty TxIn
tx_version :: Tx -> Word32
..} !Int
idx !ByteString
script_pubkey !SighashType
sighash_type =
let !base :: SighashType
base = SighashType -> SighashType
base_type SighashType
sighash_type
!anyonecanpay :: Bool
anyonecanpay = SighashType -> Bool
is_anyonecanpay SighashType
sighash_type
!inputs_list :: [TxIn]
inputs_list = NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxIn
tx_inputs
!outputs_list :: [TxOut]
outputs_list = NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxOut
tx_outputs
clear_scripts :: Int -> [TxIn] -> [TxIn]
clear_scripts :: Int -> [TxIn] -> [TxIn]
clear_scripts !Int
_ [] = []
clear_scripts !Int
i (TxIn
inp : [TxIn]
rest)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx = TxIn
inp { txin_script_sig = script_pubkey } TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: [TxIn]
clear_rest
| Bool
otherwise = TxIn
inp { txin_script_sig = BS.empty } TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: [TxIn]
clear_rest
where
!clear_rest :: [TxIn]
clear_rest = Int -> [TxIn] -> [TxIn]
clear_scripts (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxIn]
rest
zero_other_sequences :: Int -> [TxIn] -> [TxIn]
zero_other_sequences :: Int -> [TxIn] -> [TxIn]
zero_other_sequences !Int
_ [] = []
zero_other_sequences !Int
i (TxIn
inp : [TxIn]
rest)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx = TxIn
inp TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: Int -> [TxIn] -> [TxIn]
zero_other_sequences (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxIn]
rest
| Bool
otherwise =
TxIn
inp { txin_sequence = 0 } TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: Int -> [TxIn] -> [TxIn]
zero_other_sequences (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxIn]
rest
!inputs_cleared :: [TxIn]
inputs_cleared = Int -> [TxIn] -> [TxIn]
clear_scripts Int
0 [TxIn]
inputs_list
!inputs_processed :: [TxIn]
inputs_processed = case SighashType
base of
SighashType
SIGHASH_NONE -> Int -> [TxIn] -> [TxIn]
zero_other_sequences Int
0 [TxIn]
inputs_cleared
SighashType
SIGHASH_SINGLE -> Int -> [TxIn] -> [TxIn]
zero_other_sequences Int
0 [TxIn]
inputs_cleared
SighashType
_ -> [TxIn]
inputs_cleared
!final_inputs :: [TxIn]
final_inputs
| Bool
anyonecanpay = case [TxIn] -> Int -> Maybe TxIn
forall a. [a] -> Int -> Maybe a
safe_index [TxIn]
inputs_processed Int
idx of
Just TxIn
inp -> [TxIn
inp]
Maybe TxIn
Nothing -> []
| Bool
otherwise = [TxIn]
inputs_processed
!final_outputs :: [TxOut]
final_outputs = case SighashType
base of
SighashType
SIGHASH_NONE -> []
SighashType
SIGHASH_SINGLE -> [TxOut] -> Int -> [TxOut]
build_single_outputs [TxOut]
outputs_list Int
idx
SighashType
_ -> [TxOut]
outputs_list
in Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
Word32 -> Builder
put_word32_le Word32
tx_version
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
final_inputs))
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TxIn -> Builder) -> [TxIn] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxIn -> Builder
put_txin_legacy [TxIn]
final_inputs
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut]
final_outputs))
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TxOut -> Builder) -> [TxOut] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Builder
put_txout [TxOut]
final_outputs
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
tx_locktime
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SighashType -> Word8
sighash_byte SighashType
sighash_type))
build_single_outputs :: [TxOut] -> Int -> [TxOut]
build_single_outputs :: [TxOut] -> Int -> [TxOut]
build_single_outputs ![TxOut]
outs !Int
target_idx = Int -> [TxOut] -> [TxOut]
go Int
0 [TxOut]
outs
where
go :: Int -> [TxOut] -> [TxOut]
go :: Int -> [TxOut] -> [TxOut]
go !Int
_ [] = []
go !Int
i (TxOut
o : [TxOut]
rest)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
target_idx = [TxOut
o]
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target_idx = TxOut
empty_output TxOut -> [TxOut] -> [TxOut]
forall a. a -> [a] -> [a]
: Int -> [TxOut] -> [TxOut]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxOut]
rest
| Bool
otherwise = []
empty_output :: TxOut
empty_output :: TxOut
empty_output = Word64 -> ByteString -> TxOut
TxOut Word64
0xffffffffffffffff ByteString
BS.empty
safe_index :: [a] -> Int -> Maybe a
safe_index :: forall a. [a] -> Int -> Maybe a
safe_index [] Int
_ = Maybe a
forall a. Maybe a
Nothing
safe_index (a
x : [a]
xs) !Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe a
forall a. Maybe a
Nothing
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
safe_index [a]
xs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE safe_index #-}
put_txin_legacy :: TxIn -> BSB.Builder
put_txin_legacy :: TxIn -> Builder
put_txin_legacy TxIn{Word32
ByteString
OutPoint
txin_script_sig :: TxIn -> ByteString
txin_sequence :: TxIn -> Word32
txin_prevout :: OutPoint
txin_script_sig :: ByteString
txin_sequence :: Word32
txin_prevout :: TxIn -> OutPoint
..} =
OutPoint -> Builder
put_outpoint OutPoint
txin_prevout
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
txin_script_sig))
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
txin_script_sig
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
txin_sequence
{-# INLINE put_txin_legacy #-}
sighash_segwit
:: Tx
-> Int
-> BS.ByteString
-> Word64
-> SighashType
-> Maybe BS.ByteString
sighash_segwit :: Tx
-> Int -> ByteString -> Word64 -> SighashType -> Maybe ByteString
sighash_segwit !Tx
tx !Int
idx !ByteString
script_code !Word64
value !SighashType
sighash_type = do
preimage <- Tx
-> Int -> ByteString -> Word64 -> SighashType -> Maybe ByteString
build_bip143_preimage Tx
tx Int
idx ByteString
script_code Word64
value SighashType
sighash_type
pure $! hash256 preimage
build_bip143_preimage
:: Tx
-> Int
-> BS.ByteString
-> Word64
-> SighashType
-> Maybe BS.ByteString
build_bip143_preimage :: Tx
-> Int -> ByteString -> Word64 -> SighashType -> Maybe ByteString
build_bip143_preimage Tx{[Witness]
Word32
NonEmpty TxOut
NonEmpty TxIn
tx_outputs :: Tx -> NonEmpty TxOut
tx_locktime :: Tx -> Word32
tx_witnesses :: Tx -> [Witness]
tx_inputs :: Tx -> NonEmpty TxIn
tx_version :: Tx -> Word32
tx_version :: Word32
tx_inputs :: NonEmpty TxIn
tx_outputs :: NonEmpty TxOut
tx_witnesses :: [Witness]
tx_locktime :: Word32
..} !Int
idx !ByteString
script_code !Word64
value !SighashType
sighash_type = do
let !inputs_list :: [TxIn]
inputs_list = NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxIn
tx_inputs
!outputs_list :: [TxOut]
outputs_list = NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxOut
tx_outputs
signing_input <- [TxIn] -> Int -> Maybe TxIn
forall a. [a] -> Int -> Maybe a
safe_index [TxIn]
inputs_list Int
idx
let !base = SighashType -> SighashType
base_type SighashType
sighash_type
!anyonecanpay = SighashType -> Bool
is_anyonecanpay SighashType
sighash_type
!hash_prevouts
| Bool
anyonecanpay = ByteString
zero32
| Bool
otherwise = ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
(TxIn -> Builder) -> NonEmpty TxIn -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (OutPoint -> Builder
put_outpoint (OutPoint -> Builder) -> (TxIn -> OutPoint) -> TxIn -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
txin_prevout) NonEmpty TxIn
tx_inputs
!hash_sequence
| Bool
anyonecanpay = ByteString
zero32
| SighashType
base SighashType -> SighashType -> Bool
forall a. Eq a => a -> a -> Bool
== SighashType
SIGHASH_SINGLE = ByteString
zero32
| SighashType
base SighashType -> SighashType -> Bool
forall a. Eq a => a -> a -> Bool
== SighashType
SIGHASH_NONE = ByteString
zero32
| Bool
otherwise = ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
(TxIn -> Builder) -> NonEmpty TxIn -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Word32 -> Builder
put_word32_le (Word32 -> Builder) -> (TxIn -> Word32) -> TxIn -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Word32
txin_sequence) NonEmpty TxIn
tx_inputs
!hash_outputs = case SighashType
base of
SighashType
SIGHASH_NONE -> ByteString
zero32
SighashType
SIGHASH_SINGLE ->
case [TxOut] -> Int -> Maybe TxOut
forall a. [a] -> Int -> Maybe a
safe_index [TxOut]
outputs_list Int
idx of
Maybe TxOut
Nothing -> ByteString
zero32
Just TxOut
out -> ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ TxOut -> Builder
put_txout TxOut
out
SighashType
_ -> ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ (TxOut -> Builder) -> NonEmpty TxOut -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Builder
put_txout NonEmpty TxOut
tx_outputs
!outpoint = TxIn -> OutPoint
txin_prevout TxIn
signing_input
!sequence_n = TxIn -> Word32
txin_sequence TxIn
signing_input
pure $! to_strict $
put_word32_le tx_version
<> BSB.byteString hash_prevouts
<> BSB.byteString hash_sequence
<> put_outpoint outpoint
<> put_compact (fromIntegral (BS.length script_code))
<> BSB.byteString script_code
<> put_word64_le value
<> put_word32_le sequence_n
<> BSB.byteString hash_outputs
<> put_word32_le tx_locktime
<> put_word32_le (fromIntegral (sighash_byte sighash_type))