module EVM.RLP where

import Prelude hiding (drop, head)
import EVM.Types
import Data.Bits       (shiftR)
import Data.ByteString (ByteString, drop, head)
import qualified Data.ByteString   as BS

data RLP = BS ByteString | List [RLP] deriving RLP -> RLP -> Bool
(RLP -> RLP -> Bool) -> (RLP -> RLP -> Bool) -> Eq RLP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RLP -> RLP -> Bool
$c/= :: RLP -> RLP -> Bool
== :: RLP -> RLP -> Bool
$c== :: RLP -> RLP -> Bool
Eq

instance Show RLP where
  show :: RLP -> String
show (BS ByteString
str) = ByteStringS -> String
forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
str)
  show (List [RLP]
list) = [RLP] -> String
forall a. Show a => a -> String
show [RLP]
list

slice :: Int -> Int -> ByteString -> ByteString
slice :: Int -> Int -> ByteString -> ByteString
slice Int
offset Int
size ByteString
bs = Int -> ByteString -> ByteString
BS.take Int
size (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
offset ByteString
bs

-- helper function returning (the length of the prefix, the length of the content, isList boolean, optimal boolean)
itemInfo :: ByteString -> (Int, Int, Bool, Bool)
itemInfo :: ByteString -> (Int, Int, Bool, Bool)
itemInfo ByteString
bs | ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty = (Int
0, Int
0, Bool
False, Bool
False)
            | Bool
otherwise = case ByteString -> Word8
head ByteString
bs of
  Word8
x | Word8
0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128   -> (Int
0, Int
1, Bool
False, Bool
True) -- directly encoded byte
  Word8
x | Word8
128 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
184 -> (Int
1, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num Word8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
128, Bool
False, (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2) Bool -> Bool -> Bool
|| (Word8
127 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< (ByteString -> Word8
head (ByteString -> Word8) -> ByteString -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
drop Int
1 ByteString
bs))) -- short string
  Word8
x | Word8
184 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
192 -> (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pre, Int
len, Bool
False, (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
55) Bool -> Bool -> Bool
&& ByteString -> Word8
head (Int -> ByteString -> ByteString
drop Int
1 ByteString
bs) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) -- long string
    where pre :: Int
pre = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
183
          len :: Int
len = W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num (W256 -> Int) -> W256 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
slice Int
1 Int
pre ByteString
bs
  Word8
x | Word8
192 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
248 -> (Int
1, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
192, Bool
True, Bool
True) -- short list
  Word8
x                       -> (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pre, Int
len, Bool
True, (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
55) Bool -> Bool -> Bool
&& ByteString -> Word8
head (Int -> ByteString -> ByteString
drop Int
1 ByteString
bs) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) -- long list
    where pre :: Int
pre = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
247
          len :: Int
len = W256 -> Int
forall a b. (Integral a, Num b) => a -> b
num (W256 -> Int) -> W256 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
slice Int
1 Int
pre ByteString
bs

rlpdecode :: ByteString -> Maybe RLP
rlpdecode :: ByteString -> Maybe RLP
rlpdecode ByteString
bs | Bool
optimal Bool -> Bool -> Bool
&& Int
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
bs = if Bool
isList
                                                   then do
                                                      [RLP]
items <- ((Int, Int) -> Maybe RLP) -> [(Int, Int)] -> Maybe [RLP]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                        (\(Int
s, Int
e) -> ByteString -> Maybe RLP
rlpdecode (ByteString -> Maybe RLP) -> ByteString -> Maybe RLP
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
slice Int
s Int
e ByteString
content) ([(Int, Int)] -> Maybe [RLP]) -> [(Int, Int)] -> Maybe [RLP]
forall a b. (a -> b) -> a -> b
$
                                                        ByteString -> Int -> Int -> [(Int, Int)]
rlplengths ByteString
content Int
0 Int
len
                                                      RLP -> Maybe RLP
forall a. a -> Maybe a
Just ([RLP] -> RLP
List [RLP]
items)
                                                   else RLP -> Maybe RLP
forall a. a -> Maybe a
Just (ByteString -> RLP
BS ByteString
content)
             | Bool
otherwise = Maybe RLP
forall a. Maybe a
Nothing
  where (Int
pre, Int
len, Bool
isList, Bool
optimal) = ByteString -> (Int, Int, Bool, Bool)
itemInfo ByteString
bs
        content :: ByteString
content = Int -> ByteString -> ByteString
drop Int
pre ByteString
bs

rlplengths :: ByteString -> Int -> Int -> [(Int,Int)]
rlplengths :: ByteString -> Int -> Int -> [(Int, Int)]
rlplengths ByteString
bs Int
acc Int
top | Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
top = let (Int
pre, Int
len, Bool
_, Bool
_) = ByteString -> (Int, Int, Bool, Bool)
itemInfo ByteString
bs
                                    in (Int
acc, Int
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: ByteString -> Int -> Int -> [(Int, Int)]
rlplengths (Int -> ByteString -> ByteString
drop (Int
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) ByteString
bs) (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int
top
                      | Bool
otherwise = []

rlpencode :: RLP -> ByteString
rlpencode :: RLP -> ByteString
rlpencode (BS ByteString
bs) = if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ByteString -> Word8
head ByteString
bs Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then ByteString
bs
                    else Int -> ByteString -> ByteString
encodeLen Int
128 ByteString
bs
rlpencode (List [RLP]
items) = Int -> ByteString -> ByteString
encodeLen Int
192 ([ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (RLP -> ByteString) -> [RLP] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map RLP -> ByteString
rlpencode [RLP]
items)

encodeLen :: Int -> ByteString -> ByteString
encodeLen :: Int -> ByteString -> ByteString
encodeLen Int
offset ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
55 = Int -> ByteString
prefix (ByteString -> Int
BS.length ByteString
bs) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
                    | Bool
otherwise = Int -> ByteString
prefix Int
lenLen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lenBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
          where
            lenBytes :: ByteString
lenBytes = Int -> ByteString
forall a. Integral a => a -> ByteString
asBE (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
            prefix :: Int -> ByteString
prefix Int
n = Word8 -> ByteString
BS.singleton (Word8 -> ByteString) -> Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
num (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
            lenLen :: Int
lenLen = ByteString -> Int
BS.length ByteString
lenBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
55

rlpList :: [RLP] -> ByteString
rlpList :: [RLP] -> ByteString
rlpList [RLP]
n = RLP -> ByteString
rlpencode (RLP -> ByteString) -> RLP -> ByteString
forall a b. (a -> b) -> a -> b
$ [RLP] -> RLP
List [RLP]
n

octets :: W256 -> ByteString
octets :: W256 -> ByteString
octets W256
x =
  [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) [W256 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
shiftR W256
x (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) | Int
i <- [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..Int
31]]

octetsFull :: Int -> W256 -> ByteString
octetsFull :: Int -> W256 -> ByteString
octetsFull Int
n W256
x =
  [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ [W256 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
shiftR W256
x (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) | Int
i <- [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..Int
n]]

octets160 :: Addr -> ByteString
octets160 :: Addr -> ByteString
octets160 Addr
x =
  [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) [Addr -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Addr -> Int -> Addr
forall a. Bits a => a -> Int -> a
shiftR Addr
x (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) | Int
i <- [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..Int
19]]

rlpWord256 :: W256 -> RLP
rlpWord256 :: W256 -> RLP
rlpWord256 W256
0 = ByteString -> RLP
BS ByteString
forall a. Monoid a => a
mempty
rlpWord256 W256
n = ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ W256 -> ByteString
octets W256
n

rlpWordFull :: W256 -> RLP
rlpWordFull :: W256 -> RLP
rlpWordFull = ByteString -> RLP
BS (ByteString -> RLP) -> (W256 -> ByteString) -> W256 -> RLP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256 -> ByteString
octetsFull Int
31

rlpAddrFull :: Addr -> RLP
rlpAddrFull :: Addr -> RLP
rlpAddrFull = ByteString -> RLP
BS (ByteString -> RLP) -> (Addr -> ByteString) -> Addr -> RLP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256 -> ByteString
octetsFull Int
19 (W256 -> ByteString) -> (Addr -> W256) -> Addr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> W256
forall a b. (Integral a, Num b) => a -> b
num

rlpWord160 :: Addr -> RLP
rlpWord160 :: Addr -> RLP
rlpWord160 Addr
0 = ByteString -> RLP
BS ByteString
forall a. Monoid a => a
mempty
rlpWord160 Addr
n = ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ Addr -> ByteString
octets160 Addr
n