haskoin-core-1.2.2: src/Haskoin/Script/Common.hs
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}
-- |
-- Module : Haskoin.Script.Common
-- Copyright : No rights reserved
-- License : MIT
-- Maintainer : jprupp@protonmail.ch
-- Stability : experimental
-- Portability : POSIX
--
-- Common script-related functions and data types.
module Haskoin.Script.Common
( -- * Scripts
ScriptOp (..),
Script (..),
PushDataType (..),
isPushOp,
opPushData,
intToScriptOp,
scriptOpToInt,
)
where
import Control.DeepSeq
import Control.Monad
import Data.Aeson
import Data.Aeson.Encoding
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Builder (char7)
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Either (fromRight)
import Data.Hashable
import Data.Serialize (Serialize (..))
import Data.Word (Word8)
import GHC.Generics (Generic)
import Haskoin.Util (hexBuilder)
import Haskoin.Util.Helpers (decodeHex, encodeHex, hexEncoding)
-- | Data type representing a transaction script. Scripts are defined as lists
-- of script operators 'ScriptOp'. Scripts are used to:
--
-- * Define the spending conditions in the output of a transaction.
-- * Provide signatures in the input of a transaction (except SegWit).
--
-- SigWit only: the segregated witness data structure, and not the input script,
-- contains signatures and redeem script for pay-to-witness-script and
-- pay-to-witness-public-key-hash transactions.
newtype Script = Script
{ -- | script operators defining this script
ops :: [ScriptOp]
}
deriving (Eq, Show, Read, Generic)
deriving newtype (Hashable, NFData)
instance FromJSON Script where
parseJSON = withText "script" $ \t -> do
bs <- maybe mzero return (decodeHex t)
either fail return (runGetS deserialize bs)
instance ToJSON Script where
toJSON = String . encodeHex . runPutS . serialize
toEncoding = hexEncoding . runPutL . serialize
instance Serial Script where
deserialize =
Script <$> getScriptOps
where
getScriptOps = do
empty <- isEmpty
if empty
then return []
else (:) <$> deserialize <*> getScriptOps
serialize (Script ops) = forM_ ops serialize
instance Binary Script where
put = serialize
get = deserialize
instance Serialize Script where
put = serialize
get = deserialize
-- | Data type representing the type of an OP_PUSHDATA opcode.
data PushDataType
= -- | next opcode bytes is data to be pushed
OPCODE
| -- | next byte contains number of bytes of data to be pushed
OPDATA1
| -- | next two bytes contains number of bytes to be pushed
OPDATA2
| -- | next four bytes contains the number of bytes to be pushed
OPDATA4
deriving (Show, Read, Eq, Generic, Hashable, NFData)
-- | Data type representing an operator allowed inside a 'Script'.
data ScriptOp
= -- Pushing Data
OP_PUSHDATA
!ByteString
!PushDataType
| OP_0
| OP_1NEGATE
| OP_RESERVED
| OP_1
| OP_2
| OP_3
| OP_4
| OP_5
| OP_6
| OP_7
| OP_8
| OP_9
| OP_10
| OP_11
| OP_12
| OP_13
| OP_14
| OP_15
| OP_16
| -- Flow control
OP_NOP
| OP_VER -- reserved
| OP_IF
| OP_NOTIF
| OP_VERIF -- resreved
| OP_VERNOTIF -- reserved
| OP_ELSE
| OP_ENDIF
| OP_VERIFY
| OP_RETURN
| -- Stack operations
OP_TOALTSTACK
| OP_FROMALTSTACK
| OP_IFDUP
| OP_DEPTH
| OP_DROP
| OP_DUP
| OP_NIP
| OP_OVER
| OP_PICK
| OP_ROLL
| OP_ROT
| OP_SWAP
| OP_TUCK
| OP_2DROP
| OP_2DUP
| OP_3DUP
| OP_2OVER
| OP_2ROT
| OP_2SWAP
| -- Splice
OP_CAT
| OP_SUBSTR
| OP_LEFT
| OP_RIGHT
| OP_SIZE
| -- Bitwise logic
OP_INVERT
| OP_AND
| OP_OR
| OP_XOR
| OP_EQUAL
| OP_EQUALVERIFY
| OP_RESERVED1
| OP_RESERVED2
| -- Arithmetic
OP_1ADD
| OP_1SUB
| OP_2MUL
| OP_2DIV
| OP_NEGATE
| OP_ABS
| OP_NOT
| OP_0NOTEQUAL
| OP_ADD
| OP_SUB
| OP_MUL
| OP_DIV
| OP_MOD
| OP_LSHIFT
| OP_RSHIFT
| OP_BOOLAND
| OP_BOOLOR
| OP_NUMEQUAL
| OP_NUMEQUALVERIFY
| OP_NUMNOTEQUAL
| OP_LESSTHAN
| OP_GREATERTHAN
| OP_LESSTHANOREQUAL
| OP_GREATERTHANOREQUAL
| OP_MIN
| OP_MAX
| OP_WITHIN
| -- Crypto
OP_RIPEMD160
| OP_SHA1
| OP_SHA256
| OP_HASH160
| OP_HASH256
| OP_CODESEPARATOR
| OP_CHECKSIG
| OP_CHECKSIGVERIFY
| OP_CHECKMULTISIG
| OP_CHECKMULTISIGVERIFY
| -- Expansion
OP_NOP1
| OP_CHECKLOCKTIMEVERIFY
| OP_CHECKSEQUENCEVERIFY
| OP_NOP4
| OP_NOP5
| OP_NOP6
| OP_NOP7
| OP_NOP8
| OP_NOP9
| OP_NOP10
| -- Bitcoin Cash Nov 2018 hard fork
OP_CHECKDATASIG
| OP_CHECKDATASIGVERIFY
| -- Bitcoin Cash May 2020 hard fork
OP_REVERSEBYTES
| -- Other
OP_PUBKEYHASH
| OP_PUBKEY
| OP_INVALIDOPCODE !Word8
deriving (Show, Read, Eq, Generic, Hashable, NFData)
instance Serial ScriptOp where
deserialize = go . fromIntegral =<< getWord8
where
go op
| op == 0x00 = return OP_0
| op <= 0x4b = do
payload <- getByteString (fromIntegral op)
return $ OP_PUSHDATA payload OPCODE
| op == 0x4c = do
len <- getWord8
payload <- getByteString (fromIntegral len)
return $ OP_PUSHDATA payload OPDATA1
| op == 0x4d = do
len <- getWord16le
payload <- getByteString (fromIntegral len)
return $ OP_PUSHDATA payload OPDATA2
| op == 0x4e = do
len <- getWord32le
payload <- getByteString (fromIntegral len)
return $ OP_PUSHDATA payload OPDATA4
| op == 0x4f = return OP_1NEGATE
| op == 0x50 = return OP_RESERVED
| op == 0x51 = return OP_1
| op == 0x52 = return OP_2
| op == 0x53 = return OP_3
| op == 0x54 = return OP_4
| op == 0x55 = return OP_5
| op == 0x56 = return OP_6
| op == 0x57 = return OP_7
| op == 0x58 = return OP_8
| op == 0x59 = return OP_9
| op == 0x5a = return OP_10
| op == 0x5b = return OP_11
| op == 0x5c = return OP_12
| op == 0x5d = return OP_13
| op == 0x5e = return OP_14
| op == 0x5f = return OP_15
| op == 0x60 = return OP_16
-- Flow control
| op == 0x61 = return OP_NOP
| op == 0x62 = return OP_VER -- reserved
| op == 0x63 = return OP_IF
| op == 0x64 = return OP_NOTIF
| op == 0x65 = return OP_VERIF -- reserved
| op == 0x66 = return OP_VERNOTIF -- reserved
| op == 0x67 = return OP_ELSE
| op == 0x68 = return OP_ENDIF
| op == 0x69 = return OP_VERIFY
| op == 0x6a = return OP_RETURN
-- Stack
| op == 0x6b = return OP_TOALTSTACK
| op == 0x6c = return OP_FROMALTSTACK
| op == 0x6d = return OP_2DROP
| op == 0x6e = return OP_2DUP
| op == 0x6f = return OP_3DUP
| op == 0x70 = return OP_2OVER
| op == 0x71 = return OP_2ROT
| op == 0x72 = return OP_2SWAP
| op == 0x73 = return OP_IFDUP
| op == 0x74 = return OP_DEPTH
| op == 0x75 = return OP_DROP
| op == 0x76 = return OP_DUP
| op == 0x77 = return OP_NIP
| op == 0x78 = return OP_OVER
| op == 0x79 = return OP_PICK
| op == 0x7a = return OP_ROLL
| op == 0x7b = return OP_ROT
| op == 0x7c = return OP_SWAP
| op == 0x7d = return OP_TUCK
-- Splice
| op == 0x7e = return OP_CAT
| op == 0x7f = return OP_SUBSTR
| op == 0x80 = return OP_LEFT
| op == 0x81 = return OP_RIGHT
| op == 0x82 = return OP_SIZE
-- Bitwise logic
| op == 0x83 = return OP_INVERT
| op == 0x84 = return OP_AND
| op == 0x85 = return OP_OR
| op == 0x86 = return OP_XOR
| op == 0x87 = return OP_EQUAL
| op == 0x88 = return OP_EQUALVERIFY
| op == 0x89 = return OP_RESERVED1
| op == 0x8a = return OP_RESERVED2
-- Arithmetic
| op == 0x8b = return OP_1ADD
| op == 0x8c = return OP_1SUB
| op == 0x8d = return OP_2MUL
| op == 0x8e = return OP_2DIV
| op == 0x8f = return OP_NEGATE
| op == 0x90 = return OP_ABS
| op == 0x91 = return OP_NOT
| op == 0x92 = return OP_0NOTEQUAL
| op == 0x93 = return OP_ADD
| op == 0x94 = return OP_SUB
| op == 0x95 = return OP_MUL
| op == 0x96 = return OP_DIV
| op == 0x97 = return OP_MOD
| op == 0x98 = return OP_LSHIFT
| op == 0x99 = return OP_RSHIFT
| op == 0x9a = return OP_BOOLAND
| op == 0x9b = return OP_BOOLOR
| op == 0x9c = return OP_NUMEQUAL
| op == 0x9d = return OP_NUMEQUALVERIFY
| op == 0x9e = return OP_NUMNOTEQUAL
| op == 0x9f = return OP_LESSTHAN
| op == 0xa0 = return OP_GREATERTHAN
| op == 0xa1 = return OP_LESSTHANOREQUAL
| op == 0xa2 = return OP_GREATERTHANOREQUAL
| op == 0xa3 = return OP_MIN
| op == 0xa4 = return OP_MAX
| op == 0xa5 = return OP_WITHIN
-- Crypto
| op == 0xa6 = return OP_RIPEMD160
| op == 0xa7 = return OP_SHA1
| op == 0xa8 = return OP_SHA256
| op == 0xa9 = return OP_HASH160
| op == 0xaa = return OP_HASH256
| op == 0xab = return OP_CODESEPARATOR
| op == 0xac = return OP_CHECKSIG
| op == 0xad = return OP_CHECKSIGVERIFY
| op == 0xae = return OP_CHECKMULTISIG
| op == 0xaf = return OP_CHECKMULTISIGVERIFY
-- More NOPs
| op == 0xb0 = return OP_NOP1
| op == 0xb1 = return OP_CHECKLOCKTIMEVERIFY
| op == 0xb2 = return OP_CHECKSEQUENCEVERIFY
| op == 0xb3 = return OP_NOP4
| op == 0xb4 = return OP_NOP5
| op == 0xb5 = return OP_NOP6
| op == 0xb6 = return OP_NOP7
| op == 0xb7 = return OP_NOP8
| op == 0xb8 = return OP_NOP9
| op == 0xb9 = return OP_NOP10
-- Bitcoin Cash Nov 2018 hard fork
| op == 0xba = return OP_CHECKDATASIG
| op == 0xbb = return OP_CHECKDATASIGVERIFY
-- Bitcoin Cash May 2020 hard fork
| op == 0xbc = return OP_REVERSEBYTES
-- Constants
| op == 0xfd = return OP_PUBKEYHASH
| op == 0xfe = return OP_PUBKEY
| otherwise = return $ OP_INVALIDOPCODE op
serialize op = case op of
(OP_PUSHDATA payload optype) -> do
let len = B.length payload
case optype of
OPCODE -> do
unless (len <= 0x4b) $
error "OP_PUSHDATA OPCODE: Payload size too big"
putWord8 $ fromIntegral len
OPDATA1 -> do
unless (len <= 0xff) $
error "OP_PUSHDATA OPDATA1: Payload size too big"
putWord8 0x4c
putWord8 $ fromIntegral len
OPDATA2 -> do
unless (len <= 0xffff) $
error "OP_PUSHDATA OPDATA2: Payload size too big"
putWord8 0x4d
putWord16le $ fromIntegral len
OPDATA4 -> do
unless (len <= 0x7fffffff) $
error "OP_PUSHDATA OPDATA4: Payload size too big"
putWord8 0x4e
putWord32le $ fromIntegral len
putByteString payload
-- Constants
OP_0 -> putWord8 0x00
OP_1NEGATE -> putWord8 0x4f
OP_RESERVED -> putWord8 0x50
OP_1 -> putWord8 0x51
OP_2 -> putWord8 0x52
OP_3 -> putWord8 0x53
OP_4 -> putWord8 0x54
OP_5 -> putWord8 0x55
OP_6 -> putWord8 0x56
OP_7 -> putWord8 0x57
OP_8 -> putWord8 0x58
OP_9 -> putWord8 0x59
OP_10 -> putWord8 0x5a
OP_11 -> putWord8 0x5b
OP_12 -> putWord8 0x5c
OP_13 -> putWord8 0x5d
OP_14 -> putWord8 0x5e
OP_15 -> putWord8 0x5f
OP_16 -> putWord8 0x60
-- Crypto Constants
OP_PUBKEY -> putWord8 0xfe
OP_PUBKEYHASH -> putWord8 0xfd
-- Invalid Opcodes
(OP_INVALIDOPCODE x) -> putWord8 x
-- Flow Control
OP_NOP -> putWord8 0x61
OP_VER -> putWord8 0x62
OP_IF -> putWord8 0x63
OP_NOTIF -> putWord8 0x64
OP_VERIF -> putWord8 0x65
OP_VERNOTIF -> putWord8 0x66
OP_ELSE -> putWord8 0x67
OP_ENDIF -> putWord8 0x68
OP_VERIFY -> putWord8 0x69
OP_RETURN -> putWord8 0x6a
-- Stack Operations
OP_TOALTSTACK -> putWord8 0x6b
OP_FROMALTSTACK -> putWord8 0x6c
OP_2DROP -> putWord8 0x6d
OP_2DUP -> putWord8 0x6e
OP_3DUP -> putWord8 0x6f
OP_2OVER -> putWord8 0x70
OP_2ROT -> putWord8 0x71
OP_2SWAP -> putWord8 0x72
OP_IFDUP -> putWord8 0x73
OP_DEPTH -> putWord8 0x74
OP_DROP -> putWord8 0x75
OP_DUP -> putWord8 0x76
OP_NIP -> putWord8 0x77
OP_OVER -> putWord8 0x78
OP_PICK -> putWord8 0x79
OP_ROLL -> putWord8 0x7a
OP_ROT -> putWord8 0x7b
OP_SWAP -> putWord8 0x7c
OP_TUCK -> putWord8 0x7d
-- Splice
OP_CAT -> putWord8 0x7e
OP_SUBSTR -> putWord8 0x7f
OP_LEFT -> putWord8 0x80
OP_RIGHT -> putWord8 0x81
OP_SIZE -> putWord8 0x82
-- Bitwise Logic
OP_INVERT -> putWord8 0x83
OP_AND -> putWord8 0x84
OP_OR -> putWord8 0x85
OP_XOR -> putWord8 0x86
OP_EQUAL -> putWord8 0x87
OP_EQUALVERIFY -> putWord8 0x88
OP_RESERVED1 -> putWord8 0x89
OP_RESERVED2 -> putWord8 0x8a
-- Arithmetic
OP_1ADD -> putWord8 0x8b
OP_1SUB -> putWord8 0x8c
OP_2MUL -> putWord8 0x8d
OP_2DIV -> putWord8 0x8e
OP_NEGATE -> putWord8 0x8f
OP_ABS -> putWord8 0x90
OP_NOT -> putWord8 0x91
OP_0NOTEQUAL -> putWord8 0x92
OP_ADD -> putWord8 0x93
OP_SUB -> putWord8 0x94
OP_MUL -> putWord8 0x95
OP_DIV -> putWord8 0x96
OP_MOD -> putWord8 0x97
OP_LSHIFT -> putWord8 0x98
OP_RSHIFT -> putWord8 0x99
OP_BOOLAND -> putWord8 0x9a
OP_BOOLOR -> putWord8 0x9b
OP_NUMEQUAL -> putWord8 0x9c
OP_NUMEQUALVERIFY -> putWord8 0x9d
OP_NUMNOTEQUAL -> putWord8 0x9e
OP_LESSTHAN -> putWord8 0x9f
OP_GREATERTHAN -> putWord8 0xa0
OP_LESSTHANOREQUAL -> putWord8 0xa1
OP_GREATERTHANOREQUAL -> putWord8 0xa2
OP_MIN -> putWord8 0xa3
OP_MAX -> putWord8 0xa4
OP_WITHIN -> putWord8 0xa5
-- Crypto
OP_RIPEMD160 -> putWord8 0xa6
OP_SHA1 -> putWord8 0xa7
OP_SHA256 -> putWord8 0xa8
OP_HASH160 -> putWord8 0xa9
OP_HASH256 -> putWord8 0xaa
OP_CODESEPARATOR -> putWord8 0xab
OP_CHECKSIG -> putWord8 0xac
OP_CHECKSIGVERIFY -> putWord8 0xad
OP_CHECKMULTISIG -> putWord8 0xae
OP_CHECKMULTISIGVERIFY -> putWord8 0xaf
-- More NOPs
OP_NOP1 -> putWord8 0xb0
OP_CHECKLOCKTIMEVERIFY -> putWord8 0xb1
OP_CHECKSEQUENCEVERIFY -> putWord8 0xb2
OP_NOP4 -> putWord8 0xb3
OP_NOP5 -> putWord8 0xb4
OP_NOP6 -> putWord8 0xb5
OP_NOP7 -> putWord8 0xb6
OP_NOP8 -> putWord8 0xb7
OP_NOP9 -> putWord8 0xb8
OP_NOP10 -> putWord8 0xb9
-- Bitcoin Cash Nov 2018 hard fork
OP_CHECKDATASIG -> putWord8 0xba
OP_CHECKDATASIGVERIFY -> putWord8 0xbb
-- Bitcoin Cash May 2020 hard fork
OP_REVERSEBYTES -> putWord8 0xbc
instance Binary ScriptOp where
put = serialize
get = deserialize
instance Serialize ScriptOp where
put = serialize
get = deserialize
-- | Check whether opcode is only data.
isPushOp :: ScriptOp -> Bool
isPushOp op = case op of
OP_PUSHDATA _ _ -> True
OP_0 -> True
OP_1NEGATE -> True
OP_1 -> True
OP_2 -> True
OP_3 -> True
OP_4 -> True
OP_5 -> True
OP_6 -> True
OP_7 -> True
OP_8 -> True
OP_9 -> True
OP_10 -> True
OP_11 -> True
OP_12 -> True
OP_13 -> True
OP_14 -> True
OP_15 -> True
OP_16 -> True
_ -> False
-- | Optimally encode data using one of the 4 types of data pushing opcodes.
opPushData :: ByteString -> ScriptOp
opPushData bs
| len <= 0x4b = OP_PUSHDATA bs OPCODE
| len <= 0xff = OP_PUSHDATA bs OPDATA1
| len <= 0xffff = OP_PUSHDATA bs OPDATA2
| len <= 0xffffffff = OP_PUSHDATA bs OPDATA4
| otherwise = error "opPushData: payload size too big"
where
len = B.length bs
-- | Transforms integers @[1 .. 16]@ to 'ScriptOp' @[OP_1 .. OP_16]@.
intToScriptOp :: Int -> ScriptOp
intToScriptOp i
| i `elem` [1 .. 16] = op
| otherwise = err
where
op =
fromRight err
. runGetS deserialize
. B.singleton
. fromIntegral
$ i + 0x50
err = error $ "intToScriptOp: Invalid integer " ++ show i
-- | Decode 'ScriptOp' @[OP_1 .. OP_16]@ to integers @[1 .. 16]@. This functions
-- fails for other values of 'ScriptOp'
scriptOpToInt :: ScriptOp -> Either String Int
scriptOpToInt s
| res `elem` [1 .. 16] = return res
| otherwise = Left $ "scriptOpToInt: invalid opcode " ++ show s
where
res = fromIntegral (B.head $ runPutS $ serialize s) - 0x50