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
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) = forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
str)
  show (List [RLP]
list) = 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 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 forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = (Int
0, Int
0, Bool
False, Bool
False)
            | Bool
otherwise = case HasCallStack => ByteString -> Word8
head ByteString
bs of
  Word8
x | Word8
0 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
< Word8
128   -> (Int
0, Int
1, Bool
False, Bool
True) -- directly encoded byte
  Word8
x | Word8
128 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
< Word8
184 -> (Int
1, forall a b. (Integral a, Num b) => a -> b
num Word8
x forall a. Num a => a -> a -> a
- Int
128, Bool
False, (ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
/= Int
2) Bool -> Bool -> Bool
|| (Word8
127 forall a. Ord a => a -> a -> Bool
< (HasCallStack => ByteString -> Word8
head forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
drop Int
1 ByteString
bs))) -- short string
  Word8
x | Word8
184 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
< Word8
192 -> (Int
1 forall a. Num a => a -> a -> a
+ Int
pre, Int
len, Bool
False, (Int
len forall a. Ord a => a -> a -> Bool
> Int
55) Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
head (Int -> ByteString -> ByteString
drop Int
1 ByteString
bs) forall a. Eq a => a -> a -> Bool
/= Word8
0) -- long string
    where pre :: Int
pre = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ Word8
x forall a. Num a => a -> a -> a
- Word8
183
          len :: Int
len = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
slice Int
1 Int
pre ByteString
bs
  Word8
x | Word8
192 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
< Word8
248 -> (Int
1, forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ Word8
x forall a. Num a => a -> a -> a
- Word8
192, Bool
True, Bool
True) -- short list
  Word8
x                       -> (Int
1 forall a. Num a => a -> a -> a
+ Int
pre, Int
len, Bool
True, (Int
len forall a. Ord a => a -> a -> Bool
> Int
55) Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
head (Int -> ByteString -> ByteString
drop Int
1 ByteString
bs) forall a. Eq a => a -> a -> Bool
/= Word8
0) -- long list
    where pre :: Int
pre = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ Word8
x forall a. Num a => a -> a -> a
- Word8
247
          len :: Int
len = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word 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 forall a. Num a => a -> a -> a
+ Int
len forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
bs = if Bool
isList
                                                   then do
                                                      [RLP]
items <- 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 forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
slice Int
s Int
e ByteString
content) forall a b. (a -> b) -> a -> b
$
                                                        ByteString -> Int -> Int -> [(Int, Int)]
rlplengths ByteString
content Int
0 Int
len
                                                      forall a. a -> Maybe a
Just ([RLP] -> RLP
List [RLP]
items)
                                                   else forall a. a -> Maybe a
Just (ByteString -> RLP
BS ByteString
content)
             | Bool
otherwise = 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 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 forall a. Num a => a -> a -> a
+ Int
len) forall a. a -> [a] -> [a]
: ByteString -> Int -> Int -> [(Int, Int)]
rlplengths (Int -> ByteString -> ByteString
drop (Int
pre forall a. Num a => a -> a -> a
+ Int
len) ByteString
bs) (Int
acc forall a. Num a => a -> a -> a
+ Int
pre 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 forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
head ByteString
bs 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 (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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 forall a. Ord a => a -> a -> Bool
<= Int
55 = Int -> ByteString
prefix (ByteString -> Int
BS.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString
bs
                    | Bool
otherwise = Int -> ByteString
prefix Int
lenLen forall a. Semigroup a => a -> a -> a
<> ByteString
lenBytes forall a. Semigroup a => a -> a -> a
<> ByteString
bs
          where
            lenBytes :: ByteString
lenBytes = forall a. Integral a => a -> ByteString
asBE forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
            prefix :: Int -> ByteString
prefix Int
n = Word8 -> ByteString
BS.singleton forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ Int
offset forall a. Num a => a -> a -> a
+ Int
n
            lenLen :: Int
lenLen = ByteString -> Int
BS.length ByteString
lenBytes forall a. Num a => a -> a -> a
+ Int
55

rlpList :: [RLP] -> ByteString
rlpList :: [RLP] -> ByteString
rlpList [RLP]
n = RLP -> ByteString
rlpencode 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 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Word8
0) [forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR W256
x (Int
8 forall a. Num a => a -> a -> a
* Int
i)) | Int
i <- 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 forall a b. (a -> b) -> a -> b
$ [forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR W256
x (Int
8 forall a. Num a => a -> a -> a
* Int
i)) | Int
i <- forall a. [a] -> [a]
reverse [Int
0..Int
n]]

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

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

rlpWordFull :: W256 -> RLP
rlpWordFull :: W256 -> RLP
rlpWordFull = ByteString -> RLP
BS 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256 -> ByteString
octetsFull Int
19 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
num

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