module Network.Haskoin.Script.Evaluator
(
verifySpend
, evalScript
, SigCheck
, Flag
, ProgramData
, Stack
, encodeInt
, decodeInt
, encodeBool
, decodeBool
, runStack
, checkStack
, dumpScript
, dumpStack
, execScript
) where
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Except
import Control.Monad.Identity
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.String.Conversions (cs)
import Data.Bits (shiftR, shiftL, testBit, setBit, clearBit, (.&.))
import Data.Int (Int64)
import Data.Word (Word8, Word64)
import Data.Either (rights)
import Data.Maybe (mapMaybe, isJust)
import Network.Haskoin.Crypto
import Network.Haskoin.Script.Types
import Network.Haskoin.Script.SigHash
import Network.Haskoin.Util
import Network.Haskoin.Transaction.Types
import Data.Binary (encode, decodeOrFail)
maxScriptSize :: Int
maxScriptSize = 10000
maxScriptElementSize :: Int
maxScriptElementSize = 520
maxStackSize :: Int
maxStackSize = 1000
maxOpcodes :: Int
maxOpcodes = 200
maxKeysMultisig :: Int
maxKeysMultisig = 20
data Flag = P2SH
| STRICTENC
| DERSIG
| LOW_S
| NULLDUMMY
| SIGPUSHONLY
| MINIMALDATA
| DISCOURAGE_UPGRADABLE_NOPS
deriving ( Show, Read, Eq )
type FlagSet = [ Flag ]
data EvalError =
EvalError String
| ProgramError String ProgramData
| StackError ScriptOp
| DisabledOp ScriptOp
instance Show EvalError where
show (EvalError m) = m
show (ProgramError m prog) = m ++ " - ProgramData: " ++ show prog
show (StackError op) = show op ++ ": Stack Error"
show (DisabledOp op) = show op ++ ": disabled"
type StackValue = [Word8]
type AltStack = [StackValue]
type Stack = [StackValue]
type HashOps = [ScriptOp]
type SigCheck = [ScriptOp] -> TxSignature -> PubKey -> Bool
data ProgramData = ProgramData {
stack :: Stack,
altStack :: AltStack,
hashOps :: HashOps,
sigCheck :: SigCheck,
opCount :: Int
}
dumpOp :: ScriptOp -> ByteString
dumpOp (OP_PUSHDATA payload optype) = mconcat
[ "OP_PUSHDATA(", cs (show optype), ")", " 0x", encodeHex payload ]
dumpOp op = cs $ show op
dumpList :: [ByteString] -> ByteString
dumpList xs = mconcat [ "[", BS.intercalate "," xs, "]" ]
dumpScript :: [ScriptOp] -> ByteString
dumpScript script = dumpList $ map dumpOp script
dumpStack :: Stack -> ByteString
dumpStack s = dumpList $ map (encodeHex . BS.pack) s
instance Show ProgramData where
show p = "stack: " ++ (cs $ dumpStack $ stack p)
type ProgramState = ExceptT EvalError Identity
type IfStack = [Bool]
type StackOperation = ReaderT FlagSet ( StateT ProgramData ProgramState )
type Program a = StateT IfStack StackOperation a
evalStackOperation :: StackOperation a -> ProgramData -> FlagSet -> Either EvalError a
evalStackOperation m s f = runIdentity . runExceptT $ evalStateT ( runReaderT m f ) s
evalProgram :: Program a
-> [ Bool ]
-> ProgramData
-> FlagSet
-> Either EvalError a
evalProgram m s = evalStackOperation ( evalStateT m s )
programError :: String -> StackOperation a
programError s = get >>= throwError . ProgramError s
disabled :: ScriptOp -> StackOperation ()
disabled op = throwError . DisabledOp $ op
encodeInt :: Int64 -> StackValue
encodeInt i = prefix $ encod (fromIntegral $ abs i) []
where encod :: Word64 -> StackValue -> StackValue
encod 0 bytes = bytes
encod j bytes = fromIntegral j:encod (j `shiftR` 8) bytes
prefix :: StackValue -> StackValue
prefix [] = []
prefix xs | testBit (last xs) 7 = prefix $ xs ++ [0]
| i < 0 = init xs ++ [setBit (last xs) 7]
| otherwise = xs
decodeInt :: StackValue -> Maybe Int64
decodeInt bytes | length bytes > 4 = Nothing
| otherwise = Just $ sign' (decodeW bytes)
where decodeW [] = 0
decodeW [x] = fromIntegral $ clearBit x 7
decodeW (x:xs) = fromIntegral x + decodeW xs `shiftL` 8
sign' i | null bytes = 0
| testBit (last bytes) 7 = i
| otherwise = i
decodeBool :: StackValue -> Bool
decodeBool [] = False
decodeBool [0x00] = False
decodeBool [0x80] = False
decodeBool (0x00:vs) = decodeBool vs
decodeBool _ = True
encodeBool :: Bool -> StackValue
encodeBool True = [1]
encodeBool False = []
constValue :: ScriptOp -> Maybe StackValue
constValue op = case op of
OP_0 -> Just $ encodeInt 0
OP_1 -> Just $ encodeInt 1
OP_2 -> Just $ encodeInt 2
OP_3 -> Just $ encodeInt 3
OP_4 -> Just $ encodeInt 4
OP_5 -> Just $ encodeInt 5
OP_6 -> Just $ encodeInt 6
OP_7 -> Just $ encodeInt 7
OP_8 -> Just $ encodeInt 8
OP_9 -> Just $ encodeInt 9
OP_10 -> Just $ encodeInt 10
OP_11 -> Just $ encodeInt 11
OP_12 -> Just $ encodeInt 12
OP_13 -> Just $ encodeInt 13
OP_14 -> Just $ encodeInt 14
OP_15 -> Just $ encodeInt 15
OP_16 -> Just $ encodeInt 16
OP_1NEGATE -> Just $ encodeInt $ 1
(OP_PUSHDATA string _) -> Just $ BS.unpack string
_ -> Nothing
isConstant :: ScriptOp -> Bool
isConstant = isJust . constValue
isDisabled :: ScriptOp -> Bool
isDisabled op = op `elem` [ OP_CAT
, OP_SUBSTR
, OP_LEFT
, OP_RIGHT
, OP_INVERT
, OP_AND
, OP_OR
, OP_XOR
, OP_2MUL
, OP_2DIV
, OP_MUL
, OP_DIV
, OP_MOD
, OP_LSHIFT
, OP_RSHIFT
, OP_VER
, OP_VERIF
, OP_VERNOTIF ]
countOp :: ScriptOp -> Bool
countOp op | isConstant op = False
| op == OP_RESERVED = False
| otherwise = True
popInt :: StackOperation Int64
popInt = minimalStackValEnforcer >> decodeInt <$> popStack >>= \case
Nothing -> programError "popInt: data > nMaxNumSize"
Just i -> return i
pushInt :: Int64 -> StackOperation ()
pushInt = pushStack . encodeInt
popBool :: StackOperation Bool
popBool = decodeBool <$> popStack
pushBool :: Bool -> StackOperation ()
pushBool = pushStack . encodeBool
opToSv :: StackValue -> BS.ByteString
opToSv = BS.pack
bsToSv :: BS.ByteString -> StackValue
bsToSv = BS.unpack
getStack :: StackOperation Stack
getStack = stack <$> get
getCond :: Program [Bool]
getCond = get
popCond :: Program Bool
popCond = get >>= \condStack -> case condStack of
[] -> lift $ programError "popCond: empty condStack"
(x:xs) -> put xs >> return x
pushCond :: Bool -> Program ()
pushCond c = get >>= \s ->
put (c:s)
flipCond :: Program ()
flipCond = popCond >>= pushCond . not
withStack :: StackOperation Stack
withStack = getStack >>= \case
[] -> stackError
s -> return s
putStack :: Stack -> StackOperation ()
putStack st = modify $ \p -> p { stack = st }
prependStack :: Stack -> StackOperation ()
prependStack s = getStack >>= \s' -> putStack $ s ++ s'
checkPushData :: ScriptOp -> StackOperation ()
checkPushData (OP_PUSHDATA v _) | BS.length v > fromIntegral maxScriptElementSize
= programError "OP_PUSHDATA > maxScriptElementSize"
| otherwise = return ()
checkPushData _ = return ()
checkStackSize :: StackOperation ()
checkStackSize = do n <- length <$> stack <$> get
m <- length <$> altStack <$> get
when ((n + m) > fromIntegral maxStackSize) $
programError "stack > maxStackSize"
pushStack :: StackValue -> StackOperation ()
pushStack v = getStack >>= \s -> putStack (v:s)
popStack :: StackOperation StackValue
popStack = withStack >>= \(s:ss) -> putStack ss >> return s
popStackN :: Integer -> StackOperation [StackValue]
popStackN n | n < 0 = programError "popStackN: negative argument"
| n == 0 = return []
| otherwise = (:) <$> popStack <*> popStackN (n 1)
pickStack :: Bool -> Int -> StackOperation ()
pickStack remove n = do
st <- getStack
when (n < 0) $
programError "pickStack: n < 0"
when (n > length st 1) $
programError "pickStack: n > size"
let v = st !! n
when remove $ putStack $ take n st ++ drop (n+1) st
pushStack v
getHashOps :: StackOperation HashOps
getHashOps = hashOps <$> get
dropHashOpsSeparatedCode :: StackOperation ()
dropHashOpsSeparatedCode = modify $ \p ->
let tryDrop = dropWhile ( /= OP_CODESEPARATOR ) $ hashOps p in
case tryDrop of
[] -> p
_ -> p { hashOps = tail tryDrop }
preparedHashOps :: StackOperation HashOps
preparedHashOps = filter ( /= OP_CODESEPARATOR ) <$> getHashOps
findAndDelete :: [ StackValue ] -> [ ScriptOp ] -> [ ScriptOp ]
findAndDelete [] ops = ops
findAndDelete (s:ss) ops = let pushOp = opPushData . opToSv $ s in
findAndDelete ss $ filter ( /= pushOp ) ops
checkMultiSig :: SigCheck
-> [ StackValue ]
-> [ StackValue ]
-> [ ScriptOp ]
-> Bool
checkMultiSig f encPubKeys encSigs hOps =
let pubKeys = mapMaybe ( decodeToMaybe . opToSv ) encPubKeys
sigs = rights $ map ( decodeSig . opToSv ) encSigs
cleanHashOps = findAndDelete encSigs hOps
in (length sigs == length encSigs) &&
orderedSatisfy (f cleanHashOps) sigs pubKeys
orderedSatisfy :: ( a -> b -> Bool )
-> [ a ]
-> [ b ]
-> Bool
orderedSatisfy _ [] _ = True
orderedSatisfy _ (_:_) [] = False
orderedSatisfy f x@(a:as) y@(b:bs) | length x > length y = False
| f a b = orderedSatisfy f as bs
| otherwise = orderedSatisfy f x bs
tStack1 :: (StackValue -> Stack) -> StackOperation ()
tStack1 f = f <$> popStack >>= prependStack
tStack2 :: (StackValue -> StackValue -> Stack) -> StackOperation ()
tStack2 f = f <$> popStack <*> popStack >>= prependStack
tStack3 :: (StackValue -> StackValue -> StackValue -> Stack) -> StackOperation ()
tStack3 f = f <$> popStack <*> popStack <*> popStack >>= prependStack
tStack4 :: (StackValue -> StackValue -> StackValue -> StackValue -> Stack)
-> StackOperation ()
tStack4 f = f <$> popStack <*> popStack <*> popStack <*> popStack
>>= prependStack
tStack6 :: (StackValue -> StackValue -> StackValue ->
StackValue -> StackValue -> StackValue -> Stack) -> StackOperation ()
tStack6 f = f <$> popStack <*> popStack <*> popStack
<*> popStack <*> popStack <*> popStack >>= prependStack
arith1 :: (Int64 -> Int64) -> StackOperation ()
arith1 f = do
i <- popInt
pushStack $ encodeInt (f i)
arith2 :: (Int64 -> Int64 -> Int64) -> StackOperation ()
arith2 f = do
i <- popInt
j <- popInt
pushStack $ encodeInt (f i j)
stackError :: StackOperation a
stackError = programError "stack error"
pushAltStack :: StackValue -> StackOperation ()
pushAltStack op = modify $ \p -> p { altStack = op:altStack p }
popAltStack :: StackOperation StackValue
popAltStack = get >>= \p -> case altStack p of
a:as -> put p { altStack = as } >> return a
[] -> programError "popAltStack: empty stack"
incrementOpCount :: Int -> StackOperation ()
incrementOpCount i | i > maxOpcodes = programError "reached opcode limit"
| otherwise = modify $ \p -> p { opCount = i + 1 }
nopDiscourager :: StackOperation ()
nopDiscourager = do
flgs <- ask
if DISCOURAGE_UPGRADABLE_NOPS `elem` flgs
then programError "Discouraged OP used."
else return ()
eval :: ScriptOp -> StackOperation ()
eval OP_NOP = return ()
eval OP_NOP1 = nopDiscourager >> return ()
eval OP_NOP2 = nopDiscourager >> return ()
eval OP_NOP3 = nopDiscourager >> return ()
eval OP_NOP4 = nopDiscourager >> return ()
eval OP_NOP5 = nopDiscourager >> return ()
eval OP_NOP6 = nopDiscourager >> return ()
eval OP_NOP7 = nopDiscourager >> return ()
eval OP_NOP8 = nopDiscourager >> return ()
eval OP_NOP9 = nopDiscourager >> return ()
eval OP_NOP10 = nopDiscourager >> return ()
eval OP_VERIFY = popBool >>= \case
True -> return ()
False -> programError "OP_VERIFY failed"
eval OP_RETURN = programError "explicit OP_RETURN"
eval OP_TOALTSTACK = popStack >>= pushAltStack
eval OP_FROMALTSTACK = popAltStack >>= pushStack
eval OP_IFDUP = tStack1 $ \a -> if decodeBool a then [a, a] else [a]
eval OP_DEPTH = getStack >>= pushStack . encodeInt . fromIntegral . length
eval OP_DROP = void popStack
eval OP_DUP = tStack1 $ \a -> [a, a]
eval OP_NIP = tStack2 $ \a _ -> [a]
eval OP_OVER = tStack2 $ \a b -> [b, a, b]
eval OP_PICK = popInt >>= (pickStack False . fromIntegral)
eval OP_ROLL = popInt >>= (pickStack True . fromIntegral)
eval OP_ROT = tStack3 $ \a b c -> [c, a, b]
eval OP_SWAP = tStack2 $ \a b -> [b, a]
eval OP_TUCK = tStack2 $ \a b -> [a, b, a]
eval OP_2DROP = tStack2 $ \_ _ -> []
eval OP_2DUP = tStack2 $ \a b -> [a, b, a, b]
eval OP_3DUP = tStack3 $ \a b c -> [a, b, c, a, b, c]
eval OP_2OVER = tStack4 $ \a b c d -> [c, d, a, b, c, d]
eval OP_2ROT = tStack6 $ \a b c d e f -> [e, f, a, b, c, d]
eval OP_2SWAP = tStack4 $ \a b c d -> [c, d, a, b]
eval OP_SIZE = (fromIntegral . length <$> head <$> withStack) >>= pushInt
eval OP_EQUAL = tStack2 $ \a b -> [encodeBool (a == b)]
eval OP_EQUALVERIFY = eval OP_EQUAL >> eval OP_VERIFY
eval OP_1ADD = arith1 (+1)
eval OP_1SUB = arith1 (subtract 1)
eval OP_NEGATE = arith1 negate
eval OP_ABS = arith1 abs
eval OP_NOT = arith1 $ \case 0 -> 1; _ -> 0
eval OP_0NOTEQUAL = arith1 $ \case 0 -> 0; _ -> 1
eval OP_ADD = arith2 (+)
eval OP_SUB = arith2 $ flip ()
eval OP_BOOLAND = (&&) <$> ((0 /=) <$> popInt)
<*> ((0 /=) <$> popInt) >>= pushBool
eval OP_BOOLOR = (||) <$> ((0 /=) <$> popInt)
<*> ((0 /=) <$> popInt) >>= pushBool
eval OP_NUMEQUAL = (==) <$> popInt <*> popInt >>= pushBool
eval OP_NUMEQUALVERIFY = eval OP_NUMEQUAL >> eval OP_VERIFY
eval OP_NUMNOTEQUAL = (/=) <$> popInt <*> popInt >>= pushBool
eval OP_LESSTHAN = (>) <$> popInt <*> popInt >>= pushBool
eval OP_GREATERTHAN = (<) <$> popInt <*> popInt >>= pushBool
eval OP_LESSTHANOREQUAL = (>=) <$> popInt <*> popInt >>= pushBool
eval OP_GREATERTHANOREQUAL = (<=) <$> popInt <*> popInt >>= pushBool
eval OP_MIN = min <$> popInt <*> popInt >>= pushInt
eval OP_MAX = max <$> popInt <*> popInt >>= pushInt
eval OP_WITHIN = within <$> popInt <*> popInt <*> popInt >>= pushBool
where within y x a = (x <= a) && (a < y)
eval OP_RIPEMD160 = tStack1 $ return . bsToSv . getHash160 . hash160 . opToSv
eval OP_SHA1 = tStack1 $ return . bsToSv . getHash160 . sha1 . opToSv
eval OP_SHA256 = tStack1 $ return . bsToSv . getHash256 . hash256 . opToSv
eval OP_HASH160 = tStack1 $
return . bsToSv . getHash160 . hash160 . getHash256 . hash256 . opToSv
eval OP_HASH256 = tStack1 $
return . bsToSv . getHash256 . doubleHash256 . opToSv
eval OP_CODESEPARATOR = dropHashOpsSeparatedCode
eval OP_CHECKSIG = do
pubKey <- popStack
sig <- popStack
checker <- sigCheck <$> get
hOps <- preparedHashOps
pushBool $ checkMultiSig checker [ pubKey ] [ sig ] hOps
eval OP_CHECKMULTISIG =
do nPubKeys <- fromIntegral <$> popInt
when (nPubKeys < 0 || nPubKeys > maxKeysMultisig)
$ programError $ "nPubKeys outside range: " ++ show nPubKeys
pubKeys <- popStackN $ toInteger nPubKeys
nSigs <- fromIntegral <$> popInt
when (nSigs < 0 || nSigs > nPubKeys)
$ programError $ "nSigs outside range: " ++ show nSigs
sigs <- popStackN $ toInteger nSigs
nullDummyEnforcer
void popStack
checker <- sigCheck <$> get
hOps <- preparedHashOps
pushBool $ checkMultiSig checker pubKeys sigs hOps
modify $ \p -> p { opCount = opCount p + length pubKeys }
eval OP_CHECKSIGVERIFY = eval OP_CHECKSIG >> eval OP_VERIFY
eval OP_CHECKMULTISIGVERIFY = eval OP_CHECKMULTISIG >> eval OP_VERIFY
eval op = case constValue op of
Just sv -> minimalPushEnforcer op >> pushStack sv
Nothing -> programError $ "unexpected op " ++ show op
minimalPushEnforcer :: ScriptOp -> StackOperation ()
minimalPushEnforcer op = do
flgs <- ask
if not $ MINIMALDATA `elem` flgs
then return ()
else case checkMinimalPush op of
True -> return ()
False -> programError $ "Non-minimal data: " ++ (show op)
checkMinimalPush :: ScriptOp -> Bool
checkMinimalPush ( OP_PUSHDATA payload optype ) =
let l = BS.length payload
v = ( BS.unpack payload ) !! 0 in
if
(BS.null payload)
|| (l == 1 && v <= 16 && v >= 1)
|| (l == 1 && v == 0x81)
|| (l <= 75 && optype /= OPCODE)
|| (l <= 255 && l > 75 && optype /= OPDATA1)
|| (l > 255 && l <= 65535 && optype /= OPDATA2)
then False else True
checkMinimalPush _ = True
minimalStackValEnforcer :: StackOperation ()
minimalStackValEnforcer = do
flgs <- ask
s <- getStack
let topStack = if null s then [] else head s
if not $ MINIMALDATA `elem` flgs || null topStack
then return ()
else case checkMinimalNumRep topStack of
True -> return ()
False -> programError $ "Non-minimal stack value: " ++ (show topStack)
checkMinimalNumRep :: StackValue -> Bool
checkMinimalNumRep [] = True
checkMinimalNumRep s =
let msb = last s
l = length s in
if
( msb .&. 0x7f == 0 )
&& ( l <= 1 || ( s !! (l2) ) .&. 0x80 == 0 )
then False
else True
nullDummyEnforcer :: StackOperation ()
nullDummyEnforcer = do
flgs <- ask
topStack <- ( getStack >>= headOrError )
if ( NULLDUMMY `elem` flgs ) && ( not . null $ topStack )
then programError $ "Non-null dummy stack in multi-sig"
else return ()
where
headOrError s = if null s
then programError "Empty stack where dummy op should be."
else return ( head s )
getExec :: Program Bool
getExec = and <$> getCond
conditionalEval :: ScriptOp -> Program ()
conditionalEval scrpOp = do
lift $ checkPushData scrpOp
e <- getExec
eval' e scrpOp
when (countOp scrpOp) $ lift $ join $ incrementOpCount <$> opCount <$> get
lift checkStackSize
where
eval' :: Bool -> ScriptOp -> Program ()
eval' True OP_IF = lift popStack >>= pushCond . decodeBool
eval' True OP_NOTIF = lift popStack >>= pushCond . not . decodeBool
eval' True OP_ELSE = flipCond
eval' True OP_ENDIF = void popCond
eval' True op = lift $ eval op
eval' False OP_IF = pushCond False
eval' False OP_NOTIF = pushCond False
eval' False OP_ELSE = flipCond
eval' False OP_ENDIF = void popCond
eval' False OP_CODESEPARATOR = lift $ eval OP_CODESEPARATOR
eval' False OP_VER = return ()
eval' False op | isDisabled op = lift $ disabled op
| otherwise = return ()
evalOps :: [ ScriptOp ] -> Program ()
evalOps ops = do mapM_ conditionalEval ops
cond <- getCond
unless (null cond) (lift $ programError "ifStack not empty")
checkPushOnly :: [ ScriptOp ] -> Program ()
checkPushOnly ops
| not (all checkPushOp ops) = lift $ programError "only push ops allowed"
| otherwise = return ()
where checkPushOp op = case constValue op of
Just _ -> True
Nothing -> False
checkStack :: Stack -> Bool
checkStack (x:_) = decodeBool x
checkStack [] = False
isPayToScriptHash :: [ ScriptOp ] -> [ Flag ] -> Bool
isPayToScriptHash [OP_HASH160, OP_PUSHDATA bytes OPCODE, OP_EQUAL] flgs
= ( P2SH `elem` flgs ) && ( BS.length bytes == 20 )
isPayToScriptHash _ _ = False
stackToScriptOps :: StackValue -> [ ScriptOp ]
stackToScriptOps sv = let script = decodeOrFail $ BSL.pack sv in
case script of
Left _ -> []
Right (_,_,s) -> scriptOps s
execScript :: Script
-> Script
-> SigCheck
-> [ Flag ]
-> Either EvalError ProgramData
execScript scriptSig scriptPubKey sigCheckFcn flags =
let sigOps = scriptOps scriptSig
pubKeyOps = scriptOps scriptPubKey
initData = ProgramData {
stack = [],
altStack = [],
hashOps = pubKeyOps,
sigCheck = sigCheckFcn,
opCount = 0
}
checkSig | isPayToScriptHash pubKeyOps flags = checkPushOnly sigOps
| SIGPUSHONLY `elem` flags = checkPushOnly sigOps
| otherwise = return ()
checkKey | BSL.length (encode scriptPubKey) > fromIntegral maxScriptSize
= lift $ programError "pubKey > maxScriptSize"
| otherwise = return ()
redeemEval = checkSig >> evalOps sigOps >> lift (stack <$> get)
pubKeyEval = checkKey >> evalOps pubKeyOps >> lift get
in do s <- evalProgram redeemEval [] initData flags
p <- evalProgram pubKeyEval [] initData { stack = s } flags
if ( not . null $ s )
&& ( isPayToScriptHash pubKeyOps flags )
&& ( checkStack . runStack $ p )
then evalProgram (evalP2SH s) [] initData { stack = drop 1 s,
hashOps = stackToScriptOps $ head s } flags
else return p
evalP2SH :: Stack -> Program ProgramData
evalP2SH [] = lift $ programError "PayToScriptHash: no script on stack"
evalP2SH (sv:_) = evalOps (stackToScriptOps sv) >> lift get
evalScript :: Script -> Script -> SigCheck -> [ Flag ] -> Bool
evalScript scriptSig scriptPubKey sigCheckFcn flags =
case execScript scriptSig scriptPubKey sigCheckFcn flags of
Left _ -> False
Right p -> checkStack . runStack $ p
runStack :: ProgramData -> Stack
runStack = stack
verifySigWithType :: Tx -> Int -> [ ScriptOp ] -> TxSignature -> PubKey -> Bool
verifySigWithType tx i outOps txSig pubKey =
let outScript = Script outOps
h = txSigHash tx outScript i ( sigHashType txSig ) in
verifySig h ( txSignature txSig ) pubKey
verifySpend :: Tx
-> Int
-> Script
-> [ Flag ]
-> Bool
verifySpend tx i outscript flags =
let scriptSig = decode' . scriptInput $ txIn tx !! i
verifyFcn = verifySigWithType tx i
in
evalScript scriptSig outscript verifyFcn flags