evm-opcodes 0.1.1 → 0.1.2

raw patch · 8 files changed

+227/−93 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• evm-opcodes.cabal +1/−2
• src/EVM/Opcode.hs +57/−39
• src/EVM/Opcode/Internal.hs +31/−29
• src/EVM/Opcode/Labelled.hs +14/−15
• src/EVM/Opcode/Positional.hs +3/−3
• src/EVM/Opcode/Traversal.hs +4/−4
• test/OpcodeTest.hs +116/−0

@@ -1,4 +1,4 @@-Copyright 2018-2021 Simon Shine+Copyright 2018-2022 Simon Shine  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           evm-opcodes-version:        0.1.1+version:        0.1.2 synopsis:       Opcode types for Ethereum Virtual Machine (EVM) description:    This library provides opcode types for the Ethereum Virtual Machine. category:       Ethereum, Finance, Network@@ -77,7 +77,6 @@       Paths_evm_opcodes   hs-source-dirs:       bench-  ghc-options: -O2   build-depends:       base >=4.12 && <5     , bytestring >=0.10

@@ -1,10 +1,9 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-}  -- | -- Module: EVM.Opcode--- Copyright: 2018 Simon Shine--- Maintainer: Simon Shine <shreddedglory@gmail.com>+-- Copyright: 2018-2022 Simon Shine+-- Maintainer: Simon Shine <simon@simonshine.dk> -- License: MIT -- -- This module exposes the 'Opcode' type for expressing Ethereum VM opcodes@@ -55,45 +54,64 @@   , 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)+  , 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           Control.Applicative ((<|>))-import           Control.Monad (guard)-import           Data.ByteString (ByteString)+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.Text as Text+import Data.DoubleWord (Word256, fromHiAndLo) import qualified Data.List as List-import           Data.Word (Word8, Word64)-import           Text.Printf (printf)-+import Data.Maybe (isJust)+import qualified Data.Serialize.Get as Cereal+import Data.String (IsString, fromString)+import Data.Text (Text)+import Data.Word (Word64, Word8) import EVM.Opcode.Internal+import Text.Printf (printf)+import Prelude hiding (EQ, GT, LT)  -- | An 'Opcode' is a plain, parameterless Ethereum VM Opcode. type Opcode = Opcode' () --- | Show 'PUSH' as the Haskell data constructor-instance {-# OVERLAPPING #-} Show Opcode where-  show (PUSH n) = "PUSH " <> show n-  show opcode = Text.unpack (Text.toUpper (opcodeText opcode))- -- | 'jump' is a plain parameterless 'Opcode'. jump :: Opcode jump = JUMP ()@@ -107,15 +125,15 @@ jumpdest = JUMPDEST ()  -- | Determine if a byte represents a 'DUP' opcode ('DUP1' -- 'DUP16').-isDUP  :: Word8 -> Bool+isDUP :: Word8 -> Bool isDUP = isJust . readDUP  -- | Determine if a byte represents a 'SWAP' opcode ('SWAP1' -- 'SWAP16').-isSWAP  :: Word8 -> Bool+isSWAP :: Word8 -> Bool isSWAP = isJust . readSWAP  -- | Determine if a byte represents a 'LOG' opcode ('LOG1' -- 'LOG4').-isLOG  :: Word8 -> Bool+isLOG :: Word8 -> Bool isLOG = isJust . readLOG  -- | Determine if a byte represents a 'PUSH' opcode.@@ -275,8 +293,8 @@ -- | 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.+-- the label of a 'EVM.Opcode.LabelledOpcode' points to before code generation+-- has completed. opcodeSize :: Num i => Opcode -> i opcodeSize (PUSH n) = List.genericLength . uncurry (:) $ push' n opcodeSize _opcode = 1

@@ -1,34 +1,32 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-}  -- | -- Module: EVM.Opcode.Internal--- Copyright: 2018 Simon Shine--- Maintainer: Simon Shine <shreddedglory@gmail.com>+-- Copyright: 2018-2022 Simon Shine+-- Maintainer: Simon Shine <simon@simonshine.dk> -- License: MIT -- -- This module exposes the 'Opcode'' abstract type.  module EVM.Opcode.Internal where -import Prelude hiding (LT, EQ, GT)--import           Control.Monad (void)-import           Data.Bits (shift)-import           Data.DoubleWord (Word256)-import           Data.Text (Text)-import qualified Data.Text as Text+import Control.Monad (void)+import Data.Bits (shift)+import Data.DoubleWord (Word256) import qualified Data.List as List-import           Data.Word (Word8)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Word (Word8)+import Prelude hiding (EQ, GT, LT)  -- | An 'Opcode'' is an Ethereum VM Opcode with parameterised jumps. ----- For a plain opcode using the basic EVM stack-based jumps, use 'Opcode'--- instead.+-- For a plain opcode using the basic EVM stack-based jumps, use+-- 'EVM.Opcode.Opcode' instead. -- -- This type is used for defining and translating from annotated opcodes, e.g. -- with labelled jumps.@@ -110,7 +108,11 @@    -- 60s & 70s: Push Operations   | PUSH !Word256     -- ^ 0x60 - 0x7f (PUSH1 - PUSH32)++  -- 80s: Duplication Operations (DUP)   | DUP !Ord16         -- ^ 0x80 - 0x8f ('DUP1' - 'DUP16')++  -- 90s: Exchange operations (SWAP)   | SWAP !Ord16        -- ^ 0x90 - 0x9f ('SWAP1' - 'SWAP16')    -- a0s: Logging Operations@@ -176,17 +178,17 @@   | Ord16_9   | Ord16_10   | Ord16_11-  | Ord16_12-  | Ord16_13+  | Ord16_12+  | Ord16_13   | Ord16_14   | Ord16_15   | Ord16_16   deriving (Eq, Ord, Enum, Bounded) --- | An 'OpcodeSpec' for a given 'Opcode' contains the numeric encoding of the--- opcode, the number of items that this opcode removes from the stack (α),--- and the number of items added to the stack (δ). These values are documented--- in the Ethereum Yellow Paper.+-- | An 'OpcodeSpec' for a given 'EVM.Opcode.Opcode' contains the numeric+-- encoding of the opcode, the number of items that this opcode removes+-- from the stack (α), and the number of items added to the stack (δ).+-- These values are documented in the Ethereum Yellow Paper. -- -- Examples of 'OpcodeSpec's: --@@ -341,20 +343,20 @@   INVALID      -> OpcodeSpec 0xfe 0 0 "invalid" -- α, δ are ∅   SELFDESTRUCT -> OpcodeSpec 0xff 1 0 "selfdestruct" -instance {-# OVERLAPPABLE #-} Show a => Show (Opcode' a) where-  show opcode = show (concrete opcode) <> showParam opcode-    where-      showParam (JUMP a) = " " <> show a-      showParam (JUMPI a) = " " <> show a-      showParam (JUMPDEST a) = " " <> show a-      showParam _opcode = ""+instance Show a => Show (Opcode' a) where+  show (PUSH n) = "PUSH " <> show n+  show (JUMP j) = "JUMP " <> show j+  show (JUMPI j) = "JUMPI " <> show j+  show (JUMPDEST j) = "JUMPDEST " <> show j+  show opcode = Text.unpack (Text.toUpper (opcodeName (opcodeSpec opcode)))  -- | Convert the constant argument of a 'PUSH' to the opcode encoding -- (0x60--0x7f) and its constant split into 'Word8' segments. push' :: Word256 -> (Word8, [Word8]) push' i | i < 256 = (0x60, [fromIntegral i]) push' i = (opcode + 1, arg <> [fromIntegral i])-  where (opcode, arg) = push' (i `shift` (-8))+  where+    (opcode, arg) = push' (i `shift` (-8))  -- | Use 'DUP1' instead of @'DUP' 'Ord16_1'@. pattern DUP1 :: forall j. Opcode' j

@@ -2,17 +2,17 @@  -- | -- Module: EVM.Opcode.Labelled--- Copyright: 2018 Simon Shine--- Maintainer: Simon Shine <shreddedglory@gmail.com>+-- Copyright: 2018-2022 Simon Shine+-- Maintainer: Simon Shine <simon@simonshine.dk> -- License: MIT -- -- This module exposes the 'LabelledOpcode' type for expressing Ethereum VM -- opcodes with labelled jumps. Plain Ethereum VM Opcodes are not so ergonomic -- because one has to know the exact byte offset of the target 'JUMPDEST'. ----- With 'Opcode' the byte offset is pushed to the stack via 'PUSH', but the--- offset to the 'JUMPDEST' depends on all occurrences of 'PUSH' prior to--- the label, including the 'PUSH' to the label itself.+-- With 'EVM.Opcode.Opcode' the byte offset is pushed to the stack via 'PUSH',+-- but the offset to the 'JUMPDEST' depends on all occurrences of 'PUSH' prior+-- to the label, including the 'PUSH' to the label itself.  module EVM.Opcode.Labelled   ( Label@@ -22,17 +22,16 @@   , labelPositions   ) where -import           Data.Function (fix)-import           Data.List (group, sort, foldl')+import Data.Function (fix)+import Data.List (foldl', group, sort)+import Data.Map (Map) import qualified Data.Map as Map-import           Data.Map (Map)-import           Data.Maybe (mapMaybe)+import Data.Maybe (mapMaybe) import qualified Data.Set as Set-import           Data.Text (Text)--import           EVM.Opcode (Opcode'(..), opcodeSize, jumpdest, concrete, jumpAnnot, jumpdestAnnot)-import           EVM.Opcode.Positional (Position, PositionalOpcode, jumpSize)-import           EVM.Opcode.Traversal (OpcodeMapper(..), mapOpcodeM)+import Data.Text (Text)+import EVM.Opcode (Opcode' (..), concrete, jumpAnnot, jumpdest, jumpdestAnnot, opcodeSize)+import EVM.Opcode.Positional (Position, PositionalOpcode, jumpSize)+import EVM.Opcode.Traversal (OpcodeMapper (..), mapOpcodeM)  -- | For now, all labels are 'Text'. type Label = Text@@ -59,7 +58,7 @@ -- positional jump depends on the address being jumped to. -- -- For example, if jumping to the 'JUMPDEST' on the 256th position in a--- @['LabelledOpcode']@, this requires a 'PUSH2' instruction which uses an+-- @['LabelledOpcode']@, this requires a @PUSH2@ instruction which uses an -- additional byte, which pushes the 'JUMPDEST' one byte ahead.  translate :: [LabelledOpcode] -> Either TranslateError [PositionalOpcode]

@@ -1,7 +1,7 @@ -- | -- Module: EVM.Opcode.Positional--- Copyright: 2018 Simon Shine--- Maintainer: Simon Shine <shreddedglory@gmail.com>+-- Copyright: 2018-2022 Simon Shine+-- Maintainer: Simon Shine <simon@simonshine.dk> -- License: MIT -- -- This module exposes the `PositionalOpcode` type for expressing Ethereum@@ -21,7 +21,7 @@   , jumpSize   ) where -import EVM.Opcode (Opcode, Opcode'(..), jump, jumpi, jumpdest, concrete, opcodeSize)+import EVM.Opcode (Opcode, Opcode' (..), concrete, jump, jumpdest, jumpi, opcodeSize)  -- | The position of an Opcode. type Position = Word

@@ -2,8 +2,8 @@  -- | -- Module: EVM.Opcode.Traversal--- Copyright: 2018 Simon Shine--- Maintainer: Simon Shine <shreddedglory@gmail.com>+-- Copyright: 2018-2022 Simon Shine+-- Maintainer: Simon Shine <simon@simonshine.dk> -- License: MIT -- -- This module exposes a generic method of traversing 'Opcode''s.@@ -13,8 +13,8 @@   , mapOpcodeM   ) where -import Prelude hiding (LT, EQ, GT) import EVM.Opcode+import Prelude hiding (EQ, GT, LT)  -- | An 'OpcodeMapper' is a collection of four mapping functions that can -- map any @'Opcode'' a@ to an @'Opcode'' b@. For each of the three opcodes@@ -138,4 +138,4 @@       res <- mapOnOther mapper opa       case res of         Just opb -> return opb-        Nothing  -> return opbDefault+        Nothing -> return opbDefault

@@ -92,6 +92,10 @@     it "handles empty lists" $       L.translate [] `shouldBe` Right [] +    it "handles instructions without jumps" $ do+      L.translate [STOP] `shouldBe` Right [STOP]+      L.translate [PUSH 2, PUSH 2, ADD] `shouldBe` Right [PUSH 2, PUSH 2, ADD]+     it "handles empty labels" $       L.translate [JUMP "", JUMPDEST ""] `shouldBe` Right [JUMP 3, JUMPDEST 3] @@ -139,6 +143,118 @@           duplicateDests = [ "x", "y" ]        in L.translate instructions `shouldBe` Left (TranslateError wildJumps duplicateDests)++spec_Show_for_Opcode :: Spec+spec_Show_for_Opcode =+  describe "show" $ do+    -- 0s: Stop and Arithmetic Operations+    it "shows STOP" $ show' STOP `shouldBe` "STOP"+    it "shows ADD" $ show' ADD `shouldBe` "ADD"+    it "shows MUL" $ show' MUL `shouldBe` "MUL"+    it "shows SUB" $ show' SUB `shouldBe` "SUB"+    it "shows DIV" $ show' DIV `shouldBe` "DIV"+    it "shows SDIV" $ show' SDIV `shouldBe` "SDIV"+    it "shows MOD" $ show' MOD `shouldBe` "MOD"+    it "shows SMOD" $ show' SMOD `shouldBe` "SMOD"+    it "shows ADDMOD" $ show' ADDMOD `shouldBe` "ADDMOD"+    it "shows MULMOD" $ show' MULMOD `shouldBe` "MULMOD"+    it "shows EXP" $ show' EXP `shouldBe` "EXP"+    it "shows SIGNEXTEND" $ show' SIGNEXTEND `shouldBe` "SIGNEXTEND"++    -- 10s: Comparison & Bitwise Logic Operations+    it "shows LT" $ show' LT `shouldBe` "LT"+    it "shows GT" $ show' GT `shouldBe` "GT"+    it "shows SLT" $ show' SLT `shouldBe` "SLT"+    it "shows SGT" $ show' SGT `shouldBe` "SGT"+    it "shows EQ" $ show' EQ `shouldBe` "EQ"+    it "shows ISZERO" $ show' ISZERO `shouldBe` "ISZERO"+    it "shows AND" $ show' AND `shouldBe` "AND"+    it "shows OR" $ show' OR `shouldBe` "OR"+    it "shows XOR" $ show' XOR `shouldBe` "XOR"+    it "shows NOT" $ show' NOT `shouldBe` "NOT"+    it "shows BYTE" $ show' BYTE `shouldBe` "BYTE"+    it "shows SHL" $ show' SHL `shouldBe` "SHL"+    it "shows SHR" $ show' SHR `shouldBe` "SHR"+    it "shows SAR" $ show' SAR `shouldBe` "SAR"++    -- 20s: SHA3+    it "shows SHA3" $ show' SHA3 `shouldBe` "SHA3"++    -- 30s: Environmental Information+    it "shows ADDRESS" $ show' ADDRESS `shouldBe` "ADDRESS"+    it "shows BALANCE" $ show' BALANCE `shouldBe` "BALANCE"+    it "shows ORIGIN" $ show' ORIGIN `shouldBe` "ORIGIN"+    it "shows CALLER" $ show' CALLER `shouldBe` "CALLER"+    it "shows CALLVALUE" $ show' CALLVALUE `shouldBe` "CALLVALUE"+    it "shows CALLDATALOAD" $ show' CALLDATALOAD `shouldBe` "CALLDATALOAD"+    it "shows CALLDATASIZE" $ show' CALLDATASIZE `shouldBe` "CALLDATASIZE"+    it "shows CALLDATACOPY" $ show' CALLDATACOPY `shouldBe` "CALLDATACOPY"+    it "shows CODESIZE" $ show' CODESIZE `shouldBe` "CODESIZE"+    it "shows CODECOPY" $ show' CODECOPY `shouldBe` "CODECOPY"+    it "shows GASPRICE" $ show' GASPRICE `shouldBe` "GASPRICE"+    it "shows EXTCODESIZE" $ show' EXTCODESIZE `shouldBe` "EXTCODESIZE"+    it "shows EXTCODECOPY" $ show' EXTCODECOPY `shouldBe` "EXTCODECOPY"+    it "shows RETURNDATASIZE" $ show' RETURNDATASIZE `shouldBe` "RETURNDATASIZE"+    it "shows RETURNDATACOPY" $ show' RETURNDATACOPY `shouldBe` "RETURNDATACOPY"+    it "shows EXTCODEHASH" $ show' EXTCODEHASH `shouldBe` "EXTCODEHASH"++    -- 40s: Block Information+    it "shows BLOCKHASH" $ show' BLOCKHASH `shouldBe` "BLOCKHASH"+    it "shows COINBASE" $ show' COINBASE `shouldBe` "COINBASE"+    it "shows TIMESTAMP" $ show' TIMESTAMP `shouldBe` "TIMESTAMP"+    it "shows NUMBER" $ show' NUMBER `shouldBe` "NUMBER"+    it "shows DIFFICULTY" $ show' DIFFICULTY `shouldBe` "DIFFICULTY"+    it "shows GASLIMIT" $ show' GASLIMIT `shouldBe` "GASLIMIT"+    it "shows CHAINID" $ show' CHAINID `shouldBe` "CHAINID"+    it "shows SELFBALANCE" $ show' SELFBALANCE `shouldBe` "SELFBALANCE"++    -- 50s: Stack, Memory, Storage and Flow Operations+    it "shows POP" $ show' POP `shouldBe` "POP"+    it "shows MLOAD" $ show' MLOAD `shouldBe` "MLOAD"+    it "shows MSTORE" $ show' MSTORE `shouldBe` "MSTORE"+    it "shows MSTORE8" $ show' MSTORE8 `shouldBe` "MSTORE8"+    it "shows SLOAD" $ show' SLOAD `shouldBe` "SLOAD"+    it "shows SSTORE" $ show' SSTORE `shouldBe` "SSTORE"+    it "shows JUMP" $ show' (JUMP ()) `shouldBe` "JUMP ()"+    it "shows JUMPI" $ show' (JUMPI ()) `shouldBe` "JUMPI ()"+    it "shows PC" $ show' PC `shouldBe` "PC"+    it "shows MSIZE" $ show' MSIZE `shouldBe` "MSIZE"+    it "shows GAS" $ show' GAS `shouldBe` "GAS"+    it "shows JUMPDEST" $ show' (JUMPDEST ()) `shouldBe` "JUMPDEST ()"++    -- 60s & 70s: Push Operations+    for_ [0, 255, 256, 65535, 65536] $ \i ->+      it ("shows PUSH " <> show i) $ show' (PUSH i) `shouldBe` "PUSH " <> show i++    -- 80s: Duplication Operations (DUP)+    for_ [minBound..maxBound] $ \nth -> do+      let i = fromEnum nth + 1+      it ("shows DUP" <> show i) $ show' (DUP nth) `shouldBe` ("DUP" <> show i)++    -- 90s: Exchange operations (SWAP)+    for_ [minBound..maxBound] $ \nth -> do+      let i = fromEnum nth + 1+      it ("shows DUP" <> show i) $ show' (SWAP nth) `shouldBe` ("SWAP" <> show i)++    -- a0s: Logging Operations (LOG)+    for_ [minBound..maxBound] $ \nth -> do+      let i = fromEnum nth+      it ("shows DUP" <> show i) $ show' (LOG nth) `shouldBe` ("LOG" <> show i)++    -- f0s: System Operations+    it "shows CREATE" $ show' CREATE `shouldBe` "CREATE"+    it "shows CALL" $ show' CALL `shouldBe` "CALL"+    it "shows CALLCODE" $ show' CALLCODE `shouldBe` "CALLCODE"+    it "shows RETURN" $ show' RETURN `shouldBe` "RETURN"+    it "shows DELEGATECALL" $ show' DELEGATECALL `shouldBe` "DELEGATECALL"+    it "shows CREATE2" $ show' CREATE2 `shouldBe` "CREATE2"+    it "shows STATICCALL" $ show' STATICCALL `shouldBe` "STATICCALL"+    it "shows REVERT" $ show' REVERT `shouldBe` "REVERT"+    it "shows INVALID" $ show' INVALID `shouldBe` "INVALID"+    it "shows SELFDESTRUCT" $ show' SELFDESTRUCT `shouldBe` "SELFDESTRUCT"+  where+    show' :: Opcode -> String+    show' = show  shouldMissErr :: (Show b, Eq b) => Either TranslateError b -> [Label] -> Expectation shouldMissErr x y = x `shouldBe` Left (TranslateError y [])