content: module EVM.Transaction where
  
  import Prelude hiding (Word)
  
  import qualified EVM
  import EVM (balance, initialContract)
  import EVM.FeeSchedule
  import EVM.Precompiled (execute)
  import EVM.RLP
  import EVM.Symbolic (forceLit)
  import EVM.Types
  
  import Control.Lens
  
  import Data.Aeson (FromJSON (..))
  import Data.ByteString (ByteString)
  import Data.Map (Map)
  import Data.Maybe (fromMaybe, isNothing, isJust)
  
  import qualified Data.Aeson        as JSON
  import qualified Data.Aeson.Types  as JSON
  import qualified Data.ByteString   as BS
  import qualified Data.Map          as Map
  
  data AccessListEntry = AccessListEntry {
    accessAddress :: Addr,
    accessStorageKeys :: [W256]
  } deriving Show
  
  data TxType = LegacyTransaction
              | AccessListTransaction
              | EIP1559Transaction
    deriving (Show, Eq)
  
  data Transaction = Transaction {
      txData     :: ByteString,
      txGasLimit :: W256,
      txGasPrice :: Maybe W256,
      txNonce    :: W256,
      txR        :: W256,
      txS        :: W256,
      txToAddr   :: Maybe Addr,
      txV        :: W256,
      txValue    :: W256,
      txType     :: TxType,
      txAccessList :: [AccessListEntry],
      txMaxPriorityFeeGas :: Maybe W256,
      txMaxFeePerGas :: Maybe W256
  } deriving Show
  
  -- | utility function for getting a more useful representation of accesslistentries
  -- duplicates only matter for gas computation
  txAccessMap :: Transaction -> Map Addr [W256]
  txAccessMap tx = ((Map.fromListWith (++)) . makeTups) $ txAccessList tx
    where makeTups = map (\ale -> (accessAddress ale, accessStorageKeys ale))
  
  ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr
  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 v' (txR tx) (txS tx) hash
    where hash = keccak (signingData chainId tx)
          v    = txV tx
          v'   = if v == 27 || v == 28 then v
                 else 27 + v
  
  signingData :: Int -> Transaction -> ByteString
  signingData chainId tx =
    case txType tx of
      LegacyTransaction -> if v == (chainId * 2 + 35) || v == (chainId * 2 + 36)
        then eip155Data
        else normalData
      AccessListTransaction -> eip2930Data
      EIP1559Transaction -> eip1559Data
    where v          = fromIntegral (txV tx)
          to'        = case txToAddr tx of
            Just a  -> BS $ word160Bytes a
            Nothing -> BS mempty
          Just maxFee = txMaxFeePerGas tx
          Just maxPrio = txMaxPriorityFeeGas tx
          Just gasPrice = txGasPrice tx
          accessList = txAccessList tx
          rlpAccessList = EVM.RLP.List $ map (\accessEntry ->
            EVM.RLP.List [BS $ word160Bytes (accessAddress accessEntry),
                          EVM.RLP.List $ map rlpWordFull $ accessStorageKeys accessEntry]
            ) accessList
          normalData = rlpList [rlpWord256 (txNonce tx),
                                rlpWord256 gasPrice,
                                rlpWord256 (txGasLimit tx),
                                to',
                                rlpWord256 (txValue tx),
                                BS (txData tx)]
          eip155Data = rlpList [rlpWord256 (txNonce tx),
                                rlpWord256 gasPrice,
                                rlpWord256 (txGasLimit tx),
                                to',
                                rlpWord256 (txValue tx),
                                BS (txData tx),
                                rlpWord256 (fromIntegral chainId),
                                rlpWord256 0x0,
                                rlpWord256 0x0]
          eip1559Data = cons 0x02 $ rlpList [
            rlpWord256 (fromIntegral chainId),
            rlpWord256 (txNonce tx),
            rlpWord256 maxPrio,
            rlpWord256 maxFee,
            rlpWord256 (txGasLimit tx),
            to',
            rlpWord256 (txValue tx),
            BS (txData tx),
            rlpAccessList]
  
          eip2930Data = cons 0x01 $ rlpList [
            rlpWord256 (fromIntegral chainId),
            rlpWord256 (txNonce tx),
            rlpWord256 gasPrice,
            rlpWord256 (txGasLimit tx),
            to',
            rlpWord256 (txValue tx),
            BS (txData tx),
            rlpAccessList]
  
  accessListPrice :: FeeSchedule Integer -> [AccessListEntry] -> Integer
  accessListPrice fs 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 =
    let calldata     = txData tx
        zeroBytes    = BS.count 0 calldata
        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"
      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"
      gasLimit <- wordField val "gasLimit"
      gasPrice <- fmap read <$> val JSON..:? "gasPrice"
      maxPrio  <- fmap read <$> val JSON..:? "maxPriorityFeePerGas"
      maxFee   <- fmap read <$> val JSON..:? "maxFeePerGas"
      nonce    <- wordField val "nonce"
      r        <- wordField val "r"
      s        <- wordField val "s"
      toAddr   <- addrFieldMaybe val "to"
      v        <- wordField val "v"
      value    <- wordField val "value"
      txType   <- fmap read <$> (val JSON..:? "type")
      case txType of
        Just 0x00 -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] Nothing Nothing
        Just 0x01 -> do
          accessListEntries <- (val JSON..: "accessList") >>= parseJSONList
          return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value AccessListTransaction accessListEntries Nothing Nothing
        Just 0x02 -> do
          accessListEntries <- (val JSON..: "accessList") >>= parseJSONList
          return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value EIP1559Transaction accessListEntries maxPrio maxFee
        Just _ -> fail "unrecognized custom transaction type"
        Nothing -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] Nothing Nothing
    parseJSON invalid =
      JSON.typeMismatch "Transaction" invalid
  
  accountAt :: Addr -> Getter (Map Addr EVM.Contract) EVM.Contract
  accountAt a = (at a) . (to $ fromMaybe newAccount)
  
  touchAccount :: Addr -> Map Addr EVM.Contract -> Map Addr EVM.Contract
  touchAccount a = Map.insertWith (flip const) a newAccount
  
  newAccount :: EVM.Contract
  newAccount = initialContract $ EVM.RuntimeCode mempty
  
  -- | Increments origin nonce and pays gas deposit
  setupTx :: Addr -> Addr -> Word -> Word -> Map Addr EVM.Contract -> Map Addr EVM.Contract
  setupTx origin coinbase gasPrice gasLimit prestate =
    let gasCost = gasPrice * gasLimit
    in (Map.adjust ((over EVM.nonce   (+ 1))
                 . (over balance (subtract gasCost))) origin)
      . touchAccount origin
      . touchAccount coinbase $ prestate
  
  -- | Given a valid tx loaded into the vm state,
  -- subtract gas payment from the origin, increment the nonce
  -- and pay receiving address
  initTx :: EVM.VM -> EVM.VM
  initTx vm = let
      toAddr   = view (EVM.state . EVM.contract) vm
      origin   = view (EVM.tx . EVM.origin) vm
      gasPrice = view (EVM.tx . EVM.gasprice) vm
      gasLimit = view (EVM.tx . EVM.txgaslimit) vm
      coinbase = view (EVM.block . EVM.coinbase) vm
      value    = view (EVM.state . EVM.callvalue) vm
      toContract = initialContract (EVM.InitCode (view (EVM.state . EVM.code) vm))
      preState = setupTx origin coinbase gasPrice gasLimit $ view (EVM.env . EVM.contracts) vm
      oldBalance = view (accountAt toAddr . balance) preState
      creation = view (EVM.tx . EVM.isCreate) vm
      initState =
        (if isJust (maybeLitWord value)
         then (Map.adjust (over balance (subtract (forceLit value))) origin)
          . (Map.adjust (over balance (+ (forceLit value))) toAddr)
         else id)
        . (if creation
           then Map.insert toAddr (toContract & balance .~ oldBalance)
           else touchAccount toAddr)
        $ preState
  
      in
        vm & EVM.env . EVM.contracts .~ initState
           & EVM.tx . EVM.txReversion .~ preState
  