eths-rlp (empty) → 0.1.0.0

raw patch · 8 files changed

+197/−0 lines, 8 filesdep +QuickCheckdep +basedep +binarysetup-changed

Dependencies added: QuickCheck, base, binary, binary-strict, bytestring, doctest, eths-rlp, hscolour, hspec, quickcheck-instances

Files

• ChangeLog.md +0/−0
• LICENSE +20/−0
• README.md +3/−0
• Setup.hs +2/−0
• eths-rlp.cabal +56/−0
• src/Blockchain/Ethereum/RLP.hs +110/−0
• test-suite/DocTests.hs +4/−0
• test-suite/Spec.hs +2/−0

@@ -0,0 +1,20 @@+Copyright (c) 2016 Leonid Logvinov++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,3 @@+# RLP [![Build Status](https://travis-ci.org/LogvinovLeon/RLP.svg?branch=master)](https://travis-ci.org/LogvinovLeon/RLP) [![Gitter Chat](https://img.shields.io/gitter/room/gitterHQ/gitter.svg)](https://gitter.im/RLP-hs/Lobby)++Ethereum RLP implementation in Haskell

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,56 @@+name:                eths-rlp+version:             0.1.0.0+synopsis:            Ethereum Recursive Length Prefix Encoding+description:         RLP encoding/decoding, as described in the Ethereum Yellowpaper+license:             MIT+license-file:        LICENSE+author:              Leonid Logvinov+maintainer:          logvinov.leon@gmail.com+copyright:           2016 Leonid Logvinov+category:            Ethereum, Finance, Data, Contracts, Network+build-type:          Simple+extra-source-files:  ChangeLog.md, README.md+cabal-version:       >=1.10++flag documentation+  default: False++library+  exposed-modules: Blockchain.Ethereum.RLP+  build-depends:+    base >= 4 && < 5,+    bytestring,+    binary,+    binary-strict+  if flag(documentation)+        build-depends: hscolour == 1.20.*+  hs-source-dirs:      src+  ghc-Options:         -Wall+  default-language:    Haskell2010++Test-Suite doctest+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  HS-Source-Dirs:       test-suite+  Ghc-Options:          -threaded -Wall+  Main-Is:              DocTests.hs+  Build-Depends:+    base >= 4 && < 5,+    doctest++test-suite hspec+    build-depends:+      base,+      eths-rlp,+      bytestring,+      hspec,+      QuickCheck,+      quickcheck-instances+    default-language: Haskell2010+    hs-source-dirs:   test-suite+    main-is:          Spec.hs+    type:             exitcode-stdio-1.0++Source-Repository head+  Type:                 git+  Location:             https://github.com/LogvinovLeon/RLP

@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+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)++-- | Serialize RLPObject to ByteString+--+-- Examples:+-- >>> rlpSerialize $ RLPItem B.empty+-- "\128"+-- >>> rlpSerialize $ RLPList []+-- "\192"+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++-- | Deserialize ByteString to RLPObject+--+-- Examples:+-- >>> rlpDeserialize $ B.pack [128]+-- (Right (RLPItem ""),"")+-- >>> rlpDeserialize $ B.pack [192]+-- (Right (RLPList []),"")+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

@@ -0,0 +1,4 @@+import Test.DocTest++main::IO ()+main = doctest ["-isrc", "src/Blockchain/Ethereum/RLP.hs"]

@@ -0,0 +1,2 @@+-- test-suite/Spec.hs+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}