adding access lists

src/hevm/hevm-cli/hevm-cli.hs

@@ -757,6 +757,7 @@ vmFromCommand cmd = do
           , EVM.vmoptChainId       = word chainid 1
           , EVM.vmoptCreate        = create cmd
           , EVM.vmoptStorageModel  = ConcreteS
+          , EVM.vmoptTxAccessList  = mempty -- TODO: support me soon        
           }
         word f def = fromMaybe def (f cmd)
         addr f def = fromMaybe def (f cmd)
@@ -862,6 +863,7 @@ symvmFromCommand cmd = do
       , EVM.vmoptChainId       = word chainid 1
       , EVM.vmoptCreate        = create cmd
       , EVM.vmoptStorageModel  = fromMaybe SymbolicS (storageModel cmd)
+      , EVM.vmoptTxAccessList  = mempty
       }
     word f def = fromMaybe def (f cmd)
     addr f def = fromMaybe def (f cmd)

src/hevm/src/EVM.hs

@@ -201,6 +201,7 @@ data VMOpts = VMOpts
   , vmoptChainId :: W256
   , vmoptCreate :: Bool
   , vmoptStorageModel :: StorageModel
+  , vmoptTxAccessList :: Map Addr [W256]
   } deriving Show
 
 -- | A log entry
@@ -255,14 +256,15 @@ data FrameState = FrameState
 
 -- | The state that spans a whole transaction
 data TxState = TxState
-  { _gasprice        :: Word
-  , _txgaslimit      :: Word
-  , _origin          :: Addr
-  , _toAddr          :: Addr
-  , _value           :: SymWord
-  , _substate        :: SubState
-  , _isCreate        :: Bool
-  , _txReversion     :: Map Addr Contract
+  { _gasprice            :: Word
+  , _txgaslimit          :: Word
+  , _origin              :: Addr
+  , _toAddr              :: Addr
+  , _value               :: SymWord
+  , _substate            :: SubState
+  , _accessList :: Map Addr [W256]
+  , _isCreate            :: Bool
+  , _txReversion         :: Map Addr Contract
   }
   deriving (Show)
 
@@ -271,7 +273,7 @@ data SubState = SubState
   { _selfdestructs   :: [Addr]
   , _touchedAccounts :: [Addr]
   , _accessedAddresses :: Set Addr
-  , _accessedStorageKeys :: Set (Addr, Word)
+  , _accessedStorageKeys :: Set (Addr, W256)
   , _refunds         :: [(Addr, Integer)]
   -- in principle we should include logs here, but do not for now
   }
@@ -432,6 +434,7 @@ makeVm o = VM
     , _toAddr = vmoptAddress o
     , _value = vmoptValue o
     , _substate = SubState mempty mempty mempty mempty mempty
+    , _accessList = vmoptTxAccessList o
     , _isCreate = vmoptCreate o
     , _txReversion = Map.fromList
       [(vmoptAddress o, vmoptContract o)]
@@ -1886,8 +1889,9 @@ accessStorageForGas addr key = do
   accessedStrkeys <- use (tx . substate . accessedStorageKeys)
   case maybeLitWord key of
     Just litword -> do
-      let accessed = member (addr, litword) accessedStrkeys
-      assign (tx . substate . accessedStorageKeys) (insert (addr, litword) accessedStrkeys)
+      let litword256 = wordValue litword
+      let accessed = member (addr, litword256) accessedStrkeys
+      assign (tx . substate . accessedStorageKeys) (insert (addr, litword256) accessedStrkeys)
       return accessed
     _ -> return False
 

src/hevm/src/EVM/Exec.hs

@@ -40,6 +40,7 @@ vmForEthrunCreation creationCode =
     , vmoptChainId = 1
     , vmoptCreate = False
     , vmoptStorageModel = ConcreteS
+    , vmoptTxAccessList = mempty  -- TODO is this right 
     }) & set (env . contracts . at ethrunAddress)
              (Just (initialContract (RuntimeCode mempty)))
 

src/hevm/src/EVM/FeeSchedule.hs

@@ -48,6 +48,8 @@ data FeeSchedule n = FeeSchedule
   , g_cold_sload :: n
   , g_cold_account_access :: n
   , g_warm_storage_read :: n
+  , g_access_list_address :: n
+  , g_access_list_storage_key :: n
   } deriving Show
 
 -- For the purposes of this module, we define an EIP as just a fee
@@ -121,6 +123,8 @@ homestead = FeeSchedule
   , g_cold_sload = 2100
   , g_cold_account_access = 2600
   , g_warm_storage_read = 100
+  , g_access_list_address = 2400
+  , g_access_list_storage_key = 1900
   }
 
 metropolis :: Num n => FeeSchedule n

src/hevm/src/EVM/SymExec.hs

@@ -120,7 +120,7 @@ abstractVM typesignature concreteArgs x storagemodel = do
 
 loadSymVM :: ContractCode -> Storage -> StorageModel -> SAddr -> SymWord -> (Buffer, SymWord) -> VM
 loadSymVM x initStore model addr callvalue' calldata' =
-    (makeVm $ VMOpts
+  (makeVm $ VMOpts
     { vmoptContract = contractWithStore x initStore
     , vmoptCalldata = calldata'
     , vmoptValue = callvalue'
@@ -140,6 +140,7 @@ loadSymVM x initStore model addr callvalue' calldata' =
     , vmoptChainId = 1
     , vmoptCreate = False
     , vmoptStorageModel = model
+    , vmoptTxAccessList = mempty
     }) & set (env . contracts . at (createAddress ethrunAddress 1))
              (Just (contractWithStore x initStore))
 

src/hevm/src/EVM/Transaction.hs

@@ -15,7 +15,7 @@ import Control.Lens
 
 import Data.Aeson (FromJSON (..))
 import Data.ByteString (ByteString)
-import Data.Map (Map)
+import Data.Map (Map, keys)
 import Data.Set (fromList)
 import Data.Maybe (fromMaybe, isNothing, isJust)
 
@@ -24,38 +24,60 @@ import qualified Data.Aeson.Types  as JSON
 import qualified Data.ByteString   as BS
 import qualified Data.Map          as Map
 
-data Transaction = Transaction
-  { txData     :: ByteString,
+data AccessListEntry = AccessListEntry {
+  accessAddress :: Addr,
+  accessStorageKeys :: [W256]
+} deriving Show
+
+data Transaction = Transaction {
+    txData     :: ByteString,
     txGasLimit :: W256,
     txGasPrice :: W256,
     txNonce    :: W256,
     txR        :: W256,
     txS        :: W256,
     txToAddr   :: Maybe Addr,
     txV        :: W256,
-    txValue    :: W256
-  } deriving Show
+    txValue    :: W256,
+    txType     :: Maybe W256,
+    txAccessList :: Maybe [AccessListEntry]
+} deriving Show
+
+-- utility function for getting a more useful representation of accesslistentries
+-- duplicates only matter for gas computation
+-- ugly! could use a review....
+txAccessMap :: Transaction -> Map Addr [W256]
+txAccessMap tx = maybe mempty ((Map.fromListWith (++)) . makeTups) $ txAccessList tx
+  where makeTups = map (\ale -> (accessAddress ale, accessStorageKeys ale))
 
 ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr
-ecrec e v r s = (num . word) <$> EVM.Precompiled.execute 1 input 32
+ecrec v r s e = num . word <$> EVM.Precompiled.execute 1 input 32
   where input = BS.concat (word256Bytes <$> [e, v, r, s])
 
 sender :: Int -> Transaction -> Maybe Addr
-sender chainId tx = ecrec hash v' (txR tx) (txS tx)
-  where hash = keccak $ signingData chainId tx
+sender chainId tx = hash >>= (ecrec v' (txR tx) (txS tx))
+  where hash = keccak <$> signingData chainId tx
         v    = txV tx
         v'   = if v == 27 || v == 28 then v
                else 28 - mod v 2
 
-signingData :: Int -> Transaction -> ByteString
+signingData :: Int -> Transaction -> Maybe ByteString
 signingData chainId tx =
-  if v == (chainId * 2 + 35) || v == (chainId * 2 + 36)
-  then eip155Data
-  else normalData
+  case txType tx of
+    Nothing -> (if v == (chainId * 2 + 35) || v == (chainId * 2 + 36)
+      then Just eip155Data
+      else Just normalData)
+    Just 0x01 -> Just eip2930Data
+    _ -> Nothing
   where v          = fromIntegral (txV tx)
         to'        = case txToAddr tx of
           Just a  -> BS $ word160Bytes a
           Nothing -> BS mempty
+        accessList = (maybe [] id) . txAccessList $ tx
+        rlpAccessList = BS.concat $ map (\accessEntry ->
+          rlpList [BS $ word160Bytes (accessAddress accessEntry), 
+          BS $ rlpList $ map rlpWord256 $ accessStorageKeys accessEntry
+          ]) accessList
         normalData = rlpList [rlpWord256 (txNonce tx),
                               rlpWord256 (txGasPrice tx),
                               rlpWord256 (txGasLimit tx),
@@ -71,6 +93,25 @@ signingData chainId tx =
                               rlpWord256 (fromIntegral chainId),
                               rlpWord256 0x0,
                               rlpWord256 0x0]
+        eip2930Data = cons 0x01 $ rlpList [
+          rlpWord256 (fromIntegral chainId),
+          rlpWord256 (txNonce tx),
+          rlpWord256 (txGasPrice tx),
+          rlpWord256 (txGasLimit tx),
+          to', 
+          rlpWord256 (txValue tx),
+          BS (txData tx),
+          BS rlpAccessList]
+
+accessListPrice :: FeeSchedule Integer -> Maybe [AccessListEntry] -> Integer
+accessListPrice fs maybeAL =
+  case maybeAL of
+    Nothing -> 0
+    Just al -> sum (map 
+      (\ale -> 
+        g_access_list_address fs + 
+        (g_access_list_storage_key fs * (toInteger . length) (accessStorageKeys ale))) 
+        al)
 
 txGasCost :: FeeSchedule Integer -> Transaction -> Integer
 txGasCost fs tx =
@@ -79,10 +120,21 @@ txGasCost fs tx =
       nonZeroBytes = BS.length calldata - zeroBytes
       baseCost     = g_transaction fs
         + if isNothing (txToAddr tx) then g_txcreate fs else 0
+        + (accessListPrice fs $ txAccessList tx)
       zeroCost     = g_txdatazero fs
       nonZeroCost  = g_txdatanonzero fs
   in baseCost + zeroCost * (fromIntegral zeroBytes) + nonZeroCost * (fromIntegral nonZeroBytes)
 
+instance FromJSON AccessListEntry where
+  parseJSON (JSON.Object val) = do
+    accessAddress_ <- addrField val "address"
+    --storageKeys <- (val JSON..: "storageKeys")
+    --accessStorageKeys_ <- JSON.listParser (JSON.withText "W256" (return . readNull 0 . Text.unpack)) storageKeys
+    accessStorageKeys_ <- (val JSON..: "storageKeys") >>= parseJSONList
+    return $ AccessListEntry accessAddress_ accessStorageKeys_
+  parseJSON invalid =
+    JSON.typeMismatch "AccessListEntry" invalid
+
 instance FromJSON Transaction where
   parseJSON (JSON.Object val) = do
     tdata    <- dataField val "data"
@@ -94,7 +146,14 @@ instance FromJSON Transaction where
     toAddr   <- addrFieldMaybe val "to"
     v        <- wordField val "v"
     value    <- wordField val "value"
-    return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value
+    txType   <- wordFieldMaybe val "type"
+    --let legacyTxn = Transaction tdata gasLimit gasPrice nonce r s toAddr v value
+    case txType of
+      Just 0x01 -> do
+        accessListEntries <- (val JSON..: "accessList") >>= parseJSONList
+        return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value txType (Just accessListEntries)
+      Just _ -> fail "unrecognized custom transaction type"
+      Nothing -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value Nothing Nothing
   parseJSON invalid =
     JSON.typeMismatch "Transaction" invalid
 
@@ -144,10 +203,13 @@ initTx vm = let
     touched = if creation
               then [origin]
               else [origin, toAddr]
-    accessed = fromList $ [origin, toAddr] ++ [1..9]
+    accesslist = view (EVM.tx . EVM.accessList) vm
+    accessedaddrs = fromList $ [origin, toAddr] ++ [1..9] ++ (keys accesslist)
+    accessedstoragekeys = fromList $ foldMap (uncurry (map . (,))) (Map.toList accesslist)
 
     in
       vm & EVM.env . EVM.contracts .~ initState
          & EVM.tx . EVM.txReversion .~ preState
          & EVM.tx . EVM.substate . EVM.touchedAccounts .~ touched
-         & EVM.tx . EVM.substate . EVM.accessedAddresses .~ accessed
+         & EVM.tx . EVM.substate . EVM.accessedAddresses .~ accessedaddrs
+         & EVM.tx . EVM.substate . EVM.accessedStorageKeys .~ accessedstoragekeys

src/hevm/src/EVM/Types.hs

@@ -443,6 +443,9 @@ wordField :: JSON.Object -> Text -> JSON.Parser W256
 wordField x f = ((readNull 0) . Text.unpack)
                   <$> (x .: f)
 
+wordFieldMaybe :: JSON.Object -> Text -> JSON.Parser (Maybe W256)
+wordFieldMaybe x f = Text.Read.readMaybe . Text.unpack <$> (x .: f)
+
 addrField :: JSON.Object -> Text -> JSON.Parser Addr
 addrField x f = (read . Text.unpack) <$> (x .: f)
 

src/hevm/src/EVM/UnitTest.hs

@@ -780,6 +780,7 @@ initialUnitTestVm (UnitTestOptions {..}) theContract =
            , vmoptChainId = testChainId
            , vmoptCreate = True
            , vmoptStorageModel = ConcreteS -- TODO: support RPC
+           , vmoptTxAccessList = mempty -- TODO: support unit test access lists???
            }
     creator =
       initialContract (RuntimeCode mempty)

src/hevm/src/EVM/VMTest.hs

@@ -258,8 +258,8 @@ fromBlockchainCase' :: Block -> Transaction
                        -> Map Addr EVM.Contract -> Map Addr EVM.Contract
                        -> Either BlockchainError Case
 fromBlockchainCase' block tx preState postState =
-  let isCreate = isNothing (txToAddr tx)
-  in case (sender 1 tx, checkTx tx preState) of
+  let isCreate = isNothing (txToAddr tx) in
+  case (sender 1 tx, checkTx tx preState) of
       (Nothing, _) -> Left SignatureUnverified
       (_, Nothing) -> Left (if isCreate then FailedCreate else InvalidTx)
       (Just origin, Just checkState) -> Right $ Case
@@ -283,6 +283,7 @@ fromBlockchainCase' block tx preState postState =
          , vmoptChainId       = 1
          , vmoptCreate        = isCreate
          , vmoptStorageModel  = EVM.ConcreteS
+         , vmoptTxAccessList  = txAccessMap tx
          })
         checkState
         postState