{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Haskoin.Script.SigHash
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- Transaction signatures and related functions.
module Haskoin.Script.SigHash
  ( -- * Script Signatures
    SigHash (..),
    SigHashFlag (..),
    sigHashAll,
    sigHashNone,
    sigHashSingle,
    anyoneCanPay,
    hasForkIdFlag,
    setAnyoneCanPay,
    setForkIdFlag,
    isSigHashAll,
    isSigHashNone,
    isSigHashSingle,
    isSigHashUnknown,
    sigHashAddForkId,
    sigHashGetForkId,
    sigHashAddNetworkId,
    txSigHash,
    txSigHashForkId,
    TxSignature (..),
    decodeTxSig,
    encodeTxSig,
  )
where

import Control.DeepSeq
import Control.Monad
import Crypto.Secp256k1
import Data.Aeson
import Data.Bits
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Hashable
import Data.Maybe
import Data.Scientific
import Data.Word
import GHC.Generics (Generic)
import Haskoin.Crypto.Hash
import Haskoin.Crypto.Signature
import Haskoin.Network.Common
import Haskoin.Network.Data
import Haskoin.Script.Common
import Haskoin.Transaction.Common
import Haskoin.Util

-- | Constant representing a SIGHASH flag that controls what is being signed.
data SigHashFlag
  = -- | sign all outputs
    SIGHASH_ALL
  | -- | sign no outputs
    SIGHASH_NONE
  | -- | sign the output index corresponding to the input
    SIGHASH_SINGLE
  | -- | replay protection for Bitcoin Cash transactions
    SIGHASH_FORKID
  | -- | new inputs can be added
    SIGHASH_ANYONECANPAY
  deriving (SigHashFlag -> SigHashFlag -> Bool
(SigHashFlag -> SigHashFlag -> Bool)
-> (SigHashFlag -> SigHashFlag -> Bool) -> Eq SigHashFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigHashFlag -> SigHashFlag -> Bool
== :: SigHashFlag -> SigHashFlag -> Bool
$c/= :: SigHashFlag -> SigHashFlag -> Bool
/= :: SigHashFlag -> SigHashFlag -> Bool
Eq, Eq SigHashFlag
Eq SigHashFlag =>
(SigHashFlag -> SigHashFlag -> Ordering)
-> (SigHashFlag -> SigHashFlag -> Bool)
-> (SigHashFlag -> SigHashFlag -> Bool)
-> (SigHashFlag -> SigHashFlag -> Bool)
-> (SigHashFlag -> SigHashFlag -> Bool)
-> (SigHashFlag -> SigHashFlag -> SigHashFlag)
-> (SigHashFlag -> SigHashFlag -> SigHashFlag)
-> Ord SigHashFlag
SigHashFlag -> SigHashFlag -> Bool
SigHashFlag -> SigHashFlag -> Ordering
SigHashFlag -> SigHashFlag -> SigHashFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SigHashFlag -> SigHashFlag -> Ordering
compare :: SigHashFlag -> SigHashFlag -> Ordering
$c< :: SigHashFlag -> SigHashFlag -> Bool
< :: SigHashFlag -> SigHashFlag -> Bool
$c<= :: SigHashFlag -> SigHashFlag -> Bool
<= :: SigHashFlag -> SigHashFlag -> Bool
$c> :: SigHashFlag -> SigHashFlag -> Bool
> :: SigHashFlag -> SigHashFlag -> Bool
$c>= :: SigHashFlag -> SigHashFlag -> Bool
>= :: SigHashFlag -> SigHashFlag -> Bool
$cmax :: SigHashFlag -> SigHashFlag -> SigHashFlag
max :: SigHashFlag -> SigHashFlag -> SigHashFlag
$cmin :: SigHashFlag -> SigHashFlag -> SigHashFlag
min :: SigHashFlag -> SigHashFlag -> SigHashFlag
Ord, Int -> SigHashFlag -> ShowS
[SigHashFlag] -> ShowS
SigHashFlag -> String
(Int -> SigHashFlag -> ShowS)
-> (SigHashFlag -> String)
-> ([SigHashFlag] -> ShowS)
-> Show SigHashFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigHashFlag -> ShowS
showsPrec :: Int -> SigHashFlag -> ShowS
$cshow :: SigHashFlag -> String
show :: SigHashFlag -> String
$cshowList :: [SigHashFlag] -> ShowS
showList :: [SigHashFlag] -> ShowS
Show, ReadPrec [SigHashFlag]
ReadPrec SigHashFlag
Int -> ReadS SigHashFlag
ReadS [SigHashFlag]
(Int -> ReadS SigHashFlag)
-> ReadS [SigHashFlag]
-> ReadPrec SigHashFlag
-> ReadPrec [SigHashFlag]
-> Read SigHashFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SigHashFlag
readsPrec :: Int -> ReadS SigHashFlag
$creadList :: ReadS [SigHashFlag]
readList :: ReadS [SigHashFlag]
$creadPrec :: ReadPrec SigHashFlag
readPrec :: ReadPrec SigHashFlag
$creadListPrec :: ReadPrec [SigHashFlag]
readListPrec :: ReadPrec [SigHashFlag]
Read, (forall x. SigHashFlag -> Rep SigHashFlag x)
-> (forall x. Rep SigHashFlag x -> SigHashFlag)
-> Generic SigHashFlag
forall x. Rep SigHashFlag x -> SigHashFlag
forall x. SigHashFlag -> Rep SigHashFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SigHashFlag -> Rep SigHashFlag x
from :: forall x. SigHashFlag -> Rep SigHashFlag x
$cto :: forall x. Rep SigHashFlag x -> SigHashFlag
to :: forall x. Rep SigHashFlag x -> SigHashFlag
Generic)

instance NFData SigHashFlag

instance Hashable SigHashFlag

instance Enum SigHashFlag where
  fromEnum :: SigHashFlag -> Int
fromEnum SigHashFlag
SIGHASH_ALL = Int
0x01
  fromEnum SigHashFlag
SIGHASH_NONE = Int
0x02
  fromEnum SigHashFlag
SIGHASH_SINGLE = Int
0x03
  fromEnum SigHashFlag
SIGHASH_FORKID = Int
0x40
  fromEnum SigHashFlag
SIGHASH_ANYONECANPAY = Int
0x80
  toEnum :: Int -> SigHashFlag
toEnum Int
0x01 = SigHashFlag
SIGHASH_ALL
  toEnum Int
0x02 = SigHashFlag
SIGHASH_NONE
  toEnum Int
0x03 = SigHashFlag
SIGHASH_SINGLE
  toEnum Int
0x40 = SigHashFlag
SIGHASH_FORKID
  toEnum Int
0x80 = SigHashFlag
SIGHASH_ANYONECANPAY
  toEnum Int
_ = String -> SigHashFlag
forall a. HasCallStack => String -> a
error String
"Not a valid sighash flag"

-- | Data type representing the different ways a transaction can be signed.
-- When producing a signature, a hash of the transaction is used as the message
-- to be signed. The 'SigHash' parameter controls which parts of the
-- transaction are used or ignored to produce the transaction hash. The idea is
-- that if some part of a transaction is not used to produce the transaction
-- hash, then you can change that part of the transaction after producing a
-- signature without invalidating that signature.
--
-- If the 'SIGHASH_ANYONECANPAY' flag is set (true), then only the current input
-- is signed. Otherwise, all of the inputs of a transaction are signed. The
-- default value for 'SIGHASH_ANYONECANPAY' is unset (false).
newtype SigHash
  = SigHash Word32
  deriving (SigHash -> SigHash -> Bool
(SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool) -> Eq SigHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigHash -> SigHash -> Bool
== :: SigHash -> SigHash -> Bool
$c/= :: SigHash -> SigHash -> Bool
/= :: SigHash -> SigHash -> Bool
Eq, Eq SigHash
Eq SigHash =>
(SigHash -> SigHash -> Ordering)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> Bool)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> Ord SigHash
SigHash -> SigHash -> Bool
SigHash -> SigHash -> Ordering
SigHash -> SigHash -> SigHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SigHash -> SigHash -> Ordering
compare :: SigHash -> SigHash -> Ordering
$c< :: SigHash -> SigHash -> Bool
< :: SigHash -> SigHash -> Bool
$c<= :: SigHash -> SigHash -> Bool
<= :: SigHash -> SigHash -> Bool
$c> :: SigHash -> SigHash -> Bool
> :: SigHash -> SigHash -> Bool
$c>= :: SigHash -> SigHash -> Bool
>= :: SigHash -> SigHash -> Bool
$cmax :: SigHash -> SigHash -> SigHash
max :: SigHash -> SigHash -> SigHash
$cmin :: SigHash -> SigHash -> SigHash
min :: SigHash -> SigHash -> SigHash
Ord, Int -> SigHash
SigHash -> Int
SigHash -> [SigHash]
SigHash -> SigHash
SigHash -> SigHash -> [SigHash]
SigHash -> SigHash -> SigHash -> [SigHash]
(SigHash -> SigHash)
-> (SigHash -> SigHash)
-> (Int -> SigHash)
-> (SigHash -> Int)
-> (SigHash -> [SigHash])
-> (SigHash -> SigHash -> [SigHash])
-> (SigHash -> SigHash -> [SigHash])
-> (SigHash -> SigHash -> SigHash -> [SigHash])
-> Enum SigHash
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 :: SigHash -> SigHash
succ :: SigHash -> SigHash
$cpred :: SigHash -> SigHash
pred :: SigHash -> SigHash
$ctoEnum :: Int -> SigHash
toEnum :: Int -> SigHash
$cfromEnum :: SigHash -> Int
fromEnum :: SigHash -> Int
$cenumFrom :: SigHash -> [SigHash]
enumFrom :: SigHash -> [SigHash]
$cenumFromThen :: SigHash -> SigHash -> [SigHash]
enumFromThen :: SigHash -> SigHash -> [SigHash]
$cenumFromTo :: SigHash -> SigHash -> [SigHash]
enumFromTo :: SigHash -> SigHash -> [SigHash]
$cenumFromThenTo :: SigHash -> SigHash -> SigHash -> [SigHash]
enumFromThenTo :: SigHash -> SigHash -> SigHash -> [SigHash]
Enum, Int -> SigHash -> ShowS
[SigHash] -> ShowS
SigHash -> String
(Int -> SigHash -> ShowS)
-> (SigHash -> String) -> ([SigHash] -> ShowS) -> Show SigHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigHash -> ShowS
showsPrec :: Int -> SigHash -> ShowS
$cshow :: SigHash -> String
show :: SigHash -> String
$cshowList :: [SigHash] -> ShowS
showList :: [SigHash] -> ShowS
Show, ReadPrec [SigHash]
ReadPrec SigHash
Int -> ReadS SigHash
ReadS [SigHash]
(Int -> ReadS SigHash)
-> ReadS [SigHash]
-> ReadPrec SigHash
-> ReadPrec [SigHash]
-> Read SigHash
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SigHash
readsPrec :: Int -> ReadS SigHash
$creadList :: ReadS [SigHash]
readList :: ReadS [SigHash]
$creadPrec :: ReadPrec SigHash
readPrec :: ReadPrec SigHash
$creadListPrec :: ReadPrec [SigHash]
readListPrec :: ReadPrec [SigHash]
Read, (forall x. SigHash -> Rep SigHash x)
-> (forall x. Rep SigHash x -> SigHash) -> Generic SigHash
forall x. Rep SigHash x -> SigHash
forall x. SigHash -> Rep SigHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SigHash -> Rep SigHash x
from :: forall x. SigHash -> Rep SigHash x
$cto :: forall x. Rep SigHash x -> SigHash
to :: forall x. Rep SigHash x -> SigHash
Generic)
  deriving newtype (Eq SigHash
SigHash
Eq SigHash =>
(SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> SigHash
-> (Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> Bool)
-> (SigHash -> Maybe Int)
-> (SigHash -> Int)
-> (SigHash -> Bool)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int -> SigHash)
-> (SigHash -> Int)
-> Bits SigHash
Int -> SigHash
SigHash -> Bool
SigHash -> Int
SigHash -> Maybe Int
SigHash -> SigHash
SigHash -> Int -> Bool
SigHash -> Int -> SigHash
SigHash -> SigHash -> SigHash
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: SigHash -> SigHash -> SigHash
.&. :: SigHash -> SigHash -> SigHash
$c.|. :: SigHash -> SigHash -> SigHash
.|. :: SigHash -> SigHash -> SigHash
$cxor :: SigHash -> SigHash -> SigHash
xor :: SigHash -> SigHash -> SigHash
$ccomplement :: SigHash -> SigHash
complement :: SigHash -> SigHash
$cshift :: SigHash -> Int -> SigHash
shift :: SigHash -> Int -> SigHash
$crotate :: SigHash -> Int -> SigHash
rotate :: SigHash -> Int -> SigHash
$czeroBits :: SigHash
zeroBits :: SigHash
$cbit :: Int -> SigHash
bit :: Int -> SigHash
$csetBit :: SigHash -> Int -> SigHash
setBit :: SigHash -> Int -> SigHash
$cclearBit :: SigHash -> Int -> SigHash
clearBit :: SigHash -> Int -> SigHash
$ccomplementBit :: SigHash -> Int -> SigHash
complementBit :: SigHash -> Int -> SigHash
$ctestBit :: SigHash -> Int -> Bool
testBit :: SigHash -> Int -> Bool
$cbitSizeMaybe :: SigHash -> Maybe Int
bitSizeMaybe :: SigHash -> Maybe Int
$cbitSize :: SigHash -> Int
bitSize :: SigHash -> Int
$cisSigned :: SigHash -> Bool
isSigned :: SigHash -> Bool
$cshiftL :: SigHash -> Int -> SigHash
shiftL :: SigHash -> Int -> SigHash
$cunsafeShiftL :: SigHash -> Int -> SigHash
unsafeShiftL :: SigHash -> Int -> SigHash
$cshiftR :: SigHash -> Int -> SigHash
shiftR :: SigHash -> Int -> SigHash
$cunsafeShiftR :: SigHash -> Int -> SigHash
unsafeShiftR :: SigHash -> Int -> SigHash
$crotateL :: SigHash -> Int -> SigHash
rotateL :: SigHash -> Int -> SigHash
$crotateR :: SigHash -> Int -> SigHash
rotateR :: SigHash -> Int -> SigHash
$cpopCount :: SigHash -> Int
popCount :: SigHash -> Int
Bits, Enum SigHash
Real SigHash
(Real SigHash, Enum SigHash) =>
(SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> (SigHash, SigHash))
-> (SigHash -> SigHash -> (SigHash, SigHash))
-> (SigHash -> Integer)
-> Integral SigHash
SigHash -> Integer
SigHash -> SigHash -> (SigHash, SigHash)
SigHash -> SigHash -> SigHash
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: SigHash -> SigHash -> SigHash
quot :: SigHash -> SigHash -> SigHash
$crem :: SigHash -> SigHash -> SigHash
rem :: SigHash -> SigHash -> SigHash
$cdiv :: SigHash -> SigHash -> SigHash
div :: SigHash -> SigHash -> SigHash
$cmod :: SigHash -> SigHash -> SigHash
mod :: SigHash -> SigHash -> SigHash
$cquotRem :: SigHash -> SigHash -> (SigHash, SigHash)
quotRem :: SigHash -> SigHash -> (SigHash, SigHash)
$cdivMod :: SigHash -> SigHash -> (SigHash, SigHash)
divMod :: SigHash -> SigHash -> (SigHash, SigHash)
$ctoInteger :: SigHash -> Integer
toInteger :: SigHash -> Integer
Integral, Integer -> SigHash
SigHash -> SigHash
SigHash -> SigHash -> SigHash
(SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash -> SigHash)
-> (SigHash -> SigHash)
-> (SigHash -> SigHash)
-> (SigHash -> SigHash)
-> (Integer -> SigHash)
-> Num SigHash
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SigHash -> SigHash -> SigHash
+ :: SigHash -> SigHash -> SigHash
$c- :: SigHash -> SigHash -> SigHash
- :: SigHash -> SigHash -> SigHash
$c* :: SigHash -> SigHash -> SigHash
* :: SigHash -> SigHash -> SigHash
$cnegate :: SigHash -> SigHash
negate :: SigHash -> SigHash
$cabs :: SigHash -> SigHash
abs :: SigHash -> SigHash
$csignum :: SigHash -> SigHash
signum :: SigHash -> SigHash
$cfromInteger :: Integer -> SigHash
fromInteger :: Integer -> SigHash
Num, Num SigHash
Ord SigHash
(Num SigHash, Ord SigHash) => (SigHash -> Rational) -> Real SigHash
SigHash -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: SigHash -> Rational
toRational :: SigHash -> Rational
Real, Eq SigHash
Eq SigHash =>
(Int -> SigHash -> Int) -> (SigHash -> Int) -> Hashable SigHash
Int -> SigHash -> Int
SigHash -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SigHash -> Int
hashWithSalt :: Int -> SigHash -> Int
$chash :: SigHash -> Int
hash :: SigHash -> Int
Hashable, SigHash -> ()
(SigHash -> ()) -> NFData SigHash
forall a. (a -> ()) -> NFData a
$crnf :: SigHash -> ()
rnf :: SigHash -> ()
NFData)

instance FromJSON SigHash where
  parseJSON :: Value -> Parser SigHash
parseJSON =
    String -> (Scientific -> Parser SigHash) -> Value -> Parser SigHash
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"sighash" ((Scientific -> Parser SigHash) -> Value -> Parser SigHash)
-> (Scientific -> Parser SigHash) -> Value -> Parser SigHash
forall a b. (a -> b) -> a -> b
$
      Parser SigHash
-> (Word32 -> Parser SigHash) -> Maybe Word32 -> Parser SigHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser SigHash
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero (SigHash -> Parser SigHash
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigHash -> Parser SigHash)
-> (Word32 -> SigHash) -> Word32 -> Parser SigHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> SigHash
SigHash) (Maybe Word32 -> Parser SigHash)
-> (Scientific -> Maybe Word32) -> Scientific -> Parser SigHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Maybe Word32
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger

instance ToJSON SigHash where
  toJSON :: SigHash -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value)
-> (SigHash -> Scientific) -> SigHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigHash -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  toEncoding :: SigHash -> Encoding
toEncoding (SigHash Word32
n) = Word32 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Word32
n

-- | SIGHASH_NONE as a byte.
sigHashNone :: SigHash
sigHashNone :: SigHash
sigHashNone = Int -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SigHash) -> Int -> SigHash
forall a b. (a -> b) -> a -> b
$ SigHashFlag -> Int
forall a. Enum a => a -> Int
fromEnum SigHashFlag
SIGHASH_NONE

-- | SIGHASH_ALL as a byte.
sigHashAll :: SigHash
sigHashAll :: SigHash
sigHashAll = Int -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SigHash) -> Int -> SigHash
forall a b. (a -> b) -> a -> b
$ SigHashFlag -> Int
forall a. Enum a => a -> Int
fromEnum SigHashFlag
SIGHASH_ALL

-- | SIGHASH_SINGLE as a byte.
sigHashSingle :: SigHash
sigHashSingle :: SigHash
sigHashSingle = Int -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SigHash) -> Int -> SigHash
forall a b. (a -> b) -> a -> b
$ SigHashFlag -> Int
forall a. Enum a => a -> Int
fromEnum SigHashFlag
SIGHASH_SINGLE

-- | SIGHASH_FORKID as a byte.
sigHashForkId :: SigHash
sigHashForkId :: SigHash
sigHashForkId = Int -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SigHash) -> Int -> SigHash
forall a b. (a -> b) -> a -> b
$ SigHashFlag -> Int
forall a. Enum a => a -> Int
fromEnum SigHashFlag
SIGHASH_FORKID

-- | SIGHASH_ANYONECANPAY as a byte.
sigHashAnyoneCanPay :: SigHash
sigHashAnyoneCanPay :: SigHash
sigHashAnyoneCanPay = Int -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SigHash) -> Int -> SigHash
forall a b. (a -> b) -> a -> b
$ SigHashFlag -> Int
forall a. Enum a => a -> Int
fromEnum SigHashFlag
SIGHASH_ANYONECANPAY

-- | Set SIGHASH_FORKID flag.
setForkIdFlag :: SigHash -> SigHash
setForkIdFlag :: SigHash -> SigHash
setForkIdFlag = (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.|. SigHash
sigHashForkId)

-- | Set SIGHASH_ANYONECANPAY flag.
setAnyoneCanPay :: SigHash -> SigHash
setAnyoneCanPay :: SigHash -> SigHash
setAnyoneCanPay = (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.|. SigHash
sigHashAnyoneCanPay)

-- | Is the SIGHASH_FORKID flag set?
hasForkIdFlag :: SigHash -> Bool
hasForkIdFlag :: SigHash -> Bool
hasForkIdFlag = (SigHash -> SigHash -> Bool
forall a. Eq a => a -> a -> Bool
/= SigHash
0) (SigHash -> Bool) -> (SigHash -> SigHash) -> SigHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
sigHashForkId)

-- | Is the SIGHASH_ANYONECANPAY flag set?
anyoneCanPay :: SigHash -> Bool
anyoneCanPay :: SigHash -> Bool
anyoneCanPay = (SigHash -> SigHash -> Bool
forall a. Eq a => a -> a -> Bool
/= SigHash
0) (SigHash -> Bool) -> (SigHash -> SigHash) -> SigHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
sigHashAnyoneCanPay)

-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_ALL'.
isSigHashAll :: SigHash -> Bool
isSigHashAll :: SigHash -> Bool
isSigHashAll = (SigHash -> SigHash -> Bool
forall a. Eq a => a -> a -> Bool
== SigHash
sigHashAll) (SigHash -> Bool) -> (SigHash -> SigHash) -> SigHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
0x1f)

-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_NONE'.
isSigHashNone :: SigHash -> Bool
isSigHashNone :: SigHash -> Bool
isSigHashNone = (SigHash -> SigHash -> Bool
forall a. Eq a => a -> a -> Bool
== SigHash
sigHashNone) (SigHash -> Bool) -> (SigHash -> SigHash) -> SigHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
0x1f)

-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_SINGLE'.
isSigHashSingle :: SigHash -> Bool
isSigHashSingle :: SigHash -> Bool
isSigHashSingle = (SigHash -> SigHash -> Bool
forall a. Eq a => a -> a -> Bool
== SigHash
sigHashSingle) (SigHash -> Bool) -> (SigHash -> SigHash) -> SigHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
0x1f)

-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_UNKNOWN'.
isSigHashUnknown :: SigHash -> Bool
isSigHashUnknown :: SigHash -> Bool
isSigHashUnknown =
  (SigHash -> [SigHash] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [SigHash
sigHashAll, SigHash
sigHashNone, SigHash
sigHashSingle]) (SigHash -> Bool) -> (SigHash -> SigHash) -> SigHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
0x1f)

-- | Add a fork id to a 'SigHash'.
sigHashAddForkId :: SigHash -> Word32 -> SigHash
sigHashAddForkId :: SigHash -> Word32 -> SigHash
sigHashAddForkId SigHash
sh Word32
w = (Word32 -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w SigHash -> Int -> SigHash
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.|. (SigHash
sh SigHash -> SigHash -> SigHash
forall a. Bits a => a -> a -> a
.&. SigHash
0x000000ff)

-- | Add fork id of a particular network to a 'SigHash'.
sigHashAddNetworkId :: Network -> SigHash -> SigHash
sigHashAddNetworkId :: Network -> SigHash -> SigHash
sigHashAddNetworkId Network
net =
  (SigHash -> Word32 -> SigHash
`sigHashAddForkId` Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe Word32
0 Network
net.sigHashForkId)

-- | Get fork id from 'SigHash'.
sigHashGetForkId :: SigHash -> Word32
sigHashGetForkId :: SigHash -> Word32
sigHashGetForkId (SigHash Word32
n) = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8

-- | Computes the hash that will be used for signing a transaction.
txSigHash ::
  Network ->
  -- | transaction to sign
  Tx ->
  -- | script from output being spent
  Script ->
  -- | value of output being spent
  Word64 ->
  -- | index of input being signed
  Int ->
  -- | what to sign
  SigHash ->
  -- | hash to be signed
  Hash256
txSigHash :: Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx Script
out Word64
v Int
i SigHash
sh
  | SigHash -> Bool
hasForkIdFlag SigHash
sh Bool -> Bool -> Bool
&& Maybe Word32 -> Bool
forall a. Maybe a -> Bool
isJust Network
net.sigHashForkId =
      Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHashForkId Network
net Tx
tx Script
out Word64
v Int
i SigHash
sh
  | Bool
otherwise = do
      let newIn :: [TxIn]
newIn = [TxIn] -> Script -> Int -> SigHash -> [TxIn]
buildInputs Tx
tx.inputs Script
fout Int
i SigHash
sh
      -- When SigSingle and input index > outputs, then sign integer 1
      Hash256 -> Maybe Hash256 -> Hash256
forall a. a -> Maybe a -> a
fromMaybe Hash256
one (Maybe Hash256 -> Hash256) -> Maybe Hash256 -> Hash256
forall a b. (a -> b) -> a -> b
$ do
        [TxOut]
newOut <- [TxOut] -> Int -> SigHash -> Maybe [TxOut]
buildOutputs Tx
tx.outputs Int
i SigHash
sh
        let newTx :: Tx
newTx = Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx Tx
tx.version [TxIn]
newIn [TxOut]
newOut [] Tx
tx.locktime
        Hash256 -> Maybe Hash256
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash256 -> Maybe Hash256)
-> (Put -> Hash256) -> Put -> Maybe Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> Maybe Hash256) -> Put -> Maybe Hash256
forall a b. (a -> b) -> a -> b
$ do
          Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize Tx
newTx
          Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ SigHash -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral SigHash
sh
  where
    fout :: Script
fout = [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$ (ScriptOp -> Bool) -> [ScriptOp] -> [ScriptOp]
forall a. (a -> Bool) -> [a] -> [a]
filter (ScriptOp -> ScriptOp -> Bool
forall a. Eq a => a -> a -> Bool
/= ScriptOp
OP_CODESEPARATOR) Script
out.ops
    one :: Hash256
one = Hash256
"0100000000000000000000000000000000000000000000000000000000000000"

-- | Build transaction inputs for computing sighashes.
buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn]
buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn]
buildInputs [TxIn]
txins Script
out Int
i SigHash
sh
  | SigHash -> Bool
anyoneCanPay SigHash
sh = [TxIn -> TxIn
serialOut ([TxIn]
txins [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)]
  | SigHash -> Bool
isSigHashAll SigHash
sh Bool -> Bool -> Bool
|| SigHash -> Bool
isSigHashUnknown SigHash
sh = [TxIn]
single
  | Bool
otherwise = (TxIn -> Int -> TxIn) -> [TxIn] -> [Int] -> [TxIn]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TxIn -> Int -> TxIn
noSeq [TxIn]
single [Int
0 ..]
  where
    serialOut :: TxIn -> TxIn
serialOut TxIn {Word32
ByteString
OutPoint
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
..} = TxIn {$sel:script:TxIn :: ByteString
script = Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Script -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Script -> m ()
serialize Script
out, Word32
OutPoint
outpoint :: OutPoint
sequence :: Word32
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: Word32
..}
    emptyIn :: TxIn -> TxIn
emptyIn TxIn {Word32
ByteString
OutPoint
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
..} = TxIn {$sel:script:TxIn :: ByteString
script = ByteString
B.empty, Word32
OutPoint
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: Word32
outpoint :: OutPoint
sequence :: Word32
..}
    emptyIns :: [TxIn]
emptyIns = (TxIn -> TxIn) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn
emptyIn [TxIn]
txins
    single :: [TxIn]
single = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
emptyIns TxIn -> TxIn
serialOut
    noSeq :: TxIn -> Int -> TxIn
noSeq TxIn {Word32
ByteString
OutPoint
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
..} Int
j = TxIn {$sel:sequence:TxIn :: Word32
sequence = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then Word32
sequence else Word32
0, ByteString
OutPoint
$sel:outpoint:TxIn :: OutPoint
$sel:script:TxIn :: ByteString
outpoint :: OutPoint
script :: ByteString
..}

-- | Build transaction outputs for computing sighashes.
buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut]
buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut]
buildOutputs [TxOut]
txos Int
i SigHash
sh
  | SigHash -> Bool
isSigHashAll SigHash
sh Bool -> Bool -> Bool
|| SigHash -> Bool
isSigHashUnknown SigHash
sh = [TxOut] -> Maybe [TxOut]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxOut]
txos
  | SigHash -> Bool
isSigHashNone SigHash
sh = [TxOut] -> Maybe [TxOut]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut]
txos = Maybe [TxOut]
forall a. Maybe a
Nothing
  | Bool
otherwise = [TxOut] -> Maybe [TxOut]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxOut] -> Maybe [TxOut]) -> [TxOut] -> Maybe [TxOut]
forall a b. (a -> b) -> a -> b
$ [TxOut]
buffer [TxOut] -> [TxOut] -> [TxOut]
forall a. [a] -> [a] -> [a]
++ [[TxOut]
txos [TxOut] -> Int -> TxOut
forall a. HasCallStack => [a] -> Int -> a
!! Int
i]
  where
    buffer :: [TxOut]
buffer = Int -> TxOut -> [TxOut]
forall a. Int -> a -> [a]
replicate Int
i (TxOut -> [TxOut]) -> TxOut -> [TxOut]
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString -> TxOut
TxOut Word64
forall a. Bounded a => a
maxBound ByteString
B.empty

-- | Compute the hash that will be used for signing a transaction. This
-- function is used when the 'SIGHASH_FORKID' flag is set.
txSigHashForkId ::
  Network ->
  -- | transaction to sign
  Tx ->
  -- | script from output being spent
  Script ->
  -- | value of output being spent
  Word64 ->
  -- | index of input being signed
  Int ->
  -- | what to sign
  SigHash ->
  -- | hash to be signed
  Hash256
txSigHashForkId :: Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHashForkId Network
net Tx
tx Script
out Word64
v Int
i SigHash
sh =
  ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> Hash256) -> Put -> Hash256
forall a b. (a -> b) -> a -> b
$ do
    Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Tx
tx.version
    Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
hashPrevouts
    Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
hashSequence
    OutPoint -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => OutPoint -> m ()
serialize (Tx
tx.inputs [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i).outpoint
    Script -> Put
forall {m :: * -> *} {p}. (MonadPut m, Serial p) => p -> m ()
putScript Script
out
    Word64 -> Put
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
v
    Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Tx
tx.inputs [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i).sequence
    Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
hashOutputs
    Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Tx
tx.locktime
    Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ SigHash -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SigHash -> Word32) -> SigHash -> Word32
forall a b. (a -> b) -> a -> b
$ Network -> SigHash -> SigHash
sigHashAddNetworkId Network
net SigHash
sh
  where
    hashPrevouts :: Hash256
hashPrevouts
      | Bool -> Bool
not (SigHash -> Bool
anyoneCanPay SigHash
sh) =
          ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> Hash256) -> Put -> Hash256
forall a b. (a -> b) -> a -> b
$ (TxIn -> Put) -> [TxIn] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (OutPoint -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => OutPoint -> m ()
serialize (OutPoint -> Put) -> (TxIn -> OutPoint) -> TxIn -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.outpoint)) Tx
tx.inputs
      | Bool
otherwise = Hash256
zeros
    hashSequence :: Hash256
hashSequence
      | Bool -> Bool
not (SigHash -> Bool
anyoneCanPay SigHash
sh Bool -> Bool -> Bool
|| SigHash -> Bool
isSigHashSingle SigHash
sh Bool -> Bool -> Bool
|| SigHash -> Bool
isSigHashNone SigHash
sh) =
          ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> Hash256) -> Put -> Hash256
forall a b. (a -> b) -> a -> b
$ (TxIn -> Put) -> [TxIn] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> Put) -> (TxIn -> Word32) -> TxIn -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.sequence)) Tx
tx.inputs
      | Bool
otherwise = Hash256
zeros
    hashOutputs :: Hash256
hashOutputs
      | Bool -> Bool
not (SigHash -> Bool
isSigHashSingle SigHash
sh Bool -> Bool -> Bool
|| SigHash -> Bool
isSigHashNone SigHash
sh) =
          ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> Hash256) -> Put -> Hash256
forall a b. (a -> b) -> a -> b
$ (TxOut -> Put) -> [TxOut] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TxOut -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxOut -> m ()
serialize Tx
tx.outputs
      | SigHash -> Bool
isSigHashSingle SigHash
sh Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
tx.outputs =
          ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> Hash256) -> Put -> Hash256
forall a b. (a -> b) -> a -> b
$ TxOut -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxOut -> m ()
serialize (TxOut -> Put) -> TxOut -> Put
forall a b. (a -> b) -> a -> b
$ Tx
tx.outputs [TxOut] -> Int -> TxOut
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
      | Bool
otherwise = Hash256
zeros
    putScript :: p -> m ()
putScript p
s = do
      let encodedScript :: ByteString
encodedScript = Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ p -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => p -> m ()
serialize p
s
      Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
encodedScript
      ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
encodedScript
    zeros :: Hash256
    zeros :: Hash256
zeros = Hash256
"0000000000000000000000000000000000000000000000000000000000000000"

-- | Data type representing a signature together with a 'SigHash'. The 'SigHash'
-- is serialized as one byte at the end of an ECDSA 'Sig'. All signatures in
-- transaction inputs are of type 'TxSignature'.
data TxSignature
  = TxSignature
      { TxSignature -> Sig
sig :: !Sig,
        TxSignature -> SigHash
hash :: !SigHash
      }
  | TxSignatureEmpty
  deriving (TxSignature -> TxSignature -> Bool
(TxSignature -> TxSignature -> Bool)
-> (TxSignature -> TxSignature -> Bool) -> Eq TxSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSignature -> TxSignature -> Bool
== :: TxSignature -> TxSignature -> Bool
$c/= :: TxSignature -> TxSignature -> Bool
/= :: TxSignature -> TxSignature -> Bool
Eq, Int -> TxSignature -> ShowS
[TxSignature] -> ShowS
TxSignature -> String
(Int -> TxSignature -> ShowS)
-> (TxSignature -> String)
-> ([TxSignature] -> ShowS)
-> Show TxSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSignature -> ShowS
showsPrec :: Int -> TxSignature -> ShowS
$cshow :: TxSignature -> String
show :: TxSignature -> String
$cshowList :: [TxSignature] -> ShowS
showList :: [TxSignature] -> ShowS
Show, ReadPrec [TxSignature]
ReadPrec TxSignature
Int -> ReadS TxSignature
ReadS [TxSignature]
(Int -> ReadS TxSignature)
-> ReadS [TxSignature]
-> ReadPrec TxSignature
-> ReadPrec [TxSignature]
-> Read TxSignature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TxSignature
readsPrec :: Int -> ReadS TxSignature
$creadList :: ReadS [TxSignature]
readList :: ReadS [TxSignature]
$creadPrec :: ReadPrec TxSignature
readPrec :: ReadPrec TxSignature
$creadListPrec :: ReadPrec [TxSignature]
readListPrec :: ReadPrec [TxSignature]
Read, (forall x. TxSignature -> Rep TxSignature x)
-> (forall x. Rep TxSignature x -> TxSignature)
-> Generic TxSignature
forall x. Rep TxSignature x -> TxSignature
forall x. TxSignature -> Rep TxSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxSignature -> Rep TxSignature x
from :: forall x. TxSignature -> Rep TxSignature x
$cto :: forall x. Rep TxSignature x -> TxSignature
to :: forall x. Rep TxSignature x -> TxSignature
Generic, TxSignature -> ()
(TxSignature -> ()) -> NFData TxSignature
forall a. (a -> ()) -> NFData a
$crnf :: TxSignature -> ()
rnf :: TxSignature -> ()
NFData)

instance Marshal (Network, Ctx) TxSignature where
  marshalPut :: forall (m :: * -> *).
MonadPut m =>
(Network, Ctx) -> TxSignature -> m ()
marshalPut (Network
net, Ctx
ctx) TxSignature
TxSignatureEmpty = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  marshalPut (Network
net, Ctx
ctx) (TxSignature Sig
sig (SigHash Word32
n)) = do
    Ctx -> Sig -> m ()
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *). MonadPut m => Ctx -> Sig -> m ()
marshalPut Ctx
ctx Sig
sig
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)

  marshalGet :: forall (m :: * -> *). MonadGet m => (Network, Ctx) -> m TxSignature
marshalGet (Network
net, Ctx
ctx) =
    m TxSignature -> m TxSignature -> Bool -> m TxSignature
forall a. a -> a -> Bool -> a
bool m TxSignature
decode m TxSignature
empty (Bool -> m TxSignature) -> m Bool -> m TxSignature
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty
    where
      empty :: m TxSignature
empty = TxSignature -> m TxSignature
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSignature
TxSignatureEmpty
      decode :: m TxSignature
decode = do
        Sig
sig <- Ctx -> m Sig
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => Ctx -> m Sig
marshalGet Ctx
ctx
        SigHash
sh <- Word8 -> SigHash
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> SigHash) -> m Word8 -> m SigHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SigHash -> Bool
isSigHashUnknown SigHash
sh) (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
"Non-canonical signature: unknown hashtype byte"
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Word32 -> Bool
forall a. Maybe a -> Bool
isNothing Network
net.sigHashForkId Bool -> Bool -> Bool
&& SigHash -> Bool
hasForkIdFlag SigHash
sh) (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
"Non-canonical signature: invalid network for forkId"
        TxSignature -> m TxSignature
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSignature -> m TxSignature) -> TxSignature -> m TxSignature
forall a b. (a -> b) -> a -> b
$ Sig -> SigHash -> TxSignature
TxSignature Sig
sig SigHash
sh

instance MarshalJSON (Network, Ctx) TxSignature where
  marshalValue :: (Network, Ctx) -> TxSignature -> Value
marshalValue (Network
net, Ctx
ctx) = Text -> Value
String (Text -> Value) -> (TxSignature -> Text) -> TxSignature -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (TxSignature -> ByteString) -> TxSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Ctx -> TxSignature -> ByteString
encodeTxSig Network
net Ctx
ctx
  marshalEncoding :: (Network, Ctx) -> TxSignature -> Encoding
marshalEncoding (Network, Ctx)
s = ByteString -> Encoding
hexEncoding (ByteString -> Encoding)
-> (TxSignature -> ByteString) -> TxSignature -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString)
-> (TxSignature -> Put) -> TxSignature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Network, Ctx) -> TxSignature -> Put
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *).
MonadPut m =>
(Network, Ctx) -> TxSignature -> m ()
marshalPut (Network, Ctx)
s
  unmarshalValue :: (Network, Ctx) -> Value -> Parser TxSignature
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Text -> Parser TxSignature) -> Value -> Parser TxSignature
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TxSignature" ((Text -> Parser TxSignature) -> Value -> Parser TxSignature)
-> (Text -> Parser TxSignature) -> Value -> Parser TxSignature
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text -> Maybe ByteString
decodeHex Text
t of
        Maybe ByteString
Nothing -> String -> Parser TxSignature
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot decode hex signature"
        Just ByteString
b -> case Network -> Ctx -> ByteString -> Either String TxSignature
decodeTxSig Network
net Ctx
ctx ByteString
b of
          Left String
e -> String -> Parser TxSignature
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          Right TxSignature
s -> TxSignature -> Parser TxSignature
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSignature
s

encodeTxSig :: Network -> Ctx -> TxSignature -> ByteString
encodeTxSig :: Network -> Ctx -> TxSignature -> ByteString
encodeTxSig Network
net Ctx
ctx = Put -> ByteString
runPutS (Put -> ByteString)
-> (TxSignature -> Put) -> TxSignature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Network, Ctx) -> TxSignature -> Put
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *).
MonadPut m =>
(Network, Ctx) -> TxSignature -> m ()
marshalPut (Network
net, Ctx
ctx)

decodeTxSig :: Network -> Ctx -> ByteString -> Either String TxSignature
decodeTxSig :: Network -> Ctx -> ByteString -> Either String TxSignature
decodeTxSig Network
net Ctx
ctx =
  Get TxSignature -> ByteString -> Either String TxSignature
forall a. Get a -> ByteString -> Either String a
runGetS (Get TxSignature -> ByteString -> Either String TxSignature)
-> Get TxSignature -> ByteString -> Either String TxSignature
forall a b. (a -> b) -> a -> b
$ do
    TxSignature
sig <- (Network, Ctx) -> Get TxSignature
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => (Network, Ctx) -> m TxSignature
marshalGet (Network
net, Ctx
ctx)
    Bool
e <- Get Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Non-canonical signature: multiple hashtype bytes"
    TxSignature -> Get TxSignature
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSignature
sig