ethereum-rlp 0.0.1 → 0.1.0

raw patch · 7 files changed

+231/−246 lines, 7 filesdep +ethereum-rlpdep ~HUnitdep ~ansi-wl-pprintdep ~base16-bytestringsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: ethereum-rlp

Dependency ranges changed: HUnit, ansi-wl-pprint, base16-bytestring, bytestring, test-framework, test-framework-hunit

API changes (from Hackage documentation)

Files

• LICENSE +10/−28
• Setup.hs +0/−8
• ethereum-rlp.cabal +37/−33
• library/Blockchain/Data/RLP.hs +160/−0
• library/Blockchain/Data/Util.hs +24/−0
• src/Blockchain/Data/RLP.hs +0/−153
• src/Blockchain/Data/Util.hs +0/−24

@@ -1,31 +1,13 @@--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.+Copyright 2016 BlockApps, Inc -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.+Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at -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.+    http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

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

@@ -1,5 +1,5 @@ name: ethereum-rlp-version: 0.0.1+version: 0.1.0 cabal-version: >=1.10 build-type: Simple author: Jamshid@@ -7,44 +7,48 @@ maintainer:    jamshidnh@gmail.com synopsis: Ethereum Recursive Length Prefix Encoding category:      Data Structures-license: BSD3+license: Apache-2.0 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+  location: https://github.com/blockapps/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+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  exposed-modules:+    Blockchain.Data.RLP+  other-modules:+    Blockchain.Data.Util+  build-depends:+    bytestring == 0.10.*,+    base16-bytestring == 0.1.*,+    ansi-wl-pprint == 0.6.*,+    base >= 4 && < 5 -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+test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    ethereum-rlp,+    -- +    test-framework == 0.8.*,+    test-framework-hunit == 0.3.*,+    HUnit == 1.*,+    -- +    base == 4.*

@@ -0,0 +1,160 @@+{-# 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(..),+  formatRLPObject,+  RLPSerializable(..),+  rlpSplit,+  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.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 B.ByteString | 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 s)++formatRLPObject::RLPObject->String+formatRLPObject = show . pretty++splitAtWithError::Int->B.ByteString->(B.ByteString, B.ByteString)+splitAtWithError i s | i > B.length s = error "splitAtWithError called with n > length arr"+splitAtWithError i s = B.splitAt i s++getLength::Int->B.ByteString->(Integer, B.ByteString)+getLength sizeOfLength bytes =+  (bytes2Integer $ B.unpack $ B.take sizeOfLength bytes, B.drop sizeOfLength bytes)++rlpSplit::B.ByteString->(RLPObject, B.ByteString)+rlpSplit input =+  case B.head input of+    x | x >= 192 && x <= 192+55 ->+      let (arrayData, nextRest) =+            splitAtWithError (fromIntegral x - 192) $ B.tail input+      in (RLPArray $ getRLPObjects arrayData, nextRest)++    x | x >= 0xF8 && x <= 0xFF ->+      let +        (arrLength, restAfterLen) = getLength (fromIntegral x - 0xF7) $ B.tail input+        (arrayData, nextRest) = splitAtWithError (fromIntegral arrLength) restAfterLen+      in (RLPArray $ getRLPObjects arrayData, nextRest)++    x | x >= 128 && x <= 128+55 ->+      let+        (strList, nextRest) = splitAtWithError (fromIntegral $ x - 128) $ B.tail input+      in +       (RLPString strList, nextRest)++    x | x >= 0xB8 && x <= 0xBF ->+      let +        (strLength, restAfterLen) = getLength (fromIntegral x - 0xB7) $ B.tail input+        (strList, nextRest) = splitAtWithError (fromIntegral strLength) restAfterLen+      in+       (RLPString strList, nextRest)++    x | x < 128 -> (RLPScalar x, B.tail input)+            +    x -> error ("Missing case in rlpSplit: " ++ show x)++    +getRLPObjects::ByteString->[RLPObject]+getRLPObjects x | B.null x = []+getRLPObjects theData = obj:getRLPObjects rest+  where+    (obj, rest) = rlpSplit theData++int2Bytes::Int->[Word8]+int2Bytes val | val < 0x100 = map (fromIntegral . (val `shiftR`)) [0]+int2Bytes val | val < 0x10000 = map (fromIntegral . (val `shiftR`)) [8, 0]+int2Bytes val | val < 0x1000000 = map (fromIntegral . (val `shiftR`)) [16,  8, 0]+int2Bytes val | val < 0x100000000 = map (fromIntegral . (val `shiftR`)) [24, 16..0]+int2Bytes val | val < 0x10000000000 = map (fromIntegral . (val `shiftR`)) [32, 24..0]+int2Bytes _ = error "int2Bytes not defined for val >= 0x10000000000."++rlp2Bytes::RLPObject->[Word8]+rlp2Bytes (RLPScalar val) = [fromIntegral val]+rlp2Bytes (RLPString s) | B.length s <= 55 = 0x80 + fromIntegral (B.length s):B.unpack s+rlp2Bytes (RLPString s) =+  [0xB7 + fromIntegral (length lengthAsBytes)] ++ lengthAsBytes ++ B.unpack s+  where+    lengthAsBytes = int2Bytes $ B.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 s of+    (o, x) | B.null x -> 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 B.empty+  rlpEncode x | x < 0     = error "cannot encode negative numbers in RLP"+  rlpEncode x | x < 128   = RLPScalar $ fromIntegral x+  rlpEncode x             = RLPString $ B.pack $ integer2Bytes x+  rlpDecode (RLPScalar x) = fromIntegral x+  rlpDecode (RLPString s) = byteString2Integer s+  rlpDecode (RLPArray _)  = error "rlpDecode called for Integer for array"++instance RLPSerializable String where+  rlpEncode s = rlpEncode $ BC.pack s++  rlpDecode (RLPString s) = BC.unpack 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 x | B.length x == 1 && B.head x < 128 = RLPScalar $ B.head x+    rlpEncode s = RLPString s+      +    rlpDecode (RLPScalar x) = B.singleton x+    rlpDecode (RLPString s) = 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)]

@@ -1,153 +0,0 @@-{-# 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)

@@ -1,24 +0,0 @@--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)]