{-# 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