{-# LANGUAGE PatternSynonyms #-}

-- |
-- Module: EVM.Opcode
-- Copyright: 2018 Simon Shine
-- Maintainer: Simon Shine <shreddedglory@gmail.com>
-- License: MIT
--
-- This module exposes the 'Opcode' type for expressing Ethereum VM opcodes
-- as extracted from the Ethereum Yellow Paper with amendments from various
-- EIPs. The Yellow Paper is available at:
--
-- https://ethereum.github.io/yellowpaper/paper.pdf
--
-- The list of opcodes is found in appendix H.2.
--
-- But it is not always up-to-date, so keeping track of EIPs that add or
-- modify instructions is necessary. See comments in this module for the
-- references to these additions.

module EVM.Opcode 
  ( -- * Types
    Opcode
  , Opcode'(..)
  , OpcodeSpec(..)
  , opcodeSpec

    -- ** Pseudo-instructions and helper functions
  , jump
  , jumpi
  , jumpdest

    -- Extraction
  , jumpAnnot
  , jumpdestAnnot

    -- ** Conversion and printing
  , concrete
  , opcodeText
  , opcodeSize
  , toHex
  , pack
  , toBytes

    -- ** Parse and validate instructions
  , isDUP
  , isSWAP
  , isLOG
  , isPUSH
  , readDUP
  , readSWAP
  , readLOG
  , readPUSH
  , readOp

    -- ** Pattern synonyms
  , pattern DUP1,  pattern DUP2,  pattern DUP3,  pattern DUP4
  , pattern DUP5,  pattern DUP6,  pattern DUP7,  pattern DUP8
  , pattern DUP9,  pattern DUP10, pattern DUP11, pattern DUP12
  , pattern DUP13, pattern DUP14, pattern DUP15, pattern DUP16

  , pattern SWAP1,  pattern SWAP2,  pattern SWAP3,  pattern SWAP4
  , pattern SWAP5,  pattern SWAP6,  pattern SWAP7,  pattern SWAP8
  , pattern SWAP9,  pattern SWAP10, pattern SWAP11, pattern SWAP12
  , pattern SWAP13, pattern SWAP14, pattern SWAP15, pattern SWAP16

  , pattern LOG0, pattern LOG1, pattern LOG2, pattern LOG3, pattern LOG4
  ) where

import Prelude hiding (LT, EQ, GT)

import           Control.Applicative ((<|>))
import           Control.Monad (guard)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.DoubleWord (Word256, fromHiAndLo)
import           Data.Maybe (isJust)
import qualified Data.Serialize.Get as Cereal
import           Data.String (IsString, fromString)
import           Data.Text (Text)
import qualified Data.List as List
import           Data.Word (Word8, Word64)
import           Text.Printf (printf)

import EVM.Opcode.Internal

-- | An 'Opcode' is a plain, parameterless Ethereum VM Opcode.
type Opcode = Opcode' ()

-- | 'jump' is a plain parameterless 'Opcode'.
jump :: Opcode
jump :: Opcode
jump = forall j. j -> Opcode' j
JUMP ()

-- | 'jumpi' is a plain parameterless 'Opcode'.
jumpi :: Opcode
jumpi :: Opcode
jumpi = forall j. j -> Opcode' j
JUMPI ()

-- | 'jumpdest' is a plain parameterless 'Opcode'.
jumpdest :: Opcode
jumpdest :: Opcode
jumpdest = forall j. j -> Opcode' j
JUMPDEST ()

-- | Determine if a byte represents a 'DUP' opcode ('DUP1' -- 'DUP16').
isDUP  :: Word8 -> Bool
isDUP :: Word8 -> Bool
isDUP = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Maybe Opcode
readDUP

-- | Determine if a byte represents a 'SWAP' opcode ('SWAP1' -- 'SWAP16').
isSWAP  :: Word8 -> Bool
isSWAP :: Word8 -> Bool
isSWAP = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Maybe Opcode
readSWAP

-- | Determine if a byte represents a 'LOG' opcode ('LOG1' -- 'LOG4').
isLOG  :: Word8 -> Bool
isLOG :: Word8 -> Bool
isLOG = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Maybe Opcode
readLOG

-- | Determine if a byte represents a 'PUSH' opcode.
isPUSH :: Word8 -> ByteString -> Bool
isPUSH :: Word8 -> ByteString -> Bool
isPUSH Word8
b ByteString
bs = forall a. Maybe a -> Bool
isJust (Word8 -> ByteString -> Maybe Opcode
readPUSH Word8
b ByteString
bs)

-- | Read a 'DUP' opcode ('DUP1' -- 'DUP16') safely.
readDUP :: Word8 -> Maybe Opcode
readDUP :: Word8 -> Maybe Opcode
readDUP Word8
b = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
b forall a. Ord a => a -> a -> Bool
>= Word8
0x80 Bool -> Bool -> Bool
&& Word8
b forall a. Ord a => a -> a -> Bool
<= Word8
0x8f)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall j. Ord16 -> Opcode' j
DUP (forall e. Enum e => Word8 -> e
fromWord8 (Word8
b forall a. Num a => a -> a -> a
- Word8
0x80)))

-- | Read a 'SWAP' opcode ('SWAP1' -- 'SWAP16') safely.
readSWAP :: Word8 -> Maybe Opcode
readSWAP :: Word8 -> Maybe Opcode
readSWAP Word8
b = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
b forall a. Ord a => a -> a -> Bool
>= Word8
0x90 Bool -> Bool -> Bool
&& Word8
b forall a. Ord a => a -> a -> Bool
<= Word8
0x9f)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall j. Ord16 -> Opcode' j
SWAP (forall e. Enum e => Word8 -> e
fromWord8 (Word8
b forall a. Num a => a -> a -> a
- Word8
0x90)))

-- | Read a 'LOG' opcode ('LOG1' -- 'LOG4') safely.
readLOG :: Word8 -> Maybe Opcode
readLOG :: Word8 -> Maybe Opcode
readLOG Word8
b = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
b forall a. Ord a => a -> a -> Bool
>= Word8
0xa0 Bool -> Bool -> Bool
&& Word8
b forall a. Ord a => a -> a -> Bool
<= Word8
0xa4)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall j. Ord5 -> Opcode' j
LOG (forall e. Enum e => Word8 -> e
fromWord8 (Word8
b forall a. Num a => a -> a -> a
- Word8
0xa0)))

-- | Read a 'PUSH' opcode safely.
readPUSH :: Word8 -> ByteString -> Maybe Opcode
readPUSH :: Word8 -> ByteString -> Maybe Opcode
readPUSH Word8
b ByteString
bs = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
b forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
b forall a. Ord a => a -> a -> Bool
<= Word8
0x7f)
  let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b forall a. Num a => a -> a -> a
- Word8
0x60 forall a. Num a => a -> a -> a
+ Word8
1)
  forall j. Word256 -> Opcode' j
PUSH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Word256
word256 (Int -> ByteString -> ByteString
BS.take Int
n ByteString
bs)

-- | Parse an 'Opcode' from a 'Word8'. In case of 'PUSH' instructions, read the
-- constant being pushed from a subsequent 'ByteString'.
readOp :: Word8 -> ByteString -> Maybe Opcode
readOp :: Word8 -> ByteString -> Maybe Opcode
readOp Word8
word ByteString
bs
    = Word8 -> Maybe Opcode
readDUP Word8
word
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> Maybe Opcode
readSWAP Word8
word
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> Maybe Opcode
readLOG Word8
word
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> ByteString -> Maybe Opcode
readPUSH Word8
word ByteString
bs
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> case Word8
word of
    -- 0s: Stop and Arithmetic Operations
    Word8
0x00 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
STOP
    Word8
0x01 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
ADD
    Word8
0x02 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MUL
    Word8
0x03 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SUB
    Word8
0x04 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
DIV
    Word8
0x05 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SDIV
    Word8
0x06 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MOD
    Word8
0x07 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SMOD
    Word8
0x08 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
ADDMOD
    Word8
0x09 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MULMOD
    Word8
0x0a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
EXP
    Word8
0x0b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SIGNEXTEND

    -- 10s: Comparison & Bitwise Logic Operations
    Word8
0x10 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
LT
    Word8
0x11 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
GT
    Word8
0x12 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SLT
    Word8
0x13 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SGT
    Word8
0x14 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
EQ
    Word8
0x15 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
ISZERO
    Word8
0x16 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
AND
    Word8
0x17 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
OR
    Word8
0x18 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
XOR
    Word8
0x19 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
NOT
    Word8
0x1a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
BYTE
    Word8
0x1b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SHL
    Word8
0x1c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SHR
    Word8
0x1d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SAR

    -- 20s: SHA3
    Word8
0x20 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SHA3

    -- 30s: Environmental Information
    Word8
0x30 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
ADDRESS
    Word8
0x31 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
BALANCE
    Word8
0x32 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
ORIGIN
    Word8
0x33 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALLER
    Word8
0x34 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALLVALUE
    Word8
0x35 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALLDATALOAD
    Word8
0x36 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALLDATASIZE
    Word8
0x37 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALLDATACOPY
    Word8
0x38 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CODESIZE
    Word8
0x39 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CODECOPY
    Word8
0x3a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
GASPRICE
    Word8
0x3b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
EXTCODESIZE
    Word8
0x3c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
EXTCODECOPY
    Word8
0x3d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
RETURNDATASIZE
    Word8
0x3e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
RETURNDATACOPY
    Word8
0x3f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
EXTCODEHASH

    -- 40s: Block Information
    Word8
0x40 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
BLOCKHASH
    Word8
0x41 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
COINBASE
    Word8
0x42 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
TIMESTAMP
    Word8
0x43 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
NUMBER
    Word8
0x44 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
DIFFICULTY
    Word8
0x45 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
GASLIMIT
    Word8
0x46 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CHAINID
    Word8
0x47 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SELFBALANCE

    -- 50s: Stack, Memory, Storage and Flow Operations
    Word8
0x50 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
POP
    Word8
0x51 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MLOAD
    Word8
0x52 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MSTORE
    Word8
0x53 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MSTORE8
    Word8
0x54 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SLOAD
    Word8
0x55 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SSTORE
    Word8
0x56 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Opcode
jump
    Word8
0x57 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Opcode
jumpi
    Word8
0x58 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
PC
    Word8
0x59 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
MSIZE
    Word8
0x5a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
GAS
    Word8
0x5b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Opcode
jumpdest

    -- f0s: System Operations
    Word8
0xf0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CREATE
    Word8
0xf1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALL
    Word8
0xf2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CALLCODE
    Word8
0xf3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
RETURN
    Word8
0xf4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
DELEGATECALL
    Word8
0xf5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
CREATE2
    Word8
0xfa -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
STATICCALL
    Word8
0xfd -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
REVERT
    Word8
0xfe -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
INVALID
    Word8
0xff -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall j. Opcode' j
SELFDESTRUCT

    -- Unknown
    Word8
_    -> forall a. Maybe a
Nothing

-- | Get a 'Word256' from a 'ByteString'
--
-- Pads the ByteString with NULs up to 32 bytes.
word256 :: ByteString -> Maybe Word256
word256 :: ByteString -> Maybe Word256
word256 = forall e a. Either e a -> Maybe a
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Word256
getWord256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
padLeft Int
32
  where
    getWord256 :: ByteString -> Either String Word256
    getWord256 :: ByteString -> Either String Word256
getWord256 = forall a. Get a -> ByteString -> Either String a
Cereal.runGet forall a b. (a -> b) -> a -> b
$
      Word64 -> Word64 -> Word64 -> Word64 -> Word256
fromWord64s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
Cereal.getWord64be
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
Cereal.getWord64be
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
Cereal.getWord64be
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
Cereal.getWord64be

    fromWord64s :: Word64 -> Word64 -> Word64 -> Word64 -> Word256
    fromWord64s :: Word64 -> Word64 -> Word64 -> Word64 -> Word256
fromWord64s Word64
a Word64
b Word64
c Word64
d = forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo (forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word64
a Word64
b) (forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word64
c Word64
d)

    padLeft :: Int -> ByteString -> ByteString
    padLeft :: Int -> ByteString -> ByteString
padLeft Int
n ByteString
xs = Int -> Word8 -> ByteString
BS.replicate (Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
xs) Word8
0 forall a. Semigroup a => a -> a -> a
<> ByteString
xs

    eitherToMaybe :: Either e a -> Maybe a
    eitherToMaybe :: forall e a. Either e a -> Maybe a
eitherToMaybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Show 'Opcode' as 'Text'.
opcodeText :: Opcode -> Text
opcodeText :: Opcode -> Text
opcodeText = OpcodeSpec -> Text
opcodeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall j. Opcode' j -> OpcodeSpec
opcodeSpec

-- | Calculate the size in bytes of an encoded opcode. The only 'Opcode'
-- that uses more than one byte is 'PUSH'. Sizes are trivially determined
-- for only 'Opcode' with unlabelled jumps, since we cannot know e.g. where
-- the label of a 'LabelledOpcode' points to before code generation has
-- completed.
opcodeSize :: Num i => Opcode -> i
opcodeSize :: forall i. Num i => Opcode -> i
opcodeSize (PUSH Word256
n) = forall i a. Num i => [a] -> i
List.genericLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$ Word256 -> (Word8, [Word8])
push' Word256
n
opcodeSize Opcode
_opcode = i
1

-- | Convert a @['Opcode']@ to a string of ASCII hexadecimals.
toHex :: IsString s => [Opcode] -> s
toHex :: forall s. IsString s => [Opcode] -> s
toHex = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap (forall r. PrintfType r => String -> r
printf String
"%02x") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap Opcode -> [Word8]
toBytes

-- | Convert a @['Opcode']@ to bytecode.
pack :: [Opcode] -> ByteString
pack :: [Opcode] -> ByteString
pack = [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap Opcode -> [Word8]
toBytes

-- | Convert an @'Opcode'@ to a @['Word8']@.
--
-- To convert many 'Opcode's to bytecode, use 'pack'.
toBytes :: Opcode -> [Word8]
toBytes :: Opcode -> [Word8]
toBytes (PUSH Word256
n) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (Word256 -> (Word8, [Word8])
push' Word256
n)
toBytes Opcode
opcode = [ OpcodeSpec -> Word8
opcodeEncoding (forall j. Opcode' j -> OpcodeSpec
opcodeSpec Opcode
opcode) ]