{-# LANGUAGE TemplateHaskell #-}

module EVM.CheatsTH where

import EVM.ABI
import EVM.Types (internalError)

import Data.ByteString.Char8 (pack)
import Data.Map.Strict qualified as Map
import Data.Vector qualified as V

import Language.Haskell.TH
import Language.Haskell.TH.Syntax

liftByteString :: String -> Q Exp
liftByteString :: String -> Q Exp
liftByteString String
txt = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
txt

liftAbiType :: AbiType -> Q Exp
liftAbiType :: AbiType -> Q Exp
liftAbiType AbiType
AbiBoolType = [| AbiBool |]
liftAbiType (AbiUIntType Int
n) = [| AbiUInt $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
n) |]
liftAbiType (AbiIntType Int
n) = [| AbiInt $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
n) |]
liftAbiType AbiType
AbiAddressType = [| AbiAddress |]
liftAbiType (AbiBytesType Int
n) = [| AbiBytes $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
n) |]
liftAbiType AbiType
AbiStringType = [| AbiString |]
liftAbiType AbiType
AbiBytesDynamicType = [| AbiBytesDynamic |]
liftAbiType AbiType
_ = String -> Q Exp
forall a. HasCallStack => String -> a
internalError String
"unimplemented"

envReadSingleCheat :: String -> Q Exp
envReadSingleCheat :: String -> Q Exp
envReadSingleCheat String
sigString = [|
  \wrap convert ->
    action $Q Exp
sigL $
      \sig input -> case decodeBuf [AbiStringType] input of
        CAbi [AbiString variable] -> let
          varStr = toString variable
          cont value = continueOnce $ do
            either' (convert value) frameRevert $ \v ->
              frameReturn $ wrap v
          in do
            vm <- get
            case Map.lookup varStr vm.osEnv of
              Just v -> cont v
              Nothing -> query (PleaseReadEnv varStr cont)
        _ -> vmError (BadCheatCode (sigString <> " parameter decoding failed") sig)
   |]
  where
    sigL :: Q Exp
sigL = String -> Q Exp
liftByteString String
sigString

envReadMultipleCheat :: String -> AbiType -> Q Exp
envReadMultipleCheat :: String -> AbiType -> Q Exp
envReadMultipleCheat String
sigString AbiType
arrType = [|
  \convert ->
    action $Q Exp
sigL $
      \sig input -> case decodeBuf [AbiStringType, AbiStringType] input of
        CAbi [AbiString variable, AbiString delimiter] -> let
          (varStr, delimStr) = (toString variable, toString delimiter)
          cont value = continueOnce $ do
            let (errors, values) = partitionEithers $ map convert $ splitOn delimStr value
            case errors of
              [] -> do
                let result = AbiTuple $ V.fromList [AbiArrayDynamic $Q Exp
arrTypeL $ V.fromList $ map $Q Exp
wrapL values]
                frameReturn result
              (e:_) -> frameRevert e
          in do
            vm <- get
            case Map.lookup varStr vm.osEnv of
              Just v -> cont v
              Nothing -> query (PleaseReadEnv varStr cont)
        _ -> vmError (BadCheatCode (sigString <> " parameter decoding failed") sig)
  |]
  where
    sigL :: Q Exp
sigL = String -> Q Exp
liftByteString String
sigString
    arrTypeL :: Q Exp
arrTypeL = AbiType -> Q Exp
forall (m :: * -> *) a. (Quote m, Data a) => a -> m Exp
liftData AbiType
arrType
    wrapL :: Q Exp
wrapL = AbiType -> Q Exp
liftAbiType AbiType
arrType