hevm 0.21 → 0.24

raw patch · 15 files changed

+465/−256 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−1
• hevm-cli/hevm-cli.hs +1/−2
• hevm.cabal +2/−1
• src/EVM.hs +164/−116
• src/EVM/Concrete.hs +26/−53
• src/EVM/Emacs.hs +6/−9
• src/EVM/Format.hs +43/−39
• src/EVM/Hexdump.hs +129/−0
• src/EVM/Op.hs +1/−0
• src/EVM/Solidity.hs +1/−1
• src/EVM/Stepper.hs +5/−5
• src/EVM/TTY.hs +29/−8
• src/EVM/UnitTest.hs +28/−13
• src/EVM/VMTest.hs +1/−1
• test/test.hs +18/−7

@@ -1,6 +1,16 @@ # hevm changelog -## 0.21 - 2018-11-29+## 0.24 - 2019-01-23+ - Fix STATICCALL for precompiled contracts+ - Assume Solidity 0.5.2 in tests++## 0.23 - 2018-12-12+ - Show passing test traces with --verbose flag++## 0.22 - 2018-11-13+ - Simple memory view in TTY++## 0.21 - 2018-10-29  - Fix Hackage package by including C header files for ethjet  ## 0.20 - 2018-10-27

@@ -12,7 +12,6 @@ import EVM.Concrete (w256)  import qualified EVM as EVM-import qualified EVM.Concrete as EVM import qualified EVM.FeeSchedule as FeeSchedule import qualified EVM.Fetch import qualified EVM.Flatten@@ -282,7 +281,7 @@           error "internal error; no EVM result"         Just (EVM.VMFailure e) -> do           die (show e)-        Just (EVM.VMSuccess (EVM.B x)) -> do+        Just (EVM.VMSuccess x) -> do           let hex = BS16.encode x           if ByteString.null hex then pure ()             else do

@@ -1,7 +1,7 @@ name:   hevm version:-  0.21+  0.24 synopsis:   Ethereum virtual machine evaluator description:@@ -46,6 +46,7 @@     EVM.Format,     EVM.Fetch,     EVM.FeeSchedule,+    EVM.Hexdump,     EVM.Op,     EVM.Precompiled,     EVM.Keccak,

@@ -62,7 +62,7 @@   | SelfDestruction   | StackUnderrun   | BadJumpDestination-  | Revert+  | Revert ByteString   | NoSuchContract Addr   | OutOfGas Word Word   | BadCheatCode Word32@@ -76,8 +76,8 @@  -- | The possible result states of a VM data VMResult-  = VMFailure Error  -- ^ An operation failed-  | VMSuccess Blob   -- ^ Reached STOP, RETURN, or end-of-code+  = VMFailure Error -- ^ An operation failed+  | VMSuccess ByteString -- ^ Reached STOP, RETURN, or end-of-code  deriving instance Show VMResult @@ -108,7 +108,7 @@   | QueryTrace Query   | ErrorTrace Error   | EntryTrace Text-  | ReturnTrace Blob FrameContext+  | ReturnTrace ByteString FrameContext  data ExecMode = ExecuteNormally | ExecuteAsVMTest @@ -153,7 +153,7 @@   } deriving Show  -- | A log entry-data Log = Log Addr Blob [Word]+data Log = Log Addr ByteString [Word]  -- | An entry in the VM's "call/create stack" data Frame = Frame@@ -170,7 +170,7 @@     , callContextSize     :: Word     , callContextCodehash :: W256     , callContextAbi      :: Maybe Word-    , callContextData     :: Blob+    , callContextData     :: ByteString     , callContextReversion :: Map Addr Contract     } @@ -181,13 +181,13 @@   , _code         :: ByteString   , _pc           :: Int   , _stack        :: [Word]-  , _memory       :: Memory+  , _memory       :: ByteString   , _memorySize   :: Int-  , _calldata     :: Blob+  , _calldata     :: ByteString   , _callvalue    :: Word   , _caller       :: Addr   , _gas          :: Word-  , _returndata   :: Blob+  , _returndata   :: ByteString   , _static       :: Bool   } @@ -216,7 +216,7 @@ -- | Various environmental data data Env = Env   { _contracts :: Map Addr Contract-  , _sha3Crack :: Map Word Blob+  , _sha3Crack :: Map Word ByteString   , _origin    :: Addr   } @@ -301,7 +301,7 @@     , _code = vmoptCode o     , _contract = vmoptAddress o     , _codeContract = vmoptAddress o-    , _calldata = B $ vmoptCalldata o+    , _calldata = vmoptCalldata o     , _callvalue = w256 $ vmoptValue o     , _caller = vmoptCaller o     , _gas = w256 $ vmoptGas o@@ -357,34 +357,11 @@      fees@(FeeSchedule {..}) = the block schedule -    doStop =-      case vm ^. frames of-        [] ->-          assign result (Just (VMSuccess ""))-        (nextFrame : remainingFrames) -> do-          popTrace-          assign frames remainingFrames-          assign state (view frameState nextFrame)-          case view frameContext nextFrame of-            CreationContext _ -> do-              -- Move back the gas to the parent context-              assign (state . gas) (the state gas)--            CallContext _ _ _ _ _ _ -> do-              -- Take back the remaining gas allowance-              modifying (state . gas) (+ the state gas)-              modifying burned (subtract (the state gas))-          push 1+    doStop = finishFrame (FrameReturned "")    if the state pc >= num (BS.length (the state code))     then-      case view frames vm of-        (nextFrame : remainingFrames) -> do-          assign frames remainingFrames-          assign state (view frameState nextFrame)-          push 1-        [] ->-          assign result (Just (VMSuccess (blob "")))+      doStop      else do       let ?op = BS.index (the state code) (the state pc)@@ -585,7 +562,7 @@                 accessMemoryRange fees memOffset n $ do                   next                   assign (state . stack) xs-                  copyBytesToMemory (blob (view bytecode this))+                  copyBytesToMemory (view bytecode this)                     n codeOffset memOffset             _ -> underrun @@ -625,7 +602,7 @@                   touchAccount (num extAccount) $ \c -> do                     next                     assign (state . stack) xs-                    copyBytesToMemory (blob (view bytecode c))+                    copyBytesToMemory (view bytecode c)                       codeSize codeOffset memOffset             _ -> underrun @@ -817,7 +794,7 @@                     else do                       let                         newAddr =-                          newContractAddress self (forceConcreteWord (view nonce this))+                          newContractAddress self (wordValue (view nonce this))                       case view execMode vm of                         ExecuteAsVMTest -> do                           assign (state . stack) (num newAddr : xs)@@ -826,7 +803,7 @@                         ExecuteNormally -> do                           let                             newCode =-                              forceConcreteBlob $ readMemory (num xOffset) (num xSize) vm+                              readMemory (num xOffset) (num xSize) vm                             newContract =                               initialContract newCode                             newContext  =@@ -913,43 +890,8 @@           case stk of             (xOffset:xSize:_) ->               accessMemoryRange fees xOffset xSize $ do-                case vm ^. frames of-                  [] ->-                    assign result (Just (VMSuccess (readMemory (num xOffset) (num xSize) vm)))--                  (nextFrame : remainingFrames) -> do-                    assign frames remainingFrames--                    case view frameContext nextFrame of-                      CreationContext _ -> do-                        replaceCodeOfSelf (forceConcreteBlob (readMemory (num xOffset) (num xSize) vm))-                        assign state (view frameState nextFrame)--                        -- Move back the gas to the parent context-                        assign (state . gas) (the state gas)--                        push (num (the state contract))-                        popTrace--                      ctx@(CallContext yOffset ySize _ _ _ _) -> do-                        let output = readMemory (num xOffset) (num xSize) vm-                        assign state (view frameState nextFrame)--                        -- Take back the remaining gas allowance-                        modifying (state . gas) (+ the state gas)-                        modifying burned (subtract (the state gas))--                        assign (state . returndata) output-                        copyBytesToMemory-                          output-                          (num ySize)-                          0-                          (num yOffset)-                        push 1--                        insertTrace (ReturnTrace output ctx)-                        popTrace-+                let output = readMemory (num xOffset) (num xSize) vm+                finishFrame (FrameReturned output)             _ -> underrun          -- op: DELEGATECALL@@ -1009,7 +951,12 @@          -- op: REVERT         0xfd ->-          vmError Revert+          case stk of+            (xOffset:xSize:_) ->+              accessMemoryRange fees xOffset xSize $ do+                let output = readMemory (num xOffset) (num xSize) vm+                finishFrame (FrameReverted output)+            _ -> underrun          xxx ->           vmError (UnrecognizedOpcode xxx)@@ -1018,11 +965,22 @@ precompiledContract = do   vm <- get   fees <- use (block . schedule)+  stk <- use (state . stack) -  use (state . stack) >>= \case-    (_:(num -> op):_:inOffset:inSize:outOffset:outSize:xs) ->+  case (?op, stk) of+    -- CALL (includes value)+    (0xf1, (_:(num -> op):_:inOffset:inSize:outOffset:outSize:xs)) ->+      doIt vm fees op inOffset inSize outOffset outSize xs+    -- STATICCALL (does not include value)+    (0xfa, (_:(num -> op):inOffset:inSize:outOffset:outSize:xs)) ->+      doIt vm fees op inOffset inSize outOffset outSize xs+    _ ->+      underrun++  where+    doIt vm fees op inOffset inSize outOffset outSize xs =       let-        input = forceConcreteBlob (readMemory (num inOffset) (num inSize) vm)+        input = readMemory (num inOffset) (num inSize) vm       in         case EVM.Precompiled.execute op input (num outSize) of           Nothing -> do@@ -1039,10 +997,8 @@                 burn cost $ do                   assign (state . stack) (1 : xs)                   modifying (state . memory)-                    (writeMemory (blob output) outSize 0 outOffset)+                    (writeMemory output outSize 0 outOffset)                   next-    _ ->-      underrun  -- * Opcode helper actions @@ -1100,22 +1056,26 @@       touchAccount addr $ \_ ->         accessStorage addr slot continue --- | Replace current contract's code, like when CREATE returns+-- | Replace a contract's code, like when CREATE returns -- from the constructor code.-replaceCodeOfSelf :: ByteString -> EVM ()-replaceCodeOfSelf createdCode = do-  self <- use (state . contract)-  zoom (env . contracts . at self) $ do-    if BS.null createdCode+replaceCode :: Addr -> ByteString -> EVM ()+replaceCode target newCode = do+  zoom (env . contracts . at target) $ do+    if BS.null newCode       then put Nothing       else do         Just now <- get         put . Just $-          initialContract createdCode+          initialContract newCode             & set storage (view storage now)             & set balance (view balance now)             & set nonce   (view nonce now) +replaceCodeOfSelf :: ByteString -> EVM ()+replaceCodeOfSelf newCode = do+  vm <- get+  replaceCode (view (state . contract) vm) newCode+ resetState :: EVM () resetState = do   assign result     Nothing@@ -1187,9 +1147,9 @@   mem <- use (state . memory)   let     abi =-      num (forceConcreteWord (readMemoryWord32 inOffset mem))+      num (wordValue (readMemoryWord32 inOffset mem))     input =-      forceConcreteBlob (sliceMemory (inOffset + 4) (inSize - 4) mem)+      sliceMemory (inOffset + 4) (inSize - 4) mem   case Map.lookup abi cheatActions of     Nothing ->       vmError (BadCheatCode abi)@@ -1205,7 +1165,7 @@             Just (encodeAbiValue -> bs) -> do               next               modifying (state . memory)-                (writeMemory (blob bs) outSize 0 outOffset)+                (writeMemory bs outSize 0 outOffset)               push 1         Left _ ->           vmError (BadCheatCode abi)@@ -1254,7 +1214,7 @@                           if xInSize >= 4                           then                             let-                              w = forceConcreteWord+                              w = wordValue                                     (readMemoryWord32 xInOffset (view (state . memory) vm0))                             in Just $! num w                           else Nothing@@ -1283,36 +1243,123 @@   -- * VM error implementation+ underrun :: EVM () underrun = vmError StackUnderrun -vmError :: Error -> EVM ()-vmError e = do-  vm <- get-  case view frames vm of-    [] -> assign result (Just (VMFailure e))+-- | A stack frame can be popped in three ways.+data FrameResult+  = FrameReturned ByteString -- ^ STOP, RETURN, or no more code+  | FrameReverted ByteString -- ^ REVERT+  | FrameErrored Error -- ^ Any other error+  deriving Show -    (nextFrame : remainingFrames) -> do+-- | This function defines how to pop the current stack frame in either of+-- the ways specified by 'FrameResult'.+--+-- It also handles the case when the current stack frame is the only one;+-- in this case, we set the final '_result' of the VM execution.+finishFrame :: FrameResult -> EVM ()+finishFrame how = do+  oldVm <- get -      insertTrace (ErrorTrace e)+  case view frames oldVm of+    -- Is the current frame the only one?+    [] ->+      assign result . Just $+        case how of+          FrameReturned output -> VMSuccess output+          FrameReverted output -> VMFailure (Revert output)+          FrameErrored e       -> VMFailure e++    -- Are there some remaining frames?+    nextFrame : remainingFrames -> do++      -- Pop the top frame.+      assign frames remainingFrames+      -- Install the state of the frame to which we shall return.+      assign state (view frameState nextFrame)+      -- Insert a debug trace.+      insertTrace $+        case how of+          FrameErrored e ->+            ErrorTrace e+          FrameReverted output ->+            ErrorTrace (Revert output)+          FrameReturned output ->+            ReturnTrace output (view frameContext nextFrame)+      -- Pop to the previous level of the debug trace stack.       popTrace +      let remainingGas = view (state . gas) oldVm++      -- Now dispatch on whether we were creating or calling,+      -- and whether we shall return, revert, or error (six cases).       case view frameContext nextFrame of++        -- Were we calling?+        CallContext (num -> outOffset) (num -> outSize) _ _ _ reversion -> do++          let+            -- When entering a call, the gas allowance is counted as burned+            -- in advance; this unburns the remainder and adds it to the+            -- parent frame.+            reclaimRemainingGasAllowance = do+              modifying burned (subtract remainingGas)+              modifying (state . gas) (+ remainingGas)++            revertContracts = assign (env . contracts) reversion++          case how of+            -- Case 1: Returning from a call?+            FrameReturned output -> do+              assign (state . returndata) output+              copyBytesToMemory output outSize 0 outOffset+              reclaimRemainingGasAllowance+              push 1++            -- Case 2: Reverting during a call?+            FrameReverted output -> do+              revertContracts+              assign (state . returndata) output+              reclaimRemainingGasAllowance+              push 0++            -- Case 3: Error during a call?+            FrameErrored _ -> do+              revertContracts+              push 0++        -- Or were we creating?         CreationContext _ -> do-          assign frames remainingFrames-          assign state (view frameState nextFrame)-          assign (state . gas) 0-          push 0-          let self = vm ^. state . contract-          assign (env . contracts . at self) Nothing+          let+            createe = view (state . contract) oldVm+            destroy = assign (env . contracts . at createe) Nothing -        CallContext _ _ _ _ _ reversion -> do-          assign frames remainingFrames-          assign state (view frameState nextFrame)-          assign (env . contracts) reversion-          push 0+          case how of+            -- Case 4: Returning during a creation?+            FrameReturned output -> do+              replaceCode createe output+              assign (state . gas) remainingGas+              push (num createe) +            -- Case 5: Reverting during a creation?+            FrameReverted output -> do+              destroy+              assign (state . returndata) output+              assign (state . gas) remainingGas+              push 0 +            -- Case 6: Error during a creation?+            FrameErrored _ -> do+              destroy+              assign (state . gas) 0+              push 0+++vmError :: Error -> EVM ()+vmError e = finishFrame (FrameErrored e)+ -- * Memory helpers  accessMemoryRange@@ -1337,7 +1384,7 @@ accessMemoryWord fees x continue = accessMemoryRange fees x 32 continue  copyBytesToMemory-  :: Blob -> Word -> Word -> Word -> EVM ()+  :: ByteString -> Word -> Word -> Word -> EVM () copyBytesToMemory bs size xOffset yOffset =   if size == 0 then noop   else do@@ -1345,13 +1392,13 @@     assign (state . memory) $       writeMemory bs size xOffset yOffset mem -readMemory :: Word -> Word -> VM -> Blob+readMemory :: Word -> Word -> VM -> ByteString readMemory offset size vm = sliceMemory offset size (view (state . memory) vm)  word256At   :: Functor f   => Word -> (Word -> f Word)-  -> Memory -> f Memory+  -> ByteString -> f ByteString word256At i = lens getter setter where   getter m = readMemoryWord i m   setter m x = setMemoryWord i x m@@ -1619,6 +1666,7 @@   0xf3 -> OpReturn   0xf4 -> OpDelegatecall   0xfd -> OpRevert+  0xfa -> OpStaticcall   0xff -> OpSelfdestruct   _    -> (OpUnknown x) 

@@ -16,7 +16,6 @@ import Data.DoubleWord (signedWord, unsignedWord) import Data.Maybe      (fromMaybe) import Data.Semigroup  ((<>))-import Data.String     (IsString) import Data.Word       (Word8)  import qualified Data.ByteString as BS@@ -45,16 +44,10 @@ w256 :: W256 -> Word w256 = C Dull -blob :: ByteString -> Blob-blob = B- data Word = C Whiff W256-newtype Blob = B ByteString-newtype Byte = ConcreteByte Word8-newtype Memory = ConcreteMemory ByteString -wordToByte :: Word -> Byte-wordToByte (C _ x) = ConcreteByte (num (x .&. 0xff))+wordToByte :: Word -> Word8+wordToByte (C _ x) = num (x .&. 0xff)  exponentiate :: Word -> Word -> Word exponentiate (C _ x) (C _ y) = w256 (x ^ y)@@ -95,18 +88,15 @@ sgt (C _ (W256 x)) (C _ (W256 y)) =   if signedWord x > signedWord y then w256 1 else w256 0 -forceConcreteBlob :: Blob -> ByteString-forceConcreteBlob (B x) = x--forceConcreteWord :: Word -> W256-forceConcreteWord (C _ x) = x+wordValue :: Word -> W256+wordValue (C _ x) = x -sliceMemory :: (Integral a, Integral b) => a -> b -> Memory -> Blob-sliceMemory o s (ConcreteMemory m) =-  B $ byteStringSliceWithDefaultZeroes (num o) (num s) m+sliceMemory :: (Integral a, Integral b) => a -> b -> ByteString -> ByteString+sliceMemory o s m =+  byteStringSliceWithDefaultZeroes (num o) (num s) m -writeMemory :: Blob -> Word -> Word -> Word -> Memory -> Memory-writeMemory (B bs1) (C _ n) (C _ src) (C _ dst) (ConcreteMemory bs0) =+writeMemory :: ByteString -> Word -> Word -> Word -> ByteString -> ByteString+writeMemory bs1 (C _ n) (C _ src) (C _ dst) bs0 =   if src > num (BS.length bs1)   then     let@@ -114,19 +104,17 @@       c      = BS.replicate (num n) 0       b'     = BS.drop (num n) b     in-      ConcreteMemory $-        a <> c <> b'+      a <> c <> b'   else     let       (a, b) = BS.splitAt (num dst) bs0       c      = BS.take (num n) (BS.drop (num src) bs1)       b'     = BS.drop (num n) b     in-      ConcreteMemory $-        a <> BS.replicate (num dst - BS.length a) 0 <> c <> b'+      a <> BS.replicate (num dst - BS.length a) 0 <> c <> b' -readMemoryWord :: Word -> Memory -> Word-readMemoryWord (C _ i) (ConcreteMemory m) =+readMemoryWord :: Word -> ByteString -> Word+readMemoryWord (C _ i) m =   let     go !a (-1) = a     go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m)@@ -134,8 +122,8 @@   in {-# SCC readMemoryWord #-}     w256 $ go (0 :: W256) (31 :: Int) -readMemoryWord32 :: Word -> Memory -> Word-readMemoryWord32 (C _ i) (ConcreteMemory m) =+readMemoryWord32 :: Word -> ByteString -> Word+readMemoryWord32 (C _ i) m =   let     go !a (-1) = a     go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m)@@ -143,40 +131,25 @@   in {-# SCC readMemoryWord32 #-}     w256 $ go (0 :: W256) (3 :: Int) -setMemoryWord :: Word -> Word -> Memory -> Memory+setMemoryWord :: Word -> Word -> ByteString -> ByteString setMemoryWord (C _ i) (C _ x) m =-  writeMemory (B (word256Bytes x)) 32 0 (num i) m+  writeMemory (word256Bytes x) 32 0 (num i) m -setMemoryByte :: Word -> Byte -> Memory -> Memory-setMemoryByte (C _ i) (ConcreteByte x) m =-  writeMemory (B (BS.singleton x)) 1 0 (num i) m+setMemoryByte :: Word -> Word8 -> ByteString -> ByteString+setMemoryByte (C _ i) x m =+  writeMemory (BS.singleton x) 1 0 (num i) m -readBlobWord :: Word -> Blob -> Word-readBlobWord (C _ i) (B x) =+readBlobWord :: Word -> ByteString -> Word+readBlobWord (C _ i) x =   if i > num (BS.length x)   then 0   else w256 (wordAt (num i) x) -blobSize :: Blob -> Word-blobSize (B x) = w256 (num (BS.length x))--keccakBlob :: Blob -> Word-keccakBlob (B x) = C (FromKeccak x) (keccak x)+blobSize :: ByteString -> Word+blobSize x = w256 (num (BS.length x)) -deriving instance Bits Byte-deriving instance FiniteBits Byte-deriving instance Enum Byte-deriving instance Eq Byte-deriving instance Integral Byte-deriving instance IsString Blob-deriving instance Semigroup Blob-deriving instance Monoid Blob-deriving instance Semigroup Memory-deriving instance Monoid Memory-deriving instance Num Byte-deriving instance Ord Byte-deriving instance Real Byte-deriving instance Show Blob+keccakBlob :: ByteString -> Word+keccakBlob x = C (FromKeccak x) (keccak x)  instance Show Word where   show (C Dull x) = show x

@@ -410,9 +410,6 @@   sexp x =     L [A "frame", sexp (view frameContext x), sexp (view frameState x)] -instance SDisplay Blob where-  sexp (B x) = sexp x- instance SDisplay FrameContext where   sexp _x = A "some-context" @@ -422,7 +419,7 @@       , L [A "code-contract", sexp (view codeContract x)]       , L [A "pc", A (txt (view pc x))]       , L [A "stack", sexp (view stack x)]-      , L [A "memory", sexp (view memory x)]+      , L [A "memory", sexpMemory (view memory x)]       ]  instance SDisplay a => SDisplay [a] where@@ -436,11 +433,11 @@ instance SDisplay ByteString where   sexp = A . txt . pack . showByteStringWith0x -instance SDisplay Memory where-  sexp (ConcreteMemory bs) =-    if BS.length bs > 1024-    then L [A "large-memory", A (txt (BS.length bs))]-    else sexp bs+sexpMemory :: ByteString -> SExpr Text+sexpMemory bs =+  if BS.length bs > 1024+  then L [A "large-memory", A (txt (BS.length bs))]+  else sexp bs  defaultUnitTestOptions :: MonadIO m => m UnitTestOptions defaultUnitTestOptions = do

@@ -2,17 +2,17 @@  import Prelude hiding (Word) -import EVM (VM, cheatCode, traceForest, traceData)+import EVM (VM, cheatCode, traceForest, traceData, Error (..)) import EVM (Trace, TraceData (..), Log (..), Query (..), FrameContext (..)) import EVM.Dapp (DappInfo, dappSolcByHash, showTraceLocation, dappEventMap)-import EVM.Concrete (Word (..), Blob (..))+import EVM.Concrete (Word (..)) import EVM.Types (W256 (..), num) import EVM.ABI (AbiValue (..), Event (..), AbiType (..)) import EVM.ABI (Indexed (Indexed, NotIndexed), getAbiSeq, getAbi) import EVM.ABI (abiTypeSolidity, parseTypeName) import EVM.Solidity (SolcContract, contractName, abiMap) import EVM.Solidity (methodOutput, methodSignature)-import EVM.Concrete (forceConcreteBlob, forceConcreteWord)+import EVM.Concrete (wordValue)  import Control.Arrow ((>>>)) import Control.Lens (view, preview, ix, _2, to, _Just)@@ -149,9 +149,26 @@     EventTrace (Log _ bytes topics) ->       case topics of         (t:_) ->-          formatLog-            (getEvent t (view dappEventMap dapp))-            (forceConcreteBlob bytes) <> pos+          let event = getEvent t (view dappEventMap dapp)+              -- indexed types are in the remaining topics+              types = getEventUnindexedTypes event+          in case event of+            -- todo: catch ds-note in Anonymous case+            Just (Event name _ _) ->+              mconcat+                [ "\x1b[36m"+                , name+                , showEvent types bytes+                , "\x1b[0m"+                ] <> pos+            Nothing ->+              mconcat+                [ "\x1b[36m"+                , "<unknown-event> "+                , formatBinary bytes+                , mconcat (map (pack . show) topics)+                , "\x1b[0m"+                ] <> pos         _ ->           "log" <> pos     QueryTrace q ->@@ -161,18 +178,22 @@         PleaseFetchSlot addr slot _ ->           "fetch storage slot " <> pack (show slot) <> " from " <> pack (show addr) <> pos     ErrorTrace e ->-      "\x1b[91merror\x1b[0m " <> pack (show e) <> pos+      case e of+        Revert output ->+          "\x1b[91merror\x1b[0m " <> "Revert " <> formatBinary output <> pos+        _ ->+          "\x1b[91merror\x1b[0m " <> pack (show e) <> pos      ReturnTrace output (CallContext _ _ hash (Just abi) _ _) ->       case getAbiMethodOutput dapp hash abi of         Nothing ->-          "← " <> formatBinary (forceConcreteBlob output)+          "← " <> formatBinary output         Just (_, t) ->-          "← " <> abiTypeSolidity t <> " " <> showValue t (forceConcreteBlob output)+          "← " <> abiTypeSolidity t <> " " <> showValue t output     ReturnTrace output (CallContext {}) ->-      "← " <> formatBinary (forceConcreteBlob output)-    ReturnTrace _ (CreationContext {}) ->-      error "internal error: shouldn't show returns for creates"+      "← " <> formatBinary output+    ReturnTrace output (CreationContext {}) ->+      "← " <> pack (show (BS.length output)) <> " bytes of code"      EntryTrace t ->       t@@ -190,9 +211,9 @@             <> maybe ("[fallback function]")                  (\x -> maybe "[unknown method]" id (maybeAbiName solc x))                  abi-            <> maybe ("(" <> formatBinary (forceConcreteBlob calldata) <> ")")+            <> maybe ("(" <> formatBinary calldata <> ")")                  -- todo: if unknown method, then just show raw calldata-                 (\x -> showCall (catMaybes x) (forceConcreteBlob calldata))+                 (\x -> showCall (catMaybes x) calldata)                  (abi >>= fmap getAbiTypes . maybeAbiName solc)             <> "\x1b[0m"             <> pos@@ -221,6 +242,13 @@     Right (_, _, xs) -> showAbiValues xs     Left (_, _, _)   -> formatBinary bs +showEvent :: [AbiType] -> ByteString -> Text+showEvent ts bs =+  case runGetOrFail (getAbiSeq (length ts) ts)+            (fromStrict bs) of+    Right (_, _, abivals) -> showAbiValues abivals+    Left (_,_,_) -> error "lol"+ showValue :: AbiType -> ByteString -> Text showValue t bs =   case runGetOrFail (getAbi t) (fromStrict bs) of@@ -240,26 +268,8 @@ contractPathPart :: Text -> Text contractPathPart x = Text.split (== ':') x !! 0 --- TODO: this should take Log-formatLog :: Maybe Event -> ByteString -> Text-formatLog event args =-  let types = getEventUnindexedTypes event-      name  = getEventName event-  in-  case runGetOrFail (getAbiSeq (length types) types)-                      (fromStrict args) of-                    Right (_, _, abivals) ->-                      mconcat-                        [ "\x1b[36m"-                        , name-                        , showAbiValues abivals-                        , "\x1b[0m"-                        ]-                    Left (_,_,_) ->-                      error "lol"- getEvent :: Word -> Map W256 Event -> Maybe Event-getEvent w events = Map.lookup (forceConcreteWord w) events+getEvent w events = Map.lookup (wordValue w) events  getEventName :: Maybe Event -> Text getEventName (Just (Event name _ _)) = name@@ -272,9 +282,3 @@ getEventIndexedTypes :: Maybe Event -> [AbiType] getEventIndexedTypes Nothing = [] getEventIndexedTypes (Just (Event _ _ xs)) = [x | (x, Indexed) <- xs]--getEventArgs :: Blob -> Text-getEventArgs b = formatBlob b--formatBlob :: Blob -> Text-formatBlob b = decodeUtf8 $ forceConcreteBlob b

@@ -0,0 +1,129 @@+-- Copyright (c) 2011, Galois Inc.  All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are met:+-- +--     * Redistributions of source code must retain the above copyright+--       notice, this list of conditions and the following disclaimer.+-- +--     * Redistributions in binary form must reproduce the above+--       copyright notice, this list of conditions and the following+--       disclaimer in the documentation and/or other materials provided+--       with the distribution.+-- +--     * Neither the name of Trevor Elliott nor the names of other+--       contributors may be used to endorse or promote products derived+--       from this software without specific prior written permission.+-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+--++module EVM.Hexdump (prettyHex, simpleHex) where++import Data.ByteString                       (ByteString)+import qualified Data.ByteString       as B  (length, unpack)+import qualified Data.ByteString.Char8 as B8 (unpack)+import Data.Char                             (isAscii, isControl)+import Data.List                             (intercalate, transpose, unfoldr)+import Numeric                               (showHex)++byteWidth :: Num a => a+byteWidth    = 2  -- Width of an padded 'Word8'++numWordBytes :: Num a => a+numWordBytes = 4  -- Number of bytes to group into a 32-bit word++-- |'prettyHex' renders a 'ByteString' as a multi-line 'String' complete with+-- addressing, hex digits, and ASCII representation.+--+-- Sample output+--+-- @Length: 100 (0x64) bytes+--0000:   4b c1 ad 8a  5b 47 d7 57  48 64 e7 cc  5e b5 2f 6e   K...[G.WHd..^./n+--0010:   c5 b3 a4 73  44 3b 97 53  99 2d 54 e7  1b 2f 91 12   ...sD;.S.-T../..+--0020:   c8 1a ff c4  3b 2b 72 ea  97 e2 9f e2  93 ad 23 79   ....;+r.......#y+--0030:   e8 0f 08 54  02 14 fa 09  f0 2d 34 c9  08 6b e1 64   ...T.....-4..k.d+--0040:   d1 c5 98 7e  d6 a1 98 e2  97 da 46 68  4e 60 11 15   ...~......FhN`..+--0050:   d8 32 c6 0b  70 f5 2e 76  7f 8d f2 3b  ed de 90 c6   .2..p..v...;....+--0060:   93 12 9c e1                                          ....@+prettyHex :: Int -> ByteString -> String+prettyHex hexDisplayWidth bs = unlines (header : body)+ where+  numLineWords    = 4  -- Number of words to group onto a line+  addressWidth    = 4  -- Minimum width of a padded address+  numLineBytes    = numLineWords * numWordBytes -- Number of bytes on a line+  replacementChar = '.' -- 'Char' to use for non-printable characters++  header = "Length: " ++ show    (B.length bs)+        ++ " (0x"     ++ showHex (B.length bs) ") bytes"++  body = map (intercalate "   ")+       $ transpose [mkLineNumbers, mkHexDisplay bs, mkAsciiDump bs]++  mkHexDisplay+    = padLast hexDisplayWidth+    . map (intercalate "  ") . group numLineWords+    . map (intercalate " ")  . group numWordBytes+    . map (paddedShowHex byteWidth)+    . B.unpack++  mkAsciiDump = group numLineBytes . cleanString . B8.unpack++  cleanString = map go+   where+    go x | isWorthPrinting x = x+         | otherwise         = replacementChar++  mkLineNumbers = [paddedShowHex addressWidth (x * numLineBytes) ++ ":"+                   | x <- [0 .. (B.length bs - 1) `div` numLineBytes] ]++  padLast w [x]         = [x ++ replicate (w - length x) ' ']+  padLast w (x:xs)      = x : padLast w xs+  padLast _ []          = []++-- |'paddedShowHex' displays a number in hexidecimal and pads the number+-- with 0 so that it has a minimum length of @w@.+paddedShowHex :: (Show a, Integral a) => Int -> a -> String+paddedShowHex w n = pad ++ str+    where+     str = showHex n ""+     pad = replicate (w - length str) '0'+++-- |'simpleHex' converts a 'ByteString' to a 'String' showing the octets+-- grouped in 32-bit words.+--+-- Sample output+--+-- @4b c1 ad 8a  5b 47 d7 57@+simpleHex :: ByteString -> String+simpleHex = intercalate "  "+          . map (intercalate " ") . group numWordBytes+          . map (paddedShowHex byteWidth)+          . B.unpack++-- |'isWorthPrinting' returns 'True' for non-control ascii characters.+-- These characters will all fit in a single character when rendered.+isWorthPrinting :: Char -> Bool+isWorthPrinting x = isAscii x && not (isControl x)++-- |'group' breaks up a list into sublists of size @n@. The last group+-- may be smaller than @n@ elements. When @n@ less not positive the+-- list is returned as one sublist.+group :: Int -> [a] -> [[a]]+group n+ | n <= 0    = (:[])+ | otherwise = unfoldr go+  where+    go [] = Nothing+    go xs = Just (splitAt n xs)

@@ -63,6 +63,7 @@   | OpJumpdest   | OpCreate   | OpCall+  | OpStaticcall   | OpCallcode   | OpReturn   | OpDelegatecall

@@ -318,7 +318,7 @@ solidity' :: Text -> IO (Text, Text) solidity' src = withSystemTempFile "hevm.sol" $ \path handle -> do   hClose handle-  writeFile path ("pragma solidity ^0.4.8;\n" <> src)+  writeFile path ("pragma solidity ^0.5.2;\n" <> src)   x <- pack <$>     readProcess       "solc"

@@ -36,8 +36,8 @@ import qualified EVM  import EVM.ABI (AbiType, AbiValue, getAbi)-import EVM.Concrete (Blob (B)) +import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LazyByteString  -- | The instruction type of the operational monad@@ -86,7 +86,7 @@ note = singleton . Note  -- | Run the VM until final result, resolving all queries-execFully :: Stepper (Either Error Blob)+execFully :: Stepper (Either Error ByteString) execFully =   exec >>= \case     VMFailure (Query q) ->@@ -96,12 +96,12 @@     VMSuccess x ->       pure (Right x) -execFullyOrFail :: Stepper Blob+execFullyOrFail :: Stepper ByteString execFullyOrFail = execFully >>= either (fail . VMFailed) pure  -- | Decode a blob as an ABI value, failing if ABI encoding wrong-decode :: AbiType -> Blob -> Stepper AbiValue-decode abiType (B bytes) =+decode :: AbiType -> ByteString -> Stepper AbiValue+decode abiType bytes =   case runGetOrFail (getAbi abiType) (LazyByteString.fromStrict bytes) of     Right ("", _, x) ->       pure x

@@ -20,6 +20,7 @@ import EVM.Format (Signedness (..), showDec, showWordExact) import EVM.Format (showTraceTree) import EVM.Format (contractNamePart, contractPathPart)+import EVM.Hexdump (prettyHex) import EVM.Op import EVM.Solidity import EVM.Types hiding (padRight)@@ -83,6 +84,7 @@   , _uiVmFirstState   :: UiVmState   , _uiVmMessage      :: Maybe String   , _uiVmNotes        :: [String]+  , _uiVmShowMemory   :: Bool   }  data UiTestPickerState = UiTestPickerState@@ -260,6 +262,7 @@            , _uiVmFirstState = undefined            , _uiVmMessage = Just "Executing EVM code"            , _uiVmNotes = []+           , _uiVmShowMemory = False            }     ui1 = updateUiVmState ui0 vm & set uiVmFirstState ui1 @@ -414,15 +417,19 @@               -- and execute n - 1 instructions from there.               --               -- We keep the current cache so we don't have to redo-              -- any blocking queries.+              -- any blocking queries, and also the memory view.               let                 s0 = view uiVmFirstState s-                s1 = set (uiVm . cache) (view (uiVm . cache) s) s0+                s1 = set (uiVm . cache)   (view (uiVm . cache) s) s0+                s2 = set (uiVmShowMemory) (view uiVmShowMemory s) s1                -- Take n steps; "timidly," because all queries               -- ought to be cached.-              takeStep s1 StepTimidly (StepMany (n - 1))+              takeStep s2 StepTimidly (StepMany (n - 1)) +        (UiVmScreen s, VtyEvent (Vty.EvKey (Vty.KChar 'm') [])) ->+          continue (UiVmScreen (over uiVmShowMemory not s))+         (UiTestPickerScreen s', VtyEvent (Vty.EvKey (Vty.KEnter) [])) -> do           case listSelectedElement (view testPickerList s') of             Nothing -> error "nothing selected"@@ -471,6 +478,7 @@         , _uiVmFirstState   = undefined         , _uiVmMessage      = Just "Creating unit test contract"         , _uiVmNotes        = []+        , _uiVmShowMemory   = False         }     Just testContract =       view (dappSolcByName . at theContractName) dapp@@ -591,6 +599,7 @@       , ("N", "step more")       , ("C-n", "step over") --      , ("  Enter", "browse")+      , ("m", "toggle memory")       , ("  Esc", "exit")       ] @@ -751,11 +760,22 @@  drawTracePane :: UiVmState -> UiWidget drawTracePane ui =-  hBorderWithLabel (txt "Trace") <=>-    renderList-      (\_ x -> txt x)-      False-      (view uiVmTraceList ui)+  case view uiVmShowMemory ui of+    False ->+      hBorderWithLabel (txt "Trace") <=>+        renderList+          (\_ x -> txt x)+          False+          (view uiVmTraceList ui)+    True ->+      vBox+      [ hBorderWithLabel (txt "Calldata") <=>+          str (prettyHex 40 (view (uiVm . state . calldata) ui))+      , hBorderWithLabel (txt "Returndata") <=>+          str (prettyHex 40 (view (uiVm . state . returndata) ui))+      , hBorderWithLabel (txt "Memory") <=>+          str (prettyHex 40 (view (uiVm . state . memory) ui))+      ]  drawSolidityPane :: UiVmState -> UiWidget drawSolidityPane ui@(view uiVmDapp -> Just dapp) =@@ -880,6 +900,7 @@   OpJumpdest -> txt "JUMPDEST"   OpCreate -> txt "CREATE"   OpCall -> txt "CALL"+  OpStaticcall -> txt "STATICCALL"   OpCallcode -> txt "CALLCODE"   OpReturn -> txt "RETURN"   OpDelegatecall -> txt "DELEGATECALL"

@@ -13,7 +13,7 @@ import EVM.Keccak import EVM.Solidity import EVM.Types-import EVM.Concrete (blob, w256, forceConcreteBlob, Blob (B), wordAt)+import EVM.Concrete (w256, wordAt)  import qualified EVM.FeeSchedule as FeeSchedule @@ -107,7 +107,7 @@   Stepper.evm (pushTrace (EntryTrace "constructor"))    -- Constructor is loaded; run until it returns code-  B bytes <- Stepper.execFullyOrFail+  bytes <- Stepper.execFullyOrFail   addr <- Stepper.evm (use (state . contract))    -- Mutate the current contract to use the new code@@ -428,22 +428,25 @@                in                  pure                    ( "PASS " <> testName <> " (gas: " <> gasText <> ")"-                   , Right (passOutput vm testName)+                   , Right (passOutput vm dapp opts testName)                    )              (Right False, vm) ->-               pure ("FAIL " <> testName, Left (failOutput vm dapp testName))+               pure ("FAIL " <> testName, Left (failOutput vm dapp opts testName))              (Left _, _)       ->                pure ("OOPS " <> testName, Left ("VM error for " <> testName))-        inform = \(x, y) -> Text.putStrLn x >> pure y +      let inform = \(x, y) -> Text.putStrLn x >> pure y+       -- Run all the test cases and print their status updates       details <-         mapM (\x -> runOne x >>= inform) testNames +      let mails = [x | Right x <- details]       let fails = [x | Left x <- details]        tick "\n"-      tick (Text.unlines fails)+      tick (Text.unlines (filter (not . Text.null) mails))+      tick (Text.unlines (filter (not . Text.null) fails))        pure (null fails) @@ -452,11 +455,23 @@   let p = Text.replicate n " "   in Text.unlines (map (p <>) (Text.lines s)) -passOutput :: VM -> Text -> Text-passOutput _ testName = "PASS " <> testName+passOutput :: VM -> DappInfo -> UnitTestOptions -> Text -> Text+passOutput vm dapp UnitTestOptions { .. } testName =+  case verbose of+    True ->+      mconcat $+        [ "Success: "+        , fromMaybe "" (stripSuffix "()" testName)+        , "\n"+        , indentLines 2 (formatTestLogs (view dappEventMap dapp) (view logs vm))+        , indentLines 2 (showTraceTree dapp vm)+        , "\n"+        ]+    False ->+      "" -failOutput :: VM -> DappInfo -> Text -> Text-failOutput vm dapp testName = mconcat $+failOutput :: VM -> DappInfo -> UnitTestOptions -> Text -> Text+failOutput vm dapp _ testName = mconcat $   [ "Failure: "   , fromMaybe "" (stripSuffix "()" testName)   , "\n"@@ -473,10 +488,9 @@  formatTestLog :: Map W256 Event -> Log -> Maybe Text formatTestLog _ (Log _ _ []) = Nothing-formatTestLog events (Log _ b (t:_)) =+formatTestLog events (Log _ args (t:_)) =   let     name  = getEventName event-    args  = forceConcreteBlob b     event = getEvent t events    in case name of@@ -494,6 +508,7 @@           val = BS.drop 44 args       in Just $ formatString key <> ": " <> formatBinary val +  -- TODO: event logs (bytes);   -- TODO: event log_named_decimal_int  (bytes32 key, int val, uint decimals);   -- TODO: event log_named_decimal_uint (bytes32 key, uint val, uint decimals); @@ -517,7 +532,7 @@ setupCall target abi allowance = do   resetState   loadContract target-  assign (state . calldata) (blob (word32Bytes (abiKeccak (encodeUtf8 abi))))+  assign (state . calldata) (word32Bytes (abiKeccak (encodeUtf8 abi)))   assign (state . gas) (w256 allowance)  initialUnitTestVm :: UnitTestOptions -> SolcContract -> [SolcContract] -> VM

@@ -63,7 +63,7 @@ checkExpectation :: Case -> EVM.VM -> IO Bool checkExpectation x vm =   case (testExpectation x, view EVM.result vm) of-    (Just expectation, Just (EVM.VMSuccess (EVM.B output))) -> do+    (Just expectation, Just (EVM.VMSuccess output)) -> do       let         (s1, b1) = ("bad-state", checkExpectedContracts vm (expectedContracts expectation))         (s2, b2) = ("bad-output", checkExpectedOut output (expectedOut expectation))

@@ -15,7 +15,6 @@ import Control.Monad.State.Strict (execState, runState) import Control.Lens -import Data.Monoid import qualified Data.Vector as Vector import Data.String.Here @@ -24,7 +23,6 @@  import EVM import EVM.ABI-import EVM.Concrete import EVM.Exec import EVM.Solidity import EVM.Types@@ -51,7 +49,7 @@           [AbiUInt 8 0] ===> AbiUInt 8 255      , testCase "keccak256()" $ do-        SolidityCall "x = uint(keccak256(a));"+        SolidityCall "x = uint(keccak256(abi.encodePacked(a)));"           [AbiString ""] ===> AbiUInt 256 0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470     ] @@ -63,7 +61,7 @@           s = "0x1542b6457e91098682138856165381453b3d0acae2470286fd8c8a09914b1b5d"         in SolidityCall              (Text.unlines-               [ "bytes32 h = keccak256(\"\\x19Ethereum Signed Message:\\n32\", d);"+               [ "bytes32 h = keccak256(abi.encodePacked(\"\\x19Ethereum Signed Message:\\n32\", d));"                , "x = ecrecover(h, a, b, c);"                ])              [ AbiUInt 8 28@@ -74,6 +72,7 @@              ===>              AbiAddress 0x2d5e56d45c63150d937f2182538a0f18510cb11f     ]+   , testGroup "Precompiled contracts" $       [ testGroup "Example (reverse)"           [ testCase "success" $@@ -138,6 +137,17 @@     contract ${x} { ${s} }   |] +defaultDataLocation :: AbiType -> Text+defaultDataLocation t =+  if (case t of+        AbiBytesDynamicType -> True+        AbiStringType -> True+        AbiArrayDynamicType _ -> True+        AbiArrayType _ _ -> True+        _ -> False)+  then "memory"+  else ""+ runStatements   :: Text -> [AbiValue] -> AbiType   -> IO (Maybe ByteString)@@ -145,6 +155,7 @@   let params =         Text.intercalate ", "           (map (\(x, c) -> abiTypeSolidity (abiValueType x)+                             <> " " <> defaultDataLocation (abiValueType x)                              <> " " <> Text.pack [c])             (zip args "abcdefg"))       sig =@@ -158,7 +169,7 @@   |]    case runState exec (vmForEthrunCreation x) of-    (VMSuccess (B targetCode), vm1) -> do+    (VMSuccess targetCode, vm1) -> do       let target = view (state . contract) vm1           vm2 = execState (replaceCodeOfSelf targetCode) vm1       case flip runState vm2@@ -166,9 +177,9 @@                  assign (state . gas) 0xffffffffffffffff -- kludge                  loadContract target                  assign (state . calldata)-                   (B (abiCalldata sig (Vector.fromList args)))+                   (abiCalldata sig (Vector.fromList args))                  exec) of-        (VMSuccess (B out), _) ->+        (VMSuccess out, _) ->           return (Just out)         (VMFailure problem, _) -> do           print problem