module Blockchain.Ethereum.RLP (rlpSerialize, rlpDeserialize, RLPSerializable (..), RLPObject (..)) where
import Data.Word
import Control.Applicative
import Control.Monad
import Data.Binary.Strict.Get
import Data.Binary.Put
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
data RLPObject = RLPItem B.ByteString | RLPList [RLPObject] deriving (Show, Eq, Ord);
int2LE::Integral a => a -> [Word8]
int2LE i | i <= 0xff = [fromIntegral i]
int2LE i = least:rest
where
rest = int2LE $ i `div` 0xff
least = fromIntegral $ i `mod` 0xff
int2BE::Integral a => a -> [Word8]
int2BE = reverse.int2LE
int2Bytes::Integral a => a -> B.ByteString
int2Bytes = B.pack.int2BE
be2Int::Integral a => [Word8] -> a
be2Int = foldl (\v a -> v * 0xff + fromIntegral a) 0
bytes2Int::B.ByteString -> Int
bytes2Int = be2Int.B.unpack
rlp2Bytes::RLPObject -> Put
rlp2Bytes (RLPItem bs) | B.length bs == 1 && B.head bs <= 0x7f = putByteString bs
rlp2Bytes (RLPItem bs) | B.length bs <= 55 = do
putWord8 $ 0x80 + fromIntegral (B.length bs)
putByteString bs
rlp2Bytes (RLPItem bs) = do
putWord8 $ 0xb7 + fromIntegral (B.length lenb)
putByteString lenb
putByteString bs
where
lenb = int2Bytes $ B.length bs
rlp2Bytes (RLPList os) | len <= 55 = do
putWord8 $ 0xc0 + fromIntegral len
putLazyByteString internal
where
len = LB.length internal
internal = LB.concat $ runPut `fmap` rlp2Bytes `fmap` os
rlp2Bytes (RLPList os) = do
putWord8 $ 0xf7 + fromIntegral (B.length lenb)
putByteString lenb
putLazyByteString internal
where
lenb = int2Bytes $ LB.length internal
internal = LB.concat (runPut . rlp2Bytes <$> os)
rlpSerialize::RLPObject -> LB.ByteString
rlpSerialize o = runPut $ rlp2Bytes o
bytes2RLP::Get RLPObject
bytes2RLP = do
b <- getWord8
case b of
_ | b <= 0x7f -> return $ RLPItem $ B.singleton b
_ | b <= 0xb7 -> do
bs <- getByteString $ fromIntegral b 0x80
return $ RLPItem bs
_ | b <= 0xbf -> do
lengthBytes <- getByteString $ fromIntegral b 0xb7
let dataLength = bytes2Int lengthBytes
bs <- getByteString dataLength
return $ RLPItem bs
_ | b <= 0xf7 -> do
let listLength = fromIntegral b 0xc0
os <- replicateM listLength bytes2RLP
return $ RLPList os
_ -> do
lengthBytes <- getByteString $ fromIntegral b 0xf7
let listLength = bytes2Int lengthBytes
os <- replicateM listLength bytes2RLP
return $ RLPList os
rlpDeserialize::B.ByteString -> (Either String RLPObject, B.ByteString)
rlpDeserialize = runGet bytes2RLP
class RLPSerializable a where
toRLP::a->RLPObject
serialize::a->LB.ByteString
serialize = rlpSerialize.toRLP
instance RLPSerializable a => RLPSerializable [a] where
toRLP os = RLPList $ toRLP `fmap` os
instance RLPSerializable B.ByteString where
toRLP = RLPItem