{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Haskoin.Transaction.Taproot (
XOnlyPubKey (..),
TapLeafVersion,
MAST (..),
mastCommitment,
getMerkleProofs,
TaprootOutput (..),
taprootOutputKey,
taprootScriptOutput,
TaprootWitness (..),
ScriptPathData (..),
viewTaprootWitness,
encodeTaprootWitness,
verifyScriptPathData,
) where
import Control.Applicative (many)
import Control.Monad ((<=<))
import Crypto.Hash (
Digest,
SHA256,
digestFromByteString,
hashFinalize,
hashUpdate,
hashUpdates,
)
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)
import Data.Binary (Binary (..))
import Data.Bits ((.&.), (.|.))
import Data.Bool (bool)
import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Bytes.Get (getBytes, runGetS)
import Data.Bytes.Put (putByteString, runPutS)
import Data.Bytes.Serial (Serial (..), deserialize, serialize)
import Data.Bytes.VarInt (VarInt (VarInt))
import Data.Foldable (foldl')
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Serialize (Serialize, get, getByteString, getWord8, put)
import Data.Word (Word8)
import Haskoin.Crypto (PubKey, initTaggedHash, tweak, tweakAddPubKey)
import Haskoin.Keys.Common (PubKeyI (PubKeyI), pubKeyPoint)
import Haskoin.Script.Common (Script)
import Haskoin.Script.Standard (ScriptOutput (PayWitness))
import Haskoin.Transaction.Common (WitnessStack)
import Haskoin.Util (decodeHex, eitherToMaybe, encodeHex)
newtype XOnlyPubKey = XOnlyPubKey {XOnlyPubKey -> PubKey
xOnlyPubKey :: PubKey}
deriving (Int -> XOnlyPubKey -> ShowS
[XOnlyPubKey] -> ShowS
XOnlyPubKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XOnlyPubKey] -> ShowS
$cshowList :: [XOnlyPubKey] -> ShowS
show :: XOnlyPubKey -> String
$cshow :: XOnlyPubKey -> String
showsPrec :: Int -> XOnlyPubKey -> ShowS
$cshowsPrec :: Int -> XOnlyPubKey -> ShowS
Show)
instance Eq XOnlyPubKey where
XOnlyPubKey
k1 == :: XOnlyPubKey -> XOnlyPubKey -> Bool
== XOnlyPubKey
k2 = Put -> WitnessStackItem
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize XOnlyPubKey
k1) forall a. Eq a => a -> a -> Bool
== Put -> WitnessStackItem
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize XOnlyPubKey
k2)
instance Serial XOnlyPubKey where
serialize :: forall (m :: * -> *). MonadPut m => XOnlyPubKey -> m ()
serialize (XOnlyPubKey PubKey
pk) =
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WitnessStackItem -> WitnessStackItem
BS.drop Int
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
forall a b. (a -> b) -> a -> b
$ PubKey -> Bool -> PubKeyI
PubKeyI PubKey
pk Bool
True
deserialize :: forall (m :: * -> *). MonadGet m => m XOnlyPubKey
deserialize =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> XOnlyPubKey
XOnlyPubKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> PubKey
pubKeyPoint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> WitnessStackItem -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> WitnessStackItem -> WitnessStackItem
BS.cons Word8
0x02
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadGet m => Int -> m WitnessStackItem
getBytes Int
32
instance Serialize XOnlyPubKey where
put :: Putter XOnlyPubKey
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get XOnlyPubKey
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Binary XOnlyPubKey where
put :: XOnlyPubKey -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get XOnlyPubKey
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance FromJSON XOnlyPubKey where
parseJSON :: Value -> Parser XOnlyPubKey
parseJSON =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"XOnlyPubKey" forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Get a -> WitnessStackItem -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"Unable to decode hex") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe WitnessStackItem
decodeHex)
instance ToJSON XOnlyPubKey where
toJSON :: XOnlyPubKey -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
type TapLeafVersion = Word8
data MAST
= MASTBranch MAST MAST
| MASTLeaf TapLeafVersion Script
| MASTCommitment (Digest SHA256)
deriving (Int -> MAST -> ShowS
[MAST] -> ShowS
MAST -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MAST] -> ShowS
$cshowList :: [MAST] -> ShowS
show :: MAST -> String
$cshow :: MAST -> String
showsPrec :: Int -> MAST -> ShowS
$cshowsPrec :: Int -> MAST -> ShowS
Show)
getMerkleProofs :: MAST -> [(TapLeafVersion, Script, [Digest SHA256])]
getMerkleProofs :: MAST -> [(Word8, Script, [Digest SHA256])]
getMerkleProofs = [Digest SHA256] -> MAST -> [(Word8, Script, [Digest SHA256])]
getProofs forall a. Monoid a => a
mempty
where
getProofs :: [Digest SHA256] -> MAST -> [(Word8, Script, [Digest SHA256])]
getProofs [Digest SHA256]
proof = \case
MASTBranch MAST
branchL MAST
branchR ->
(forall {a} {a} {b}. [a] -> a -> (a, b, [a]) -> (a, b, [a])
updateProof [Digest SHA256]
proof (MAST -> Digest SHA256
mastCommitment MAST
branchR) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MAST -> [(Word8, Script, [Digest SHA256])]
getMerkleProofs MAST
branchL)
forall a. Semigroup a => a -> a -> a
<> (forall {a} {a} {b}. [a] -> a -> (a, b, [a]) -> (a, b, [a])
updateProof [Digest SHA256]
proof (MAST -> Digest SHA256
mastCommitment MAST
branchL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MAST -> [(Word8, Script, [Digest SHA256])]
getMerkleProofs MAST
branchR)
MASTLeaf Word8
v Script
s -> [(Word8
v, Script
s, [Digest SHA256]
proof)]
MASTCommitment{} -> forall a. Monoid a => a
mempty
updateProof :: [a] -> a -> (a, b, [a]) -> (a, b, [a])
updateProof [a]
proofInit a
branchCommitment (a
v, b
s, [a]
proofTail) =
(a
v, b
s, forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [a]
proofInit forall a. Semigroup a => a -> a -> a
<> (a
branchCommitment forall a. a -> [a] -> [a]
: [a]
proofTail))
mastCommitment :: MAST -> Digest SHA256
mastCommitment :: MAST -> Digest SHA256
mastCommitment = \case
MASTBranch MAST
leftBranch MAST
rightBranch ->
Digest SHA256 -> Digest SHA256 -> Digest SHA256
hashBranch (MAST -> Digest SHA256
mastCommitment MAST
leftBranch) (MAST -> Digest SHA256
mastCommitment MAST
rightBranch)
MASTLeaf Word8
leafVersion Script
leafScript -> Word8 -> Script -> Digest SHA256
leafHash Word8
leafVersion Script
leafScript
MASTCommitment Digest SHA256
theCommitment -> Digest SHA256
theCommitment
hashBranch :: Digest SHA256 -> Digest SHA256 -> Digest SHA256
hashBranch :: Digest SHA256 -> Digest SHA256 -> Digest SHA256
hashBranch Digest SHA256
hashA Digest SHA256
hashB =
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize forall a b. (a -> b) -> a -> b
$
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates
(WitnessStackItem -> Context SHA256
initTaggedHash WitnessStackItem
"TapBranch")
[ forall a. Ord a => a -> a -> a
min Digest SHA256
hashA Digest SHA256
hashB
, forall a. Ord a => a -> a -> a
max Digest SHA256
hashA Digest SHA256
hashB
]
leafHash :: TapLeafVersion -> Script -> Digest SHA256
leafHash :: Word8 -> Script -> Digest SHA256
leafHash Word8
leafVersion Script
leafScript =
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (WitnessStackItem -> Context SHA256
initTaggedHash WitnessStackItem
"TapLeaf")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS
forall a b. (a -> b) -> a -> b
$ do
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Word8
leafVersion
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ forall n. n -> VarInt n
VarInt (WitnessStackItem -> Int
BS.length WitnessStackItem
scriptBytes)
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString WitnessStackItem
scriptBytes
where
scriptBytes :: WitnessStackItem
scriptBytes = Put -> WitnessStackItem
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Script
leafScript
data TaprootOutput = TaprootOutput
{ TaprootOutput -> PubKey
taprootInternalKey :: PubKey
, TaprootOutput -> Maybe MAST
taprootMAST :: Maybe MAST
}
deriving (Int -> TaprootOutput -> ShowS
[TaprootOutput] -> ShowS
TaprootOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaprootOutput] -> ShowS
$cshowList :: [TaprootOutput] -> ShowS
show :: TaprootOutput -> String
$cshow :: TaprootOutput -> String
showsPrec :: Int -> TaprootOutput -> ShowS
$cshowsPrec :: Int -> TaprootOutput -> ShowS
Show)
taprootOutputKey :: TaprootOutput -> PubKey
taprootOutputKey :: TaprootOutput -> PubKey
taprootOutputKey TaprootOutput{PubKey
taprootInternalKey :: PubKey
taprootInternalKey :: TaprootOutput -> PubKey
taprootInternalKey, Maybe MAST
taprootMAST :: Maybe MAST
taprootMAST :: TaprootOutput -> Maybe MAST
taprootMAST} =
forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
keyFail forall a b. (a -> b) -> a -> b
$ WitnessStackItem -> Maybe Tweak
tweak WitnessStackItem
commitment forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PubKey -> Tweak -> Maybe PubKey
tweakAddPubKey PubKey
taprootInternalKey
where
commitment :: WitnessStackItem
commitment = PubKey -> Maybe (Digest SHA256) -> WitnessStackItem
taprootCommitment PubKey
taprootInternalKey forall a b. (a -> b) -> a -> b
$ MAST -> Digest SHA256
mastCommitment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MAST
taprootMAST
keyFail :: a
keyFail = forall a. HasCallStack => String -> a
error String
"haskoin-core taprootOutputKey: key derivation failed"
taprootCommitment :: PubKey -> Maybe (Digest SHA256) -> ByteString
taprootCommitment :: PubKey -> Maybe (Digest SHA256) -> WitnessStackItem
taprootCommitment PubKey
internalKey Maybe (Digest SHA256)
merkleRoot =
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate) Maybe (Digest SHA256)
merkleRoot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
`hashUpdate` WitnessStackItem
keyBytes)
forall a b. (a -> b) -> a -> b
$ WitnessStackItem -> Context SHA256
initTaggedHash WitnessStackItem
"TapTweak"
where
keyBytes :: WitnessStackItem
keyBytes = Put -> WitnessStackItem
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ PubKey -> XOnlyPubKey
XOnlyPubKey PubKey
internalKey
taprootScriptOutput :: TaprootOutput -> ScriptOutput
taprootScriptOutput :: TaprootOutput -> ScriptOutput
taprootScriptOutput = Word8 -> WitnessStackItem -> ScriptOutput
PayWitness Word8
0x01 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> XOnlyPubKey
XOnlyPubKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaprootOutput -> PubKey
taprootOutputKey
data TaprootWitness
=
KeyPathSpend ByteString
| ScriptPathSpend ScriptPathData
deriving (TaprootWitness -> TaprootWitness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TaprootWitness -> TaprootWitness -> Bool
$c/= :: TaprootWitness -> TaprootWitness -> Bool
== :: TaprootWitness -> TaprootWitness -> Bool
$c== :: TaprootWitness -> TaprootWitness -> Bool
Eq, Int -> TaprootWitness -> ShowS
[TaprootWitness] -> ShowS
TaprootWitness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaprootWitness] -> ShowS
$cshowList :: [TaprootWitness] -> ShowS
show :: TaprootWitness -> String
$cshow :: TaprootWitness -> String
showsPrec :: Int -> TaprootWitness -> ShowS
$cshowsPrec :: Int -> TaprootWitness -> ShowS
Show)
data ScriptPathData = ScriptPathData
{ ScriptPathData -> Maybe WitnessStackItem
scriptPathAnnex :: Maybe ByteString
, ScriptPathData -> WitnessStack
scriptPathStack :: [ByteString]
, ScriptPathData -> Script
scriptPathScript :: Script
, ScriptPathData -> Bool
scriptPathExternalIsOdd :: Bool
,
ScriptPathData -> Word8
scriptPathLeafVersion :: Word8
, ScriptPathData -> PubKey
scriptPathInternalKey :: PubKey
, ScriptPathData -> WitnessStack
scriptPathControl :: [ByteString]
}
deriving (ScriptPathData -> ScriptPathData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptPathData -> ScriptPathData -> Bool
$c/= :: ScriptPathData -> ScriptPathData -> Bool
== :: ScriptPathData -> ScriptPathData -> Bool
$c== :: ScriptPathData -> ScriptPathData -> Bool
Eq, Int -> ScriptPathData -> ShowS
[ScriptPathData] -> ShowS
ScriptPathData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptPathData] -> ShowS
$cshowList :: [ScriptPathData] -> ShowS
show :: ScriptPathData -> String
$cshow :: ScriptPathData -> String
showsPrec :: Int -> ScriptPathData -> ShowS
$cshowsPrec :: Int -> ScriptPathData -> ShowS
Show)
viewTaprootWitness :: WitnessStack -> Maybe TaprootWitness
viewTaprootWitness :: WitnessStack -> Maybe TaprootWitness
viewTaprootWitness WitnessStack
witnessStack = case forall a. [a] -> [a]
reverse WitnessStack
witnessStack of
[WitnessStackItem
sig] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WitnessStackItem -> TaprootWitness
KeyPathSpend WitnessStackItem
sig
WitnessStackItem
annexA : WitnessStack
remainingStack
| Word8
0x50 : [Word8]
_ <- WitnessStackItem -> [Word8]
BS.unpack WitnessStackItem
annexA ->
Maybe WitnessStackItem -> WitnessStack -> Maybe TaprootWitness
parseSpendPathData (forall a. a -> Maybe a
Just WitnessStackItem
annexA) WitnessStack
remainingStack
WitnessStack
remainingStack -> Maybe WitnessStackItem -> WitnessStack -> Maybe TaprootWitness
parseSpendPathData forall a. Maybe a
Nothing WitnessStack
remainingStack
where
parseSpendPathData :: Maybe WitnessStackItem -> WitnessStack -> Maybe TaprootWitness
parseSpendPathData Maybe WitnessStackItem
scriptPathAnnex = \case
WitnessStackItem
scriptBytes : WitnessStackItem
controlBytes : WitnessStack
scriptPathStack -> do
Script
scriptPathScript <- forall a b. Either a b -> Maybe b
eitherToMaybe forall a b. (a -> b) -> a -> b
$ forall a. Get a -> WitnessStackItem -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize WitnessStackItem
scriptBytes
(Word8
v, PubKey
scriptPathInternalKey, WitnessStack
scriptPathControl) <- WitnessStackItem -> Maybe (Word8, PubKey, WitnessStack)
deconstructControl WitnessStackItem
controlBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptPathData -> TaprootWitness
ScriptPathSpend forall a b. (a -> b) -> a -> b
$
ScriptPathData
{ Maybe WitnessStackItem
scriptPathAnnex :: Maybe WitnessStackItem
scriptPathAnnex :: Maybe WitnessStackItem
scriptPathAnnex
, WitnessStack
scriptPathStack :: WitnessStack
scriptPathStack :: WitnessStack
scriptPathStack
, Script
scriptPathScript :: Script
scriptPathScript :: Script
scriptPathScript
, scriptPathExternalIsOdd :: Bool
scriptPathExternalIsOdd = forall a. Integral a => a -> Bool
odd Word8
v
, scriptPathLeafVersion :: Word8
scriptPathLeafVersion = Word8
v forall a. Bits a => a -> a -> a
.&. Word8
0xFE
, PubKey
scriptPathInternalKey :: PubKey
scriptPathInternalKey :: PubKey
scriptPathInternalKey
, WitnessStack
scriptPathControl :: WitnessStack
scriptPathControl :: WitnessStack
scriptPathControl
}
WitnessStack
_ -> forall a. Maybe a
Nothing
deconstructControl :: WitnessStackItem -> Maybe (Word8, PubKey, WitnessStack)
deconstructControl = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> WitnessStackItem -> Either String a
runGetS Get (Word8, PubKey, WitnessStack)
deserializeControl
deserializeControl :: Get (Word8, PubKey, WitnessStack)
deserializeControl = do
Word8
v <- Get Word8
getWord8
PubKey
k <- XOnlyPubKey -> PubKey
xOnlyPubKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
WitnessStack
proof <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ Int -> Get WitnessStackItem
getByteString Int
32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8
v, PubKey
k, WitnessStack
proof)
encodeTaprootWitness :: TaprootWitness -> WitnessStack
encodeTaprootWitness :: TaprootWitness -> WitnessStack
encodeTaprootWitness = \case
KeyPathSpend WitnessStackItem
signature -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WitnessStackItem
signature
ScriptPathSpend ScriptPathData
scriptPathData ->
ScriptPathData -> WitnessStack
scriptPathStack ScriptPathData
scriptPathData
forall a. Semigroup a => a -> a -> a
<> [ Put -> WitnessStackItem
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ ScriptPathData -> Script
scriptPathScript ScriptPathData
scriptPathData
, forall a. Monoid a => [a] -> a
mconcat
[ [Word8] -> WitnessStackItem
BS.pack [ScriptPathData -> Word8
scriptPathLeafVersion ScriptPathData
scriptPathData forall a. Bits a => a -> a -> a
.|. ScriptPathData -> Word8
parity ScriptPathData
scriptPathData]
, Put -> WitnessStackItem
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> XOnlyPubKey
XOnlyPubKey forall a b. (a -> b) -> a -> b
$ ScriptPathData -> PubKey
scriptPathInternalKey ScriptPathData
scriptPathData
, forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ ScriptPathData -> WitnessStack
scriptPathControl ScriptPathData
scriptPathData
]
, forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ ScriptPathData -> Maybe WitnessStackItem
scriptPathAnnex ScriptPathData
scriptPathData
]
where
parity :: ScriptPathData -> Word8
parity = forall a. a -> a -> Bool -> a
bool Word8
0 Word8
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptPathData -> Bool
scriptPathExternalIsOdd
verifyScriptPathData ::
PubKey ->
ScriptPathData ->
Bool
verifyScriptPathData :: PubKey -> ScriptPathData -> Bool
verifyScriptPathData PubKey
outputKey ScriptPathData
scriptPathData = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
WitnessStackItem -> Maybe Tweak
tweak WitnessStackItem
commitment forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PubKey -> Bool
onComputedKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> Tweak -> Maybe PubKey
tweakAddPubKey (ScriptPathData -> PubKey
scriptPathInternalKey ScriptPathData
scriptPathData)
where
onComputedKey :: PubKey -> Bool
onComputedKey PubKey
computedKey =
PubKey -> XOnlyPubKey
XOnlyPubKey PubKey
outputKey forall a. Eq a => a -> a -> Bool
== PubKey -> XOnlyPubKey
XOnlyPubKey PubKey
computedKey
Bool -> Bool -> Bool
&& Word8
expectedParity forall a. Eq a => a -> a -> Bool
== PubKey -> Word8
keyParity PubKey
computedKey
commitment :: WitnessStackItem
commitment = PubKey -> Maybe (Digest SHA256) -> WitnessStackItem
taprootCommitment (ScriptPathData -> PubKey
scriptPathInternalKey ScriptPathData
scriptPathData) (forall a. a -> Maybe a
Just Digest SHA256
merkleRoot)
merkleRoot :: Digest SHA256
merkleRoot =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Digest SHA256 -> Digest SHA256 -> Digest SHA256
hashBranch Digest SHA256
theLeafHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA256)
forall a b. (a -> b) -> a -> b
$ ScriptPathData -> WitnessStack
scriptPathControl ScriptPathData
scriptPathData
theLeafHash :: Digest SHA256
theLeafHash = (Word8 -> Script -> Digest SHA256
leafHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Bits a => a -> a -> a
.&. Word8
0xFE) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptPathData -> Word8
scriptPathLeafVersion forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScriptPathData -> Script
scriptPathScript) ScriptPathData
scriptPathData
expectedParity :: Word8
expectedParity = forall a. a -> a -> Bool -> a
bool Word8
0 Word8
1 forall a b. (a -> b) -> a -> b
$ ScriptPathData -> Bool
scriptPathExternalIsOdd ScriptPathData
scriptPathData
keyParity :: PubKey -> Word8
keyParity :: PubKey -> Word8
keyParity PubKey
key = case WitnessStackItem -> [Word8]
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ PubKey -> Bool -> PubKeyI
PubKeyI PubKey
key Bool
True of
Word8
0x02 : [Word8]
_ -> Word8
0x00
[Word8]
_ -> Word8
0x01