{-# Language FlexibleInstances #-}
{-# Language StrictData #-}

module EVM.Concrete where

import Prelude hiding (Word)

import EVM.RLP
import EVM.Types

import Control.Lens    ((^?), ix)
import Data.Bits       (Bits (..), shiftL, shiftR)
import Data.ByteString (ByteString)
import Data.Maybe      (fromMaybe)
import Data.Word       (Word8)

import qualified Data.ByteString as BS

wordAt :: Int -> ByteString -> W256
wordAt :: Int -> ByteString -> W256
wordAt Int
i ByteString
bs =
  ByteString -> W256
word (Int -> ByteString -> ByteString
padRight Int
32 (Int -> ByteString -> ByteString
BS.drop Int
i ByteString
bs))

readByteOrZero :: Int -> ByteString -> Word8
readByteOrZero :: Int -> ByteString -> Word8
readByteOrZero Int
i ByteString
bs = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe Word8
0 (ByteString
bs ByteString -> Getting (First Word8) ByteString Word8 -> Maybe Word8
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index ByteString -> Traversal' ByteString (IxValue ByteString)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index ByteString
i)

byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString
byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString
byteStringSliceWithDefaultZeroes Int
offset Int
size ByteString
bs =
  if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  then ByteString
""
  -- else if offset > BS.length bs
  -- then BS.replicate size 0
  -- todo: this ^^ should work, investigate why it causes more GST fails
  else
    let bs' :: ByteString
bs' = Int -> ByteString -> ByteString
BS.take Int
size (Int -> ByteString -> ByteString
BS.drop Int
offset ByteString
bs)
    in ByteString
bs' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
bs') Word8
0


wordValue :: Word -> W256
wordValue :: Word -> W256
wordValue (C Whiff
_ W256
x) = W256
x

sliceMemory :: (Integral a, Integral b) => a -> b -> ByteString -> ByteString
sliceMemory :: a -> b -> ByteString -> ByteString
sliceMemory a
o b
s =
  Int -> Int -> ByteString -> ByteString
byteStringSliceWithDefaultZeroes (a -> Int
forall a b. (Integral a, Num b) => a -> b
num a
o) (b -> Int
forall a b. (Integral a, Num b) => a -> b
num b
s)

writeMemory :: ByteString -> Word -> Word -> Word -> ByteString -> ByteString
writeMemory :: ByteString -> Word -> Word -> Word -> ByteString -> ByteString
writeMemory ByteString
bs1 (C Whiff
_ W256
n) (C Whiff
_ W256
src) (C Whiff
_ W256
dst) ByteString
bs0 =
  let
    (ByteString
a, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num W256
dst) ByteString
bs0
    a' :: ByteString
a'     = Int -> Word8 -> ByteString
BS.replicate (W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num W256
dst Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
a) Word8
0
    -- sliceMemory should work for both cases, but we are using 256 bit
    -- words, whereas ByteString is only defined up to 64 bit. For large n,
    -- src, dst this will cause problems (often in GeneralStateTests).
    -- Later we could reimplement ByteString for 256 bit arguments.
    c :: ByteString
c      = if W256
src W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> W256
forall a b. (Integral a, Num b) => a -> b
num (ByteString -> Int
BS.length ByteString
bs1)
             then Int -> Word8 -> ByteString
BS.replicate (W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num W256
n) Word8
0
             else W256 -> W256 -> ByteString -> ByteString
forall a b.
(Integral a, Integral b) =>
a -> b -> ByteString -> ByteString
sliceMemory W256
src W256
n ByteString
bs1
    b' :: ByteString
b'     = Int -> ByteString -> ByteString
BS.drop (W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num W256
n) ByteString
b
  in
    ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
a' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
c ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b'

readMemoryWord :: Word -> ByteString -> Word
readMemoryWord :: Word -> ByteString -> Word
readMemoryWord (C Whiff
_ W256
i) ByteString
m =
  if W256
i W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> (Int -> W256
forall a b. (Integral a, Num b) => a -> b
num (Int -> W256) -> Int -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
m) then Word
0 else
  let
    go :: W256 -> Int -> W256
go !W256
a (-1) = W256
a
    go !W256
a !Int
n = W256 -> Int -> W256
go (W256
a W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> W256
forall a b. (Integral a, Num b) => a -> b
num (Word8 -> W256) -> Word8 -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Word8
readByteOrZero (W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num W256
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) ByteString
m)
                              (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
31 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    w :: W256
w = W256 -> Int -> W256
go (W256
0 :: W256) (Int
31 :: Int)
  in {-# SCC "readMemoryWord" #-}
    Whiff -> W256 -> Word
C (W256 -> Whiff
Literal W256
w) W256
w

readMemoryWord32 :: Word -> ByteString -> Word
readMemoryWord32 :: Word -> ByteString -> Word
readMemoryWord32 (C Whiff
_ W256
i) ByteString
m =
  let
    go :: W256 -> Int -> W256
go !W256
a (-1) = W256
a
    go !W256
a !Int
n = W256 -> Int -> W256
go (W256
a W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> W256
forall a b. (Integral a, Num b) => a -> b
num (Word8 -> W256) -> Word8 -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Word8
readByteOrZero (W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num W256
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) ByteString
m)
                              (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  in {-# SCC "readMemoryWord32" #-}
    W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ W256 -> Int -> W256
go (W256
0 :: W256) (Int
3 :: Int)

setMemoryWord :: Word -> Word -> ByteString -> ByteString
setMemoryWord :: Word -> Word -> ByteString -> ByteString
setMemoryWord (C Whiff
_ W256
i) (C Whiff
_ W256
x) =
  ByteString -> Word -> Word -> Word -> ByteString -> ByteString
writeMemory (W256 -> ByteString
word256Bytes W256
x) Word
32 Word
0 (W256 -> Word
forall a b. (Integral a, Num b) => a -> b
num W256
i)

setMemoryByte :: Word -> Word8 -> ByteString -> ByteString
setMemoryByte :: Word -> Word8 -> ByteString -> ByteString
setMemoryByte (C Whiff
_ W256
i) Word8
x =
  ByteString -> Word -> Word -> Word -> ByteString -> ByteString
writeMemory (Word8 -> ByteString
BS.singleton Word8
x) Word
1 Word
0 (W256 -> Word
forall a b. (Integral a, Num b) => a -> b
num W256
i)

keccakBlob :: ByteString -> Word
keccakBlob :: ByteString -> Word
keccakBlob ByteString
x = Whiff -> W256 -> Word
C (Buffer -> Whiff
FromKeccak (ByteString -> Buffer
ConcreteBuffer ByteString
x)) (ByteString -> W256
keccak ByteString
x)

-- Copied from the standard library just to get specialization.
-- We also use bit operations instead of modulo and multiply.
-- (This operation was significantly slow.)
(^) :: W256 -> W256 -> W256
W256
x0 ^ :: W256 -> W256 -> W256
^ W256
y0 | W256
y0 W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< W256
0    = [Char] -> W256
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Negative exponent"
        | W256
y0 W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0   = W256
1
        | Bool
otherwise = W256 -> W256 -> W256
forall a a. (Bits a, Num a, Num a) => a -> a -> a
f W256
x0 W256
y0
    where
          f :: a -> a -> a
f a
x a
y | Bool -> Bool
not (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
y Int
0) = a -> a -> a
f (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
y a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
                | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1      = a
x
                | Bool
otherwise   = a -> a -> a -> a
forall a a. (Bits a, Num a, Num a) => a -> a -> a -> a
g (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) ((a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) a
x
          g :: a -> a -> a -> a
g a
x a
y a
z | Bool -> Bool
not (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
y Int
0) = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
y a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) a
z
                  | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1      = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
z
                  | Bool
otherwise   = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) ((a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
z)

createAddress :: Addr -> W256 -> Addr
createAddress :: Addr -> W256 -> Addr
createAddress Addr
a W256
n = W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num (W256 -> Addr) -> W256 -> Addr
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ [RLP] -> ByteString
rlpList [Addr -> RLP
rlpAddrFull Addr
a, W256 -> RLP
rlpWord256 W256
n]

create2Address :: Addr -> W256 -> ByteString -> Addr
create2Address :: Addr -> W256 -> ByteString -> Addr
create2Address Addr
a W256
s ByteString
b = W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num (W256 -> Addr) -> W256 -> Addr
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
  [Word8 -> ByteString
BS.singleton Word8
0xff, Addr -> ByteString
word160Bytes Addr
a, W256 -> ByteString
word256Bytes (W256 -> ByteString) -> W256 -> ByteString
forall a b. (a -> b) -> a -> b
$ W256 -> W256
forall a b. (Integral a, Num b) => a -> b
num W256
s, W256 -> ByteString
word256Bytes (W256 -> ByteString) -> W256 -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak ByteString
b]