module EVM.Concrete where

import Prelude hiding (Word)

import EVM.RLP
import EVM.Types

import Data.Bits       (Bits (..), 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 = forall a. a -> Maybe a -> a
fromMaybe Word8
0 (ByteString
bs ByteString -> Int -> Maybe Word8
!? Int
i)

byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString
byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString
byteStringSliceWithDefaultZeroes Int
offset Int
size ByteString
bs =
  if Int
size 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' forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
size forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
bs') Word8
0


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

writeMemory :: ByteString -> W256 -> W256 -> W256 -> ByteString -> ByteString
writeMemory :: ByteString -> W256 -> W256 -> W256 -> ByteString -> ByteString
writeMemory ByteString
bs1 W256
n W256
src W256
dst ByteString
bs0 =
  let
    (ByteString
a, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (forall a b. (Integral a, Num b) => a -> b
num W256
dst) ByteString
bs0
    a' :: ByteString
a'     = Int -> Word8 -> ByteString
BS.replicate (forall a b. (Integral a, Num b) => a -> b
num W256
dst 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 forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
num (ByteString -> Int
BS.length ByteString
bs1)
             then Int -> Word8 -> ByteString
BS.replicate (forall a b. (Integral a, Num b) => a -> b
num W256
n) Word8
0
             else 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 (forall a b. (Integral a, Num b) => a -> b
num W256
n) ByteString
b
  in
    ByteString
a forall a. Semigroup a => a -> a -> a
<> ByteString
a' forall a. Semigroup a => a -> a -> a
<> ByteString
c forall a. Semigroup a => a -> a -> a
<> ByteString
b'

-- 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 forall a. Ord a => a -> a -> Bool
< W256
0    = forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Negative exponent"
        | W256
y0 forall a. Eq a => a -> a -> Bool
== W256
0   = W256
1
        | Bool
otherwise = forall {a} {t}. (Bits a, Num t, Num a) => t -> a -> t
f W256
x0 W256
y0
    where
          f :: t -> a -> t
f t
x a
y | Bool -> Bool
not (forall a. Bits a => a -> Int -> Bool
testBit a
y Int
0) = t -> a -> t
f (t
x forall a. Num a => a -> a -> a
* t
x) (a
y forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
                | a
y forall a. Eq a => a -> a -> Bool
== a
1      = t
x
                | Bool
otherwise   = forall {a} {t}. (Bits a, Num t, Num a) => t -> a -> t -> t
g (t
x forall a. Num a => a -> a -> a
* t
x) ((a
y forall a. Num a => a -> a -> a
- a
1) forall a. Bits a => a -> Int -> a
`shiftR` Int
1) t
x
          g :: t -> a -> t -> t
g t
x a
y t
z | Bool -> Bool
not (forall a. Bits a => a -> Int -> Bool
testBit a
y Int
0) = t -> a -> t -> t
g (t
x forall a. Num a => a -> a -> a
* t
x) (a
y forall a. Bits a => a -> Int -> a
`shiftR` Int
1) t
z
                  | a
y forall a. Eq a => a -> a -> Bool
== a
1      = t
x forall a. Num a => a -> a -> a
* t
z
                  | Bool
otherwise   = t -> a -> t -> t
g (t
x forall a. Num a => a -> a -> a
* t
x) ((a
y forall a. Num a => a -> a -> a
- a
1) forall a. Bits a => a -> Int -> a
`shiftR` Int
1) (t
x forall a. Num a => a -> a -> a
* t
z)

createAddress :: Addr -> W256 -> Addr
createAddress :: Addr -> W256 -> Addr
createAddress Addr
a W256
n = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' 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 = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
  [Word8 -> ByteString
BS.singleton Word8
0xff, Addr -> ByteString
word160Bytes Addr
a, W256 -> ByteString
word256Bytes W256
s, W256 -> ByteString
word256Bytes forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' ByteString
b]