{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module: Bitcoin.Prim.Script
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Representations for [Script](https://en.bitcoin.it/wiki/Script),
-- including abstract syntax, 'BA.ByteArray', and base16-encoded
-- 'BS.ByteString' versions, as well as fast conversion utilities for
-- working with them.

module Bitcoin.Prim.Script (
    -- * Script and Script Terms
    Script(..)
  , Term(..)
  , Opcode(..)

    -- * Conversion Utilities
  , to_base16
  , from_base16
  , to_script
  , from_script

    -- for testing etc.
  , ba_to_bs
  , bs_to_ba
  ) where

import Control.Monad (guard)
import qualified Data.Bits as B
import Data.Bits ((.&.), (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import qualified Data.Char as C
import qualified Data.Primitive.ByteArray as BA
import Data.Word (Word8, Word16, Word32)
import GHC.ForeignPtr
import System.IO.Unsafe

-- utilities ------------------------------------------------------------------

fi :: (Num a, Integral b) => b -> a
fi :: forall a b. (Num a, Integral b) => b -> a
fi = b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE fi #-}

-- convert a pinned ByteArray to a ByteString
ba_to_bs :: BA.ByteArray -> BS.ByteString
ba_to_bs :: ByteArray -> ByteString
ba_to_bs ByteArray
ba = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteArray -> Bool
BA.isByteArrayPinned ByteArray
ba)
  let l :: Int
l = ByteArray -> Int
BA.sizeofByteArray ByteArray
ba
  ForeignPtr Word8
buf <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
l
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
    Ptr Word8 -> ByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> ByteArray -> Int -> Int -> m ()
BA.copyByteArrayToAddr Ptr Word8
p ByteArray
ba Int
0 Int
l
  ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> ByteString
BI.BS ForeignPtr Word8
buf Int
l)
{-# NOINLINE ba_to_bs #-}

-- convert a ByteString to a pinned ByteArray
bs_to_ba :: BS.ByteString -> BA.ByteArray
bs_to_ba :: ByteString -> ByteArray
bs_to_ba (BI.PS ForeignPtr Word8
bp Int
_ Int
l) = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray RealWorld
buf <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newPinnedByteArray Int
l
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
    MutableByteArray (PrimState IO) -> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> Ptr a -> Int -> m ()
BA.copyPtrToMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
buf Int
0 Ptr Word8
p Int
l
  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
buf
{-# NOINLINE bs_to_ba #-}

-- split a word8 into a pair of its high and low bits
-- only used for show instances
hilo :: Word8 -> (Word8, Word8)
hilo :: Word8 -> (Word8, Word8)
hilo Word8
b =
  let hex_charset :: ByteString
hex_charset = ByteString
"0123456789abcdef"
      hi :: Word8
hi = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
hex_charset (Word8 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word8
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
4)
      lo :: Word8
lo = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
hex_charset (Word8 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word8
b Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b0000_1111)
  in  (Word8
hi, Word8
lo)

-- script and term representation ---------------------------------------------

-- | A Script program, represented as a 'BA.ByteArray'.
--
--   >>> from_base16 "0014b472a266d0bd89c13706a4132ccfb16f7c3b9fcb"
--   Just (Script
--     [ 0x00, 0x14, 0xb4, 0x72, 0xa2, 0x66, 0xd0, 0xbd, 0x89, 0xc1, 0x37
--     , 0x06, 0xa4, 0x13, 0x2c, 0xcf, 0xb1, 0x6f, 0x7c, 0x3b, 0x9f, 0xcb])
newtype Script = Script BA.ByteArray
  deriving (Script -> Script -> Bool
(Script -> Script -> Bool)
-> (Script -> Script -> Bool) -> Eq Script
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Script -> Script -> Bool
== :: Script -> Script -> Bool
$c/= :: Script -> Script -> Bool
/= :: Script -> Script -> Bool
Eq, Int -> Script -> ShowS
[Script] -> ShowS
Script -> String
(Int -> Script -> ShowS)
-> (Script -> String) -> ([Script] -> ShowS) -> Show Script
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Script -> ShowS
showsPrec :: Int -> Script -> ShowS
$cshow :: Script -> String
show :: Script -> String
$cshowList :: [Script] -> ShowS
showList :: [Script] -> ShowS
Show)

-- | Terms of the Script language, each being an 'Opcode' or 'Word8'
--   byte.
--
--   >>> OPCODE OP_RETURN
--   OP_RETURN
--   >>> BYTE 0x00
--   0x00
data Term =
    OPCODE {-# UNPACK #-} !Opcode
  | BYTE   {-# UNPACK #-} !Word8
  deriving Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
/= :: Term -> Term -> Bool
Eq

instance Show Term where
  show :: Term -> String
show (OPCODE Opcode
o) = Opcode -> String
forall a. Show a => a -> String
show Opcode
o
  show (BYTE Word8
w) =
    let (Word8
hi, Word8
lo) = Word8 -> (Word8, Word8)
hilo Word8
w
    in  String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int -> Char
C.chr (Word8 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word8
hi) Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char
C.chr (Word8 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word8
lo) Char -> ShowS
forall a. a -> [a] -> [a]
: [])

-- script conversions ---------------------------------------------------------

-- | Convert a 'Script' to a base16-encoded 'BS.ByteString'.
--
--   >>> let script = to_script [OPCODE OP_1, OPCODE OP_2, OPCODE OP_ADD]
--   >>> to_base16 script
--  "515293"
to_base16 :: Script -> BS.ByteString
to_base16 :: Script -> ByteString
to_base16 (Script ByteArray
ba) = ByteString -> ByteString
B16.encode (ByteArray -> ByteString
ba_to_bs ByteArray
ba)
{-# INLINE to_base16 #-}

-- | Convert a base16-encoded 'BS.ByteString' to a 'Script'.
--
--   >>> from_base16 "515293"
--   Just (Script [0x51, 0x52, 0x93])
from_base16 :: BS.ByteString -> Maybe Script
from_base16 :: ByteString -> Maybe Script
from_base16 ByteString
b16 = do
  ByteString
bs <- ByteString -> Maybe ByteString
B16.decode ByteString
b16
  Script -> Maybe Script
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Script
Script (ByteString -> ByteArray
bs_to_ba ByteString
bs))
{-# INLINE from_base16 #-}

-- | Pack a list of Script terms into a 'Script'.
--
--   >>> to_script [OPCODE OP_1, OPCODE OP_2, OPCODE OP_ADD]
--   Script [0x51, 0x52, 0x93]
to_script :: [Term] -> Script
to_script :: [Term] -> Script
to_script [Term]
terms =
    let !bs :: ByteString
bs = [Word8] -> ByteString
BS.pack ((Term -> Word8) -> [Term] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Word8
term_to_byte [Term]
terms)
    in  ByteArray -> Script
Script (ByteString -> ByteArray
bs_to_ba ByteString
bs)
  where
    term_to_byte :: Term -> Word8
    term_to_byte :: Term -> Word8
term_to_byte = \case
      OPCODE !Opcode
op -> Int -> Word8
forall a b. (Num a, Integral b) => b -> a
fi (Opcode -> Int
forall a. Enum a => a -> Int
fromEnum Opcode
op)
      BYTE !Word8
w8 -> Word8
w8
    {-# INLINE term_to_byte #-}
{-# NOINLINE to_script #-} -- inlining causes GHC to panic during compilation

-- | Unpack a 'Script' into a list of Script terms.
--
--   >>> let Just script = from_base16 "515293"
--   >>> from_script script
--   [OP_1, OP_2, OP_ADD]
from_script :: Script -> [Term]
from_script :: Script -> [Term]
from_script (Script ByteArray
bs) = Int -> [Term]
go Int
0 where
  !l :: Int
l = ByteArray -> Int
BA.sizeofByteArray ByteArray
bs

  read_pay :: Int -> Int -> [Term]
read_pay !Int
cur !Int
end
    | Int
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end = Int -> [Term]
go Int
cur
    | Bool
otherwise  = Word8 -> Term
BYTE (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs Int
cur) Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Int -> Int -> [Term]
read_pay (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end

  go :: Int -> [Term]
go Int
j
    | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l = [Term]
forall a. Monoid a => a
mempty
    | Bool
otherwise =
        let !op :: Opcode
op = Int -> Opcode
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Num a, Integral b) => b -> a
fi (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs Int
j :: Word8)) :: Opcode
        in  case Opcode -> Maybe Int
pushbytes Opcode
op of
              Just !Int
i -> Opcode -> Term
OPCODE Opcode
op Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Int -> Int -> [Term]
read_pay (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
              Maybe Int
Nothing -> Opcode -> Term
OPCODE Opcode
op Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: case Opcode
op of
                Opcode
OP_PUSHDATA1 ->
                  let !len_idx :: Int
len_idx = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      !pay_len :: Word8
pay_len = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs Int
len_idx :: Word8
                  in    Word8 -> Term
BYTE Word8
pay_len
                      Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Int -> Int -> [Term]
read_pay (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word8
pay_len)

                Opcode
OP_PUSHDATA2 ->
                  let !len_idx :: Int
len_idx = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      !w8_0 :: Word8
w8_0 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs Int
len_idx :: Word8
                      !w8_1 :: Word8
w8_1 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Word8
                      !pay_len :: Word16
pay_len = Word8 -> Word16
forall a b. (Num a, Integral b) => b -> a
fi Word8
w8_0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Num a, Integral b) => b -> a
fi Word8
w8_1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
8 :: Word16
                  in    Word8 -> Term
BYTE Word8
w8_0 Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Word8 -> Term
BYTE Word8
w8_1
                      Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Int -> Int -> [Term]
read_pay (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word16 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word16
pay_len)

                Opcode
OP_PUSHDATA4 ->
                  let !len_idx :: Int
len_idx = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      !w8_0 :: Word8
w8_0 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs Int
len_idx :: Word8
                      !w8_1 :: Word8
w8_1 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Word8
                      !w8_2 :: Word8
w8_2 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) :: Word8
                      !w8_3 :: Word8
w8_3 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
BA.indexByteArray ByteArray
bs (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) :: Word8
                      !pay_len :: Word32
pay_len = Word8 -> Word32
forall a b. (Num a, Integral b) => b -> a
fi Word8
w8_0
                             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Num a, Integral b) => b -> a
fi Word8
w8_1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
8
                             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Num a, Integral b) => b -> a
fi Word8
w8_2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
16
                             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Num a, Integral b) => b -> a
fi Word8
w8_3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
24 :: Word32
                  in    Word8 -> Term
BYTE Word8
w8_0 Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Word8 -> Term
BYTE Word8
w8_1 Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Word8 -> Term
BYTE Word8
w8_2 Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Word8 -> Term
BYTE Word8
w8_3
                      Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Int -> Int -> [Term]
read_pay (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
len_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Num a, Integral b) => b -> a
fi Word32
pay_len)

                Opcode
_ -> Int -> [Term]
go (Int -> Int
forall a. Enum a => a -> a
succ Int
j)

-- opcodes and utilities ------------------------------------------------------

-- | Primitive opcodes.
--
--   See, for example [opcodeexplained](https://opcodeexplained.com/opcodes/)
--   for detail on each.
data Opcode =
    OP_PUSHBYTES_0
  | OP_PUSHBYTES_1
  | OP_PUSHBYTES_2
  | OP_PUSHBYTES_3
  | OP_PUSHBYTES_4
  | OP_PUSHBYTES_5
  | OP_PUSHBYTES_6
  | OP_PUSHBYTES_7
  | OP_PUSHBYTES_8
  | OP_PUSHBYTES_9
  | OP_PUSHBYTES_10
  | OP_PUSHBYTES_11
  | OP_PUSHBYTES_12
  | OP_PUSHBYTES_13
  | OP_PUSHBYTES_14
  | OP_PUSHBYTES_15
  | OP_PUSHBYTES_16
  | OP_PUSHBYTES_17
  | OP_PUSHBYTES_18
  | OP_PUSHBYTES_19
  | OP_PUSHBYTES_20
  | OP_PUSHBYTES_21
  | OP_PUSHBYTES_22
  | OP_PUSHBYTES_23
  | OP_PUSHBYTES_24
  | OP_PUSHBYTES_25
  | OP_PUSHBYTES_26
  | OP_PUSHBYTES_27
  | OP_PUSHBYTES_28
  | OP_PUSHBYTES_29
  | OP_PUSHBYTES_30
  | OP_PUSHBYTES_31
  | OP_PUSHBYTES_32
  | OP_PUSHBYTES_33
  | OP_PUSHBYTES_34
  | OP_PUSHBYTES_35
  | OP_PUSHBYTES_36
  | OP_PUSHBYTES_37
  | OP_PUSHBYTES_38
  | OP_PUSHBYTES_39
  | OP_PUSHBYTES_40
  | OP_PUSHBYTES_41
  | OP_PUSHBYTES_42
  | OP_PUSHBYTES_43
  | OP_PUSHBYTES_44
  | OP_PUSHBYTES_45
  | OP_PUSHBYTES_46
  | OP_PUSHBYTES_47
  | OP_PUSHBYTES_48
  | OP_PUSHBYTES_49
  | OP_PUSHBYTES_50
  | OP_PUSHBYTES_51
  | OP_PUSHBYTES_52
  | OP_PUSHBYTES_53
  | OP_PUSHBYTES_54
  | OP_PUSHBYTES_55
  | OP_PUSHBYTES_56
  | OP_PUSHBYTES_57
  | OP_PUSHBYTES_58
  | OP_PUSHBYTES_59
  | OP_PUSHBYTES_60
  | OP_PUSHBYTES_61
  | OP_PUSHBYTES_62
  | OP_PUSHBYTES_63
  | OP_PUSHBYTES_64
  | OP_PUSHBYTES_65
  | OP_PUSHBYTES_66
  | OP_PUSHBYTES_67
  | OP_PUSHBYTES_68
  | OP_PUSHBYTES_69
  | OP_PUSHBYTES_70
  | OP_PUSHBYTES_71
  | OP_PUSHBYTES_72
  | OP_PUSHBYTES_73
  | OP_PUSHBYTES_74
  | OP_PUSHBYTES_75
  | OP_PUSHDATA1
  | OP_PUSHDATA2
  | OP_PUSHDATA4
  | 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_2DROP
  | OP_2DUP
  | OP_3DUP
  | OP_2OVER
  | OP_2ROT
  | OP_2SWAP
  | OP_IFDUP
  | OP_DEPTH
  | OP_DROP
  | OP_DUP
  | OP_NIP
  | OP_OVER
  | OP_PICK
  | OP_ROLL
  | OP_ROT
  | OP_SWAP
  | OP_TUCK
  | 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_CLTV
  | OP_CSV
  | OP_NOP4
  | OP_NOP5
  | OP_NOP6
  | OP_NOP7
  | OP_NOP8
  | OP_NOP9
  | OP_NOP10
  | OP_CHECKSIGADD
  | OP_RETURN_187
  | OP_RETURN_188
  | OP_RETURN_189
  | OP_RETURN_190
  | OP_RETURN_191
  | OP_RETURN_192
  | OP_RETURN_193
  | OP_RETURN_194
  | OP_RETURN_195
  | OP_RETURN_196
  | OP_RETURN_197
  | OP_RETURN_198
  | OP_RETURN_199
  | OP_RETURN_200
  | OP_RETURN_201
  | OP_RETURN_202
  | OP_RETURN_203
  | OP_RETURN_204
  | OP_RETURN_205
  | OP_RETURN_206
  | OP_RETURN_207
  | OP_RETURN_208
  | OP_RETURN_209
  | OP_RETURN_210
  | OP_RETURN_211
  | OP_RETURN_212
  | OP_RETURN_213
  | OP_RETURN_214
  | OP_RETURN_215
  | OP_RETURN_216
  | OP_RETURN_217
  | OP_RETURN_218
  | OP_RETURN_219
  | OP_RETURN_220
  | OP_RETURN_221
  | OP_RETURN_222
  | OP_RETURN_223
  | OP_RETURN_224
  | OP_RETURN_225
  | OP_RETURN_226
  | OP_RETURN_227
  | OP_RETURN_228
  | OP_RETURN_229
  | OP_RETURN_230
  | OP_RETURN_231
  | OP_RETURN_232
  | OP_RETURN_233
  | OP_RETURN_234
  | OP_RETURN_235
  | OP_RETURN_236
  | OP_RETURN_237
  | OP_RETURN_238
  | OP_RETURN_239
  | OP_RETURN_240
  | OP_RETURN_241
  | OP_RETURN_242
  | OP_RETURN_243
  | OP_RETURN_244
  | OP_RETURN_245
  | OP_RETURN_246
  | OP_RETURN_247
  | OP_RETURN_248
  | OP_RETURN_249
  | OP_RETURN_250
  | OP_RETURN_251
  | OP_RETURN_252
  | OP_RETURN_253
  | OP_RETURN_254
  | OP_INVALIDOPCODE
  deriving (Opcode -> Opcode -> Bool
(Opcode -> Opcode -> Bool)
-> (Opcode -> Opcode -> Bool) -> Eq Opcode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Opcode -> Opcode -> Bool
== :: Opcode -> Opcode -> Bool
$c/= :: Opcode -> Opcode -> Bool
/= :: Opcode -> Opcode -> Bool
Eq, Int -> Opcode -> ShowS
[Opcode] -> ShowS
Opcode -> String
(Int -> Opcode -> ShowS)
-> (Opcode -> String) -> ([Opcode] -> ShowS) -> Show Opcode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Opcode -> ShowS
showsPrec :: Int -> Opcode -> ShowS
$cshow :: Opcode -> String
show :: Opcode -> String
$cshowList :: [Opcode] -> ShowS
showList :: [Opcode] -> ShowS
Show, Int -> Opcode
Opcode -> Int
Opcode -> [Opcode]
Opcode -> Opcode
Opcode -> Opcode -> [Opcode]
Opcode -> Opcode -> Opcode -> [Opcode]
(Opcode -> Opcode)
-> (Opcode -> Opcode)
-> (Int -> Opcode)
-> (Opcode -> Int)
-> (Opcode -> [Opcode])
-> (Opcode -> Opcode -> [Opcode])
-> (Opcode -> Opcode -> [Opcode])
-> (Opcode -> Opcode -> Opcode -> [Opcode])
-> Enum Opcode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Opcode -> Opcode
succ :: Opcode -> Opcode
$cpred :: Opcode -> Opcode
pred :: Opcode -> Opcode
$ctoEnum :: Int -> Opcode
toEnum :: Int -> Opcode
$cfromEnum :: Opcode -> Int
fromEnum :: Opcode -> Int
$cenumFrom :: Opcode -> [Opcode]
enumFrom :: Opcode -> [Opcode]
$cenumFromThen :: Opcode -> Opcode -> [Opcode]
enumFromThen :: Opcode -> Opcode -> [Opcode]
$cenumFromTo :: Opcode -> Opcode -> [Opcode]
enumFromTo :: Opcode -> Opcode -> [Opcode]
$cenumFromThenTo :: Opcode -> Opcode -> Opcode -> [Opcode]
enumFromThenTo :: Opcode -> Opcode -> Opcode -> [Opcode]
Enum)

-- convert a pushbytes opcode to its corresponding int
pushbytes :: Opcode -> Maybe Int
pushbytes :: Opcode -> Maybe Int
pushbytes (Opcode -> Int
forall a. Enum a => a -> Int
fromEnum -> Int
op)
  | Int
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
76 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int -> Int
forall a b. (Num a, Integral b) => b -> a
fi Int
op
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing