{-# LANGUAGE OverloadedStrings #-}
module Network.Haskoin.Script.Common
( ScriptOp(..)
, Script(..)
, PushDataType(..)
, ScriptOutput(..)
, isPayPK
, isPayPKHash
, isPayMulSig
, isPayScriptHash
, isPayWitnessPKHash
, isPayWitnessScriptHash
, isDataCarrier
, encodeOutput
, encodeOutputBS
, decodeOutput
, decodeOutputBS
, isPushOp
, opPushData
, intToScriptOp
, scriptOpToInt
) where
import Control.DeepSeq (NFData, rnf)
import Control.Monad
import Data.Aeson as A
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Serialize as S
import Data.Serialize.Get (getByteString, getWord16le,
getWord32le, getWord8,
isEmpty)
import Data.Serialize.Put (putByteString, putWord16le,
putWord32le, putWord8)
import Data.Word (Word8)
import Network.Haskoin.Crypto.Hash
import Network.Haskoin.Keys.Common
import Network.Haskoin.Util
newtype Script =
Script {
scriptOps :: [ScriptOp]
}
deriving (Eq, Show, Read)
instance NFData Script where
rnf (Script o) = rnf o
instance Serialize Script where
get =
Script <$> getScriptOps
where
getScriptOps = do
empty <- isEmpty
if empty
then return []
else (:) <$> get <*> getScriptOps
put (Script ops) = forM_ ops put
data PushDataType
=
OPCODE
| OPDATA1
| OPDATA2
| OPDATA4
deriving (Show, Read, Eq)
instance NFData PushDataType where rnf x = seq x ()
data ScriptOp
= 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
| OP_NOP
| OP_VER
| OP_IF
| OP_NOTIF
| OP_VERIF
| OP_VERNOTIF
| OP_ELSE
| OP_ENDIF
| OP_VERIFY
| OP_RETURN
| 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
| OP_CAT
| OP_SUBSTR
| OP_LEFT
| OP_RIGHT
| OP_SIZE
| OP_INVERT
| OP_AND
| OP_OR
| OP_XOR
| OP_EQUAL
| OP_EQUALVERIFY
| OP_RESERVED1
| OP_RESERVED2
| 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
| OP_RIPEMD160
| OP_SHA1
| OP_SHA256
| OP_HASH160
| OP_HASH256
| OP_CODESEPARATOR
| OP_CHECKSIG
| OP_CHECKSIGVERIFY
| OP_CHECKMULTISIG
| OP_CHECKMULTISIGVERIFY
| OP_NOP1 | OP_NOP2 | OP_NOP3 | OP_NOP4 | OP_NOP5
| OP_NOP6 | OP_NOP7 | OP_NOP8 | OP_NOP9 | OP_NOP10
| OP_PUBKEYHASH
| OP_PUBKEY
| OP_INVALIDOPCODE !Word8
deriving (Show, Read, Eq)
instance NFData ScriptOp where
rnf (OP_PUSHDATA b t) = rnf b `seq` rnf t
rnf (OP_INVALIDOPCODE c) = rnf c
rnf x = x `seq` ()
instance Serialize ScriptOp where
get = 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
| op == 0x61 = return OP_NOP
| op == 0x62 = return OP_VER
| op == 0x63 = return OP_IF
| op == 0x64 = return OP_NOTIF
| op == 0x65 = return OP_VERIF
| op == 0x66 = return OP_VERNOTIF
| op == 0x67 = return OP_ELSE
| op == 0x68 = return OP_ENDIF
| op == 0x69 = return OP_VERIFY
| op == 0x6a = return OP_RETURN
| 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
| 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
| 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
| 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
| 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
| op == 0xb0 = return OP_NOP1
| op == 0xb1 = return OP_NOP2
| op == 0xb2 = return OP_NOP3
| 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
| op == 0xfd = return OP_PUBKEYHASH
| op == 0xfe = return OP_PUBKEY
| otherwise = return $ OP_INVALIDOPCODE op
put op = case op of
(OP_PUSHDATA payload optype)-> do
let len = B.length payload
case optype of
OPCODE -> do
unless (len <= 0x4b) $ fail
"OP_PUSHDATA OPCODE: Payload size too big"
putWord8 $ fromIntegral len
OPDATA1 -> do
unless (len <= 0xff) $ fail
"OP_PUSHDATA OPDATA1: Payload size too big"
putWord8 0x4c
putWord8 $ fromIntegral len
OPDATA2 -> do
unless (len <= 0xffff) $ fail
"OP_PUSHDATA OPDATA2: Payload size too big"
putWord8 0x4d
putWord16le $ fromIntegral len
OPDATA4 -> do
unless (len <= 0x7fffffff) $ fail
"OP_PUSHDATA OPDATA4: Payload size too big"
putWord8 0x4e
putWord32le $ fromIntegral len
putByteString payload
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
OP_PUBKEY -> putWord8 0xfe
OP_PUBKEYHASH -> putWord8 0xfd
(OP_INVALIDOPCODE x) -> putWord8 x
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
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
OP_CAT -> putWord8 0x7e
OP_SUBSTR -> putWord8 0x7f
OP_LEFT -> putWord8 0x80
OP_RIGHT -> putWord8 0x81
OP_SIZE -> putWord8 0x82
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
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
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
OP_NOP1 -> putWord8 0xb0
OP_NOP2 -> putWord8 0xb1
OP_NOP3 -> 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
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
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
intToScriptOp :: Int -> ScriptOp
intToScriptOp i
| i `elem` [1 .. 16] = op
| otherwise = err
where
op = either (const err) id . S.decode . B.singleton . fromIntegral $ i + 0x50
err = error $ "intToScriptOp: Invalid integer " ++ show i
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 $ S.encode s) - 0x50
data ScriptOutput
= PayPK { getOutputPubKey :: !PubKeyI }
| PayPKHash { getOutputHash :: !Hash160 }
| PayMulSig { getOutputMulSigKeys :: ![PubKeyI]
, getOutputMulSigRequired :: !Int }
| PayScriptHash { getOutputHash :: !Hash160 }
| PayWitnessPKHash { getOutputHash :: !Hash160 }
| PayWitnessScriptHash { getScriptHash :: !Hash256 }
| DataCarrier { getOutputData :: !ByteString }
deriving (Eq, Show)
instance FromJSON ScriptOutput where
parseJSON = withText "scriptoutput" $ \t -> either fail return $
maybeToEither "scriptoutput not hex" (decodeHex t) >>=
decodeOutputBS
instance ToJSON ScriptOutput where
toJSON = String . encodeHex . encodeOutputBS
instance NFData ScriptOutput where
rnf (PayPK k) = rnf k
rnf (PayPKHash a) = rnf a
rnf (PayMulSig k r) = rnf k `seq` rnf r
rnf (PayScriptHash a) = rnf a
rnf (PayWitnessPKHash a) = rnf a
rnf (PayWitnessScriptHash h) = rnf h
rnf (DataCarrier a) = rnf a
isPayPK :: ScriptOutput -> Bool
isPayPK (PayPK _) = True
isPayPK _ = False
isPayPKHash :: ScriptOutput -> Bool
isPayPKHash (PayPKHash _) = True
isPayPKHash _ = False
isPayMulSig :: ScriptOutput -> Bool
isPayMulSig (PayMulSig _ _) = True
isPayMulSig _ = False
isPayScriptHash :: ScriptOutput -> Bool
isPayScriptHash (PayScriptHash _) = True
isPayScriptHash _ = False
isPayWitnessPKHash :: ScriptOutput -> Bool
isPayWitnessPKHash (PayWitnessPKHash _) = True
isPayWitnessPKHash _ = False
isPayWitnessScriptHash :: ScriptOutput -> Bool
isPayWitnessScriptHash (PayWitnessScriptHash _) = True
isPayWitnessScriptHash _ = False
isDataCarrier :: ScriptOutput -> Bool
isDataCarrier (DataCarrier _) = True
isDataCarrier _ = False
decodeOutput :: Script -> Either String ScriptOutput
decodeOutput s = case scriptOps s of
[OP_PUSHDATA bs _, OP_CHECKSIG] -> PayPK <$> S.decode bs
[OP_DUP, OP_HASH160, OP_PUSHDATA bs _, OP_EQUALVERIFY, OP_CHECKSIG] ->
PayPKHash <$> S.decode bs
[OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] ->
PayScriptHash <$> S.decode bs
[OP_0, OP_PUSHDATA bs OPCODE]
| B.length bs == 20 -> PayWitnessPKHash <$> S.decode bs
| B.length bs == 32 -> PayWitnessScriptHash <$> S.decode bs
[OP_RETURN, OP_PUSHDATA bs _] -> Right $ DataCarrier bs
_ -> matchPayMulSig s
decodeOutputBS :: ByteString -> Either String ScriptOutput
decodeOutputBS = decodeOutput <=< S.decode
encodeOutput :: ScriptOutput -> Script
encodeOutput s = Script $ case s of
(PayPK k) -> [opPushData $ S.encode k, OP_CHECKSIG]
(PayPKHash h) ->
[ OP_DUP, OP_HASH160, opPushData $ S.encode h, OP_EQUALVERIFY, OP_CHECKSIG]
(PayMulSig ps r)
| r <= length ps ->
let opM = intToScriptOp r
opN = intToScriptOp $ length ps
keys = map (opPushData . S.encode) ps
in opM : keys ++ [opN, OP_CHECKMULTISIG]
| otherwise -> error "encodeOutput: PayMulSig r must be <= than pkeys"
(PayScriptHash h) ->
[ OP_HASH160, opPushData $ S.encode h, OP_EQUAL]
(PayWitnessPKHash h) ->
[ OP_0, opPushData $ S.encode h ]
(PayWitnessScriptHash h) ->
[ OP_0, opPushData $ S.encode h ]
(DataCarrier d) -> [OP_RETURN, opPushData d]
encodeOutputBS :: ScriptOutput -> ByteString
encodeOutputBS = S.encode . encodeOutput
matchPayMulSig :: Script -> Either String ScriptOutput
matchPayMulSig (Script ops) = case splitAt (length ops - 2) ops of
(m:xs,[n,OP_CHECKMULTISIG]) -> do
(intM,intN) <- liftM2 (,) (scriptOpToInt m) (scriptOpToInt n)
if intM <= intN && length xs == intN
then liftM2 PayMulSig (go xs) (return intM)
else Left "matchPayMulSig: Invalid M or N parameters"
_ -> Left "matchPayMulSig: script did not match output template"
where
go (OP_PUSHDATA bs _:xs) = liftM2 (:) (S.decode bs) (go xs)
go [] = return []
go _ = Left "matchPayMulSig: invalid multisig opcode"