module EVM.Concrete where

import Prelude hiding (Word)

import EVM.RLP
import EVM.Types

import Control.Lens    ((^?), ix)
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 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix 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]