ethereum-rlp (empty) → 0.0.1

raw patch · 6 files changed

+291/−0 lines, 6 filesdep +HUnitdep +ansi-wl-pprintdep +basesetup-changed

Dependencies added: HUnit, ansi-wl-pprint, base, base16-bytestring, bytestring, test-framework, test-framework-hunit

Files

• LICENSE +31/−0
• Setup.hs +8/−0
• ethereum-rlp.cabal +50/−0
• src/Blockchain/Data/RLP.hs +153/−0
• src/Blockchain/Data/Util.hs +24/−0
• test/Main.hs +25/−0

@@ -0,0 +1,31 @@++Copyright (c) 2014, Jamshid+All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above +copyright notice, this list of conditions and the following +disclaimer in the documentation and/or other materials provided +with the distribution.++3. Neither the name of the copyright holder nor the names of its +contributors may be used to endorse or promote products derived +from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,8 @@++module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+

@@ -0,0 +1,50 @@+name: ethereum-rlp+version: 0.0.1+cabal-version: >=1.10+build-type: Simple+author: Jamshid+license-file:  LICENSE+maintainer:    jamshidnh@gmail.com+synopsis: Ethereum Recursive Length Prefix Encoding+category:      Data Structures+license: BSD3+description:  +    RLP, as described in the Ethereum Yellowpaper++source-repository head+  type:     git+  location: https://github.com/jamshidh/ethereum-rlp++source-repository this+  type:     git+  location: https://github.com/jamshidh/ethereum-rlp+  branch:   master+  tag:      v0.0.1+ +library+    default-language: Haskell98+    build-depends: +                   base >= 4 && < 5+                 , bytestring+                 , base16-bytestring+                 , ansi-wl-pprint+    exposed-modules:+                   Blockchain.Data.RLP+    other-modules:+                   Blockchain.Data.Util+    ghc-options: -Wall+    buildable: True+    hs-source-dirs: src++Test-Suite test-rlp+    default-language: Haskell98+    type:               exitcode-stdio-1.0+    main-is:            Main.hs+    hs-source-dirs:     test, src+    build-depends:      base >=4 && < 5+                    , bytestring+                    , base16-bytestring+                    , ansi-wl-pprint+                    , test-framework+                    , test-framework-hunit+                    , HUnit

@@ -0,0 +1,153 @@+{-# LANGUAGE FlexibleInstances #-}++-- | The RLP module provides a framework within which serializers can be built, described in the Ethereum Yellowpaper (<http://gavwood.com/paper.pdf>).+--+-- The 'RLPObject' is an intermediate data container, whose serialization rules are well defined.  By creating code that converts from a+-- given type to an 'RLPObject', full serialization will be specified.  The 'RLPSerializable' class provides functions to do this conversion.++module Blockchain.Data.RLP (+  RLPObject(..),+  RLPSerializable(..),+  rlpSerialize,+  rlpDeserialize+  ) where++import Data.Bits+import qualified Data.ByteString as B+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Char8 as BC+import Data.ByteString.Internal+import Data.Functor+import Data.Word+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import Numeric++import Blockchain.Data.Util++-- | An internal representation of generic data, with no type information.+--+-- End users will not need to directly create objects of this type (an 'RLPObject' can be created using 'rlpEncode'),+-- however the designer of a new type will need to create conversion code by making their type an instance +-- of the RLPSerializable class. +data RLPObject = RLPScalar Word8 | RLPString String | RLPArray [RLPObject] deriving (Show, Eq, Ord)++-- | Converts objects to and from 'RLPObject's.+class RLPSerializable a where+  rlpDecode::RLPObject->a+  rlpEncode::a->RLPObject+++instance Pretty RLPObject where+  pretty (RLPArray objects) =+    encloseSep (text "[") (text "]") (text ", ") $ pretty <$> objects+  pretty (RLPScalar n) = text $ "0x" ++ showHex n ""+  pretty (RLPString s) = text $ "0x" ++ BC.unpack (B16.encode $ BC.pack s)++++splitAtWithError::Int->[a]->([a], [a])+splitAtWithError n arr | n > length arr = error "splitAtWithError called with n > length arr"+splitAtWithError n arr = splitAt n arr++getLength::Int->[Word8]->(Integer, [Word8])+getLength sizeOfLength bytes = (bytes2Integer $ take sizeOfLength bytes, drop sizeOfLength bytes)++rlpSplit::[Word8]->(RLPObject, [Word8])+rlpSplit (x:rest) | x >= 192 && x <= 192+55 =+  (RLPArray $ getRLPObjects arrayData, nextRest)+  where+    dataLength::Word8+    dataLength = x - 192+    (arrayData, nextRest) = splitAtWithError (fromIntegral dataLength) rest+rlpSplit (x:rest) | x >= 0xF8 && x <= 0xFF =+  (RLPArray $ getRLPObjects arrayData, nextRest)+  where+    (arrLength, restAfterLen) = getLength (fromIntegral x - 0xF7) rest+    (arrayData, nextRest) = splitAtWithError (fromIntegral arrLength) restAfterLen+rlpSplit (249:len1:len2:rest) =+  (RLPArray $ getRLPObjects arrayData, nextRest)+  where+    len = fromIntegral len1 `shift` 8 + fromIntegral len2+    (arrayData, nextRest) = splitAtWithError len rest+rlpSplit (x:rest) | x >= 128 && x <= 128+55 =+  (RLPString $ w2c <$> strList, nextRest)+  where+    strLength = x-128+    (strList, nextRest) = splitAtWithError (fromIntegral strLength) rest+rlpSplit (x:rest) | x >= 0xB8 && x <= 0xBF =+  (RLPString $ w2c <$> strList, nextRest)+  where+    (strLength, restAfterLen) = getLength (fromIntegral x - 0xB7) rest+    (strList, nextRest) = splitAtWithError (fromIntegral strLength) restAfterLen+rlpSplit (x:rest) | x < 128 =+  (RLPScalar x, rest)+rlpSplit x = error ("Missing case in rlpSplit: " ++ show (B.pack x))++getRLPObjects::[Word8]->[RLPObject]+getRLPObjects [] = []+getRLPObjects theData = obj:getRLPObjects rest+  where+    (obj, rest) = rlpSplit theData++int2Bytes::Int->[Word8]+int2Bytes val | val < 256 = [fromIntegral val]+int2Bytes val | val < 65536 = +  map fromIntegral [0xFF .&. (val16 `shiftR` 8), 0xFF .&. val16]+  where val16 = fromIntegral val::Word16+int2Bytes _ = error "int2Bytes not defined for val > 65535."++rlp2Bytes::RLPObject->[Word8]+rlp2Bytes (RLPScalar val) = [fromIntegral val]+rlp2Bytes (RLPString s) | length s <= 55 = 0x80 + fromIntegral (length s):(c2w <$> s)+rlp2Bytes (RLPString s) =+  [0xB7 + fromIntegral (length lengthAsBytes)] ++ lengthAsBytes ++ (c2w <$> s)+  where+    lengthAsBytes = int2Bytes $ length s+rlp2Bytes (RLPArray innerObjects) =+  if length innerBytes <= 55+  then 0xC0 + fromIntegral (length innerBytes):innerBytes+  else let lenBytes = int2Bytes $ length innerBytes+       in [0xF7 + fromIntegral (length lenBytes)] ++ lenBytes ++ innerBytes+  where+    innerBytes = concat $ rlp2Bytes <$> innerObjects++--TODO- Probably should just use Data.Binary's 'Binary' class for this++-- | Converts bytes to 'RLPObject's.+--+-- Full deserialization of an object can be obtained using @rlpDecode . rlpDeserialize@.+rlpDeserialize::B.ByteString->RLPObject+rlpDeserialize s = +  case rlpSplit $ B.unpack s of+    (o, []) -> o+    _ -> error ("parse error converting ByteString to an RLP Object: " ++ show (B.unpack s))+++-- | Converts 'RLPObject's to bytes.+--+-- Full serialization of an object can be obtained using @rlpSerialize . rlpEncode@.+rlpSerialize::RLPObject->B.ByteString+rlpSerialize o = B.pack $ rlp2Bytes o+++instance RLPSerializable Integer where+  rlpEncode 0 = RLPString []+  rlpEncode x | x < 128 = RLPScalar $ fromIntegral x+  rlpEncode x = RLPString $ w2c <$> integer2Bytes x+  rlpDecode (RLPScalar x) = fromIntegral x+  rlpDecode (RLPString s) = byteString2Integer $ BC.pack s+  rlpDecode (RLPArray _) = error "rlpDecode called for Integer for array"++instance RLPSerializable String where+  rlpEncode [c] | c2w c < 128 = RLPScalar $ c2w c+  rlpEncode s = RLPString s+  rlpDecode (RLPString s) = s+  rlpDecode (RLPScalar n) = [w2c $ fromIntegral n]+  rlpDecode (RLPArray x) = error $ "Malformed RLP in call to rlpDecode for String: RLPObject is an array: " ++ show (pretty x)++instance RLPSerializable B.ByteString where+    rlpEncode s = rlpEncode $ BC.unpack s+      +    rlpDecode (RLPScalar x) = B.singleton x+    rlpDecode (RLPString s) = BC.pack s+    rlpDecode x = error ("rlpDecode for ByteString not defined for: " ++ show x)

@@ -0,0 +1,24 @@++module Blockchain.Data.Util (+  byteString2Integer,+  bytes2Integer,+  integer2Bytes+  ) where++import Data.Bits+import qualified Data.ByteString as B+import Data.Word++--I hate this, it is an ugly way to create an Integer from its component bytes.+--There should be an easier way....+--See http://stackoverflow.com/questions/25854311/efficient-packing-bytes-into-integers+byteString2Integer::B.ByteString->Integer+byteString2Integer x = bytes2Integer $ B.unpack x++bytes2Integer::[Word8]->Integer+bytes2Integer [] = 0+bytes2Integer (byte:rest) = fromIntegral byte `shift` (8 * length rest) + bytes2Integer rest++integer2Bytes::Integer->[Word8]+integer2Bytes 0 = []+integer2Bytes x = integer2Bytes (x `shiftR` 8) ++ [fromInteger (x .&. 255)]

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Functor+import Data.List+import Data.Monoid+import System.Exit+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import Blockchain.Data.RLP++testNumber::Assertion+testNumber = do+  let n = 20::Integer+  assertEqual "rlp encoding failed for small number" (rlpDecode $ rlpDeserialize $ rlpSerialize $ rlpEncode n) n++main::IO ()+main = +  defaultMainWithOpts +  [+   testCase "test RLP number encoding" testNumber+  ] mempty