ethereum-client-haskell (empty) → 0.0.1
raw patch · 7 files changed
+677/−0 lines, 7 filesdep +HUnitdep +ansi-wl-pprintdep +arraysetup-changed
Dependencies added: HUnit, ansi-wl-pprint, array, base, base16-bytestring, binary, bytestring, cmdargs, containers, cryptohash, data-default, directory, either, entropy, ethereum-merkle-patricia-db, ethereum-rlp, filepath, haskoin, leveldb-haskell, mtl, network, network-simple, nibblestring, resourcet, test-framework, test-framework-hunit, time, transformers, vector
Files
- LICENSE +31/−0
- Setup.hs +8/−0
- ethereum-client-haskell.cabal +93/−0
- fastNonceFinder/nonceFinder.c +152/−0
- queryEth_src/Main.hs +86/−0
- src/Main.hs +236/−0
- test/Main.hs +71/−0
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,8 @@++module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+
+ ethereum-client-haskell.cabal view
@@ -0,0 +1,93 @@+name: ethereum-client-haskell+version: 0.0.1+cabal-version: >=1.10+build-type: Simple+author: Jamshid+license-file: LICENSE+maintainer: jamshidnh@gmail.com+synopsis: A Haskell version of an Ethereum client+category: Data Structures+license: BSD3+description: + The client described in the Ethereum Yellowpaper++source-repository this+ type: git+ location: https://github.com/jamshidh/ethereum-client-haskell+ branch: master+ tag: v0.0.1++executable ethereumH+ default-language: Haskell98+ build-depends: + base >= 4 && < 5+ , base16-bytestring+ , binary+ , bytestring+ , containers+ , cryptohash+ , data-default+ , directory+ , either+ , entropy+ , ethereum-merkle-patricia-db+ , ethereum-rlp+ , filepath+ , haskoin+ , leveldb-haskell+ , mtl+ , network+ , network-simple+ , nibblestring+ , resourcet+ , time+ , transformers+ , vector+ , ansi-wl-pprint+ main-is: Main.hs+ C-sources: fastNonceFinder/nonceFinder.c+ ghc-options: -Wall+ buildable: True+ hs-source-dirs: src++executable queryEth+ default-language: Haskell98+ build-depends: + base >= 4 && < 5+ , ansi-wl-pprint+ , cmdargs+ , cryptohash+ , binary+ , bytestring+ , containers+ , ethereum-rlp+ , ethereum-merkle-patricia-db+ , filepath+ , time+ , network-simple+ , nibblestring+ , haskoin+ , base16-bytestring+ , mtl+ , network+ , transformers+ , resourcet+ , data-default+ , leveldb-haskell+ , array+ , directory+ main-is: Main.hs+ C-sources: fastNonceFinder/nonceFinder.c+ buildable: True+ hs-source-dirs: queryEth_src, src++Test-Suite test-ethereumH+ default-language: Haskell98+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test, src+ build-depends: base >= 4 && < 5+ , test-framework+ , test-framework-hunit+ , HUnit+ , containers
+ fastNonceFinder/nonceFinder.c view
@@ -0,0 +1,152 @@++#include <assert.h>+#include <pthread.h>+#include <stdio.h>+#include <stdbool.h>+#include <stdlib.h>+#include <string.h>+#include <inttypes.h>++#include "sha3.h"++#define NUMTHREADS 8++pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;++uint8_t savedNonce[32];+volatile bool nonceFound;++void saveNonce(uint8_t *val) {++ pthread_mutex_lock(&mutex);++ if (nonceFound) return; //Too late, you've been beaten to it++ memcpy(savedNonce, val, 32);++ nonceFound=true;++ pthread_mutex_unlock(&mutex);++}++struct ThreadData {+ int thread_num;+ uint8_t data[32];+ uint8_t threshold[32];+};++void getHash(uint8_t *in, uint8_t *out) {+ struct sha3_ctx ctx;+ sha3_init(&ctx, 256);+ sha3_update(&ctx, in, 64);+ sha3_finalize(&ctx, out);+}++int compare256(uint8_t first[32], uint8_t second[32]) {+ int i;+ for(i = 0; i < 32; i++) {+ if (first[i] < second[i]) return -1;+ else if (first[i] > second[i]) return 1;+ }+ return 0;+}++void increment256(uint8_t val[32]) {+ int i;+ for(i=31; i >= 0; i--) {+ val[i]++;+ if (val[i] != 0) return;+ }+}++void print256(uint8_t val[32]) {+ int i;+ for(i = 0; i < 32; i++)+ printf("%02x", val[i]);+ printf("\n");+}++void *calculateHashes(void *x) {+ uint8_t dataAndNonce[64] = {0};+ uint8_t out[32];++ struct ThreadData *threadData = (struct ThreadData *) x;++ printf("%d, #### starting thread\n", threadData->thread_num);+ ++ memcpy(dataAndNonce, threadData->data, 32);++ uint64_t i;+++ *(dataAndNonce + 32) = threadData->thread_num;+ while(true){+ //No mutex needed, because this is just a bool, it is only flipped to true in one place, and + //even if I read while writing, the worst case is that I calculate one extra sha hash.+ if (nonceFound) return NULL;+ increment256(dataAndNonce+32);+ getHash(dataAndNonce, out);+ if (compare256(out, threadData->threshold) == -1) {+ printf("data: ");+ print256(dataAndNonce);+ printf("nonce: ");+ print256(dataAndNonce+32);+ printf("out: ");+ print256(out);+ printf("done\n");+ saveNonce(dataAndNonce+32);+ return NULL;+ }+ }++ printf("shouldn't be here\n");++ exit(1);+}++int findNonce(uint8_t data[32], uint8_t threshold[32], uint8_t *out) {+ pthread_t inc_x_thread[NUMTHREADS];+ struct ThreadData threadData[NUMTHREADS];++ printf("data: ");+ print256(data);+ printf("threshold: ");+ print256(threshold);++ int thread_num;++ int i;++ nonceFound=false;++ for(thread_num = 0; thread_num < NUMTHREADS-1; thread_num++) {+ + memcpy(threadData[thread_num].threshold, threshold, 32);+ memcpy(threadData[thread_num].data, data, 32);+ threadData[thread_num].thread_num = thread_num;++ if(pthread_create(&inc_x_thread[thread_num], NULL, calculateHashes, (threadData+thread_num))) {+ fprintf(stderr, "Error creating thread\n");+ return 1;+ }+ }++ for(thread_num = 0; thread_num < NUMTHREADS-1; thread_num++) {+ if(pthread_join(inc_x_thread[thread_num], NULL)) {+ fprintf(stderr, "Error joining thread\n");+ return 2;+ }+ }++ assert(nonceFound);++ printf("savedNonce: ");+ print256(savedNonce);++ memcpy(out, savedNonce, 32);++ return 0;+ +}
+ queryEth_src/Main.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}++import System.Console.CmdArgs++import State+import Block+import Init+import Code++--import Debug.Trace++++import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Char8 as BC+--import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))++import Blockchain.ExtDBs+++data Options = + State{root::String, db::String} + | Block{hash::String, db::String} + | Code{hash::String, db::String}+ | Init{hash::String, db::String}+ deriving (Show, Data, Typeable)++stateOptions::Annotate Ann+stateOptions = + record State{root=undefined, db=undefined} [+ root := def += typ "SHAPtr" += argPos 1,+ db := def += typ "DBSTRING" += argPos 0+ ]++blockOptions::Annotate Ann+blockOptions = + record Block{hash=undefined, db=undefined} [+ hash := def += typ "FILENAME" += argPos 1 += opt ("-"::String),+ db := def += typ "DBSTRING" += argPos 0+ ]++initOptions::Annotate Ann+initOptions = + record Init{hash=undefined, db=undefined} [+ hash := def += typ "FILENAME" += argPos 1 += opt ("-"::String),+ db := def += typ "DBSTRING" += argPos 0+ ]++codeOptions::Annotate Ann+codeOptions = + record Code{hash=undefined, db=undefined} [+ hash := def += typ "USERAGENT" += argPos 1,+ db := def += typ "DBSTRING" += argPos 0+ ]++options::Annotate Ann+options = modes_ [stateOptions, blockOptions, initOptions, codeOptions]+++-- += summary "Apply shims, reorganize, and generate to the input"+++main::IO ()+main = do+ opts <- cmdArgs_ options+ run opts+ +-------------------+++run::Options->IO ()++run State{root=r, db=db'} = do+ let sr = SHAPtr $ fst $ B16.decode $ BC.pack r+ State.doit db' sr++run Block{hash=h, db=db'} = do+ Block.doit db' h++run Init{hash=h, db=db'} = do+ Init.doit db' h++run Code{hash=h, db=db'} = do+ Code.doit db' h+
+ src/Main.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (+ main+ ) where++import Control.Monad.IO.Class+import Control.Monad.State+import Control.Monad.Trans.Resource+import Data.Bits+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+--import Data.Functor+import Data.Time.Clock+import Data.Word+import Network.Haskoin.Crypto hiding (Address)+import Network.Socket (socketToHandle)+--import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import System.Entropy+import System.Environment+import System.IO++import Network.Simple.TCP++import Blockchain.Data.RLP++import Blockchain.BlockChain+import Blockchain.BlockSynchronizer+import Blockchain.Communication+import Blockchain.Constants+import Blockchain.Context+import Blockchain.Data.Address+--import Data.AddressState+import Blockchain.Data.Block+--import Data.SignedTransaction+--import Data.Transaction+import Blockchain.Data.Wire+import Blockchain.Database.MerklePatricia+import Blockchain.Display+import Blockchain.DB.ModifyStateDB+import Blockchain.PeerUrls+--import SampleTransactions+import Blockchain.SHA+import Blockchain.Util++--import Debug.Trace+++prvKey::PrvKey+Just prvKey = makePrvKey 0xac3e8ce2ef31c3f45d5da860bcd9aee4b37a05c5a3ddee40dd061620c3dab380+--Just prvKey = makePrvKey 0xd69bceff85f3bc2d0a13bcc43b7caf6bd54a21ad0c1997ae623739216710ca19 --cpp client prvKey+--6ccf6b5c33ae2017a6c76b8791ca61276a69ab8e --cpp coinbase++++getNextBlock::Block->UTCTime->ContextM Block+getNextBlock b ts = do+ let theCoinbase = prvKey2Address prvKey+ setStateRoot $ bStateRoot bd+ addToBalance theCoinbase (1500*finney)++ ctx <- get++ return Block{+ blockData=testGetNextBlockData $ stateRoot $ stateDB ctx,+ receiptTransactions=[],+ blockUncles=[]+ }+ where+ testGetNextBlockData::SHAPtr->BlockData+ testGetNextBlockData sr =+ BlockData {+ parentHash=blockHash b,+ unclesHash=hash $ B.pack [0xc0],+ coinbase=prvKey2Address prvKey,+ bStateRoot = sr,+ transactionsRoot = emptyTriePtr,+ receiptsRoot = emptyTriePtr,+ logBloom = B.pack [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], + difficulty = nextDifficulty (difficulty bd) (timestamp bd) ts,+ number = number bd + 1,+ gasLimit = max 125000 ((gasLimit bd * 1023 + gasUsed bd *6 `quot` 5) `quot` 1024),+ gasUsed = 0,+ timestamp = ts, + extraData = 0,+ nonce = SHA 5+ }+ bd = blockData b+++submitNextBlock::Socket->Integer->Block->ContextM ()+submitNextBlock socket baseDifficulty b = do+ ts <- liftIO getCurrentTime+ newBlock <- getNextBlock b ts+ n <- liftIO $ fastFindNonce newBlock++ --let theBytes = headerHashWithoutNonce newBlock `B.append` B.pack (integer2Bytes n)+ let theNewBlock = addNonceToBlock newBlock n+ sendMessage socket $ NewBlockPacket theNewBlock (baseDifficulty + difficulty (blockData theNewBlock))+ addBlocks [theNewBlock]++ifBlockInDBSubmitNextBlock::Socket->Integer->Block->ContextM ()+ifBlockInDBSubmitNextBlock socket baseDifficulty b = do+ maybeBlock <- getBlock (blockHash b)+ case maybeBlock of+ Nothing -> return ()+ _ -> submitNextBlock socket baseDifficulty b++++handlePayload::Socket->B.ByteString->ContextM ()+handlePayload socket payload = do+ --liftIO $ print $ payload+ --liftIO $ putStrLn $ show $ pretty $ rlpDeserialize payload+ let rlpObject = rlpDeserialize payload+ let msg = obj2WireMessage rlpObject+ displayMessage False msg+ case msg of+ Hello{} -> do+ bestBlock <- getBestBlock+ genesisBlockHash <- getGenesisBlockHash+ sendMessage socket Status{protocolVersion=fromIntegral ethVersion, networkID="", totalDifficulty=0, latestHash=blockHash bestBlock, genesisHash=genesisBlockHash}+ Ping -> do+ addPingCount+ sendMessage socket Pong+ GetPeers -> do+ sendMessage socket $ Peers []+ sendMessage socket GetPeers+ (Peers thePeers) -> do+ setPeers thePeers+ BlockHashes blockHashes -> handleNewBlockHashes socket blockHashes+ Blocks blocks -> do+ handleNewBlocks socket blocks+ NewBlockPacket block baseDifficulty -> do+ addBlocks [block]+ ifBlockInDBSubmitNextBlock socket baseDifficulty block++ Status{latestHash=lh} ->+ handleNewBlockHashes socket [lh]+ GetTransactions -> do+ sendMessage socket $ Transactions []+ --liftIO $ sendMessage socket GetTransactions+ return ()+ + _-> return ()++getPayloads::[Word8]->[[Word8]]+getPayloads [] = []+getPayloads (0x22:0x40:0x08:0x91:s1:s2:s3:s4:remainder) =+ take payloadLength remainder:getPayloads (drop payloadLength remainder)+ where+ payloadLength = shift (fromIntegral s1) 24 + shift (fromIntegral s2) 16 + shift (fromIntegral s3) 8 + fromIntegral s4+getPayloads _ = error "Malformed data sent to getPayloads"++readAndOutput::Socket->ContextM ()+readAndOutput socket = do+ h <- liftIO $ socketToHandle socket ReadWriteMode+ payloads <- liftIO $ BL.hGetContents h+ handleAllPayloads $ getPayloads $ BL.unpack payloads+ where+ handleAllPayloads [] = error "Server has closed the connection"+ handleAllPayloads (pl:rest) = do+ handlePayload socket $ B.pack pl+ handleAllPayloads rest++mkHello::IO Message+mkHello = do+ peerId <- getEntropy 64+ return Hello {+ version = fromIntegral shhVersion,+ clientId = "Ethereum(G)/v0.6.4//linux/Haskell",+ capability = [ETH ethVersion, SHH shhVersion],+ port = 30303,+ nodeId = fromIntegral $ byteString2Integer peerId+ }++{-+createTransaction::Transaction->ContextM SignedTransaction+createTransaction t = do+ userNonce <- addressStateNonce <$> getAddressState (prvKey2Address prvKey)+ liftIO $ withSource devURandom $ signTransaction prvKey t{tNonce=userNonce}++createTransactions::[Transaction]->ContextM [SignedTransaction]+createTransactions transactions = do+ userNonce <- addressStateNonce <$> getAddressState (prvKey2Address prvKey)+ forM (zip transactions [userNonce..]) $ \(t, n) -> do+ liftIO $ withSource devURandom $ signTransaction prvKey t{tNonce=n}+-}++doit::Socket->ContextM ()+doit socket = do+ sendMessage socket =<< (liftIO mkHello)+ (setStateRoot . bStateRoot . blockData) =<< getBestBlock+ --signedTx <- createTransaction simpleTX+ --signedTx <- createTransaction outOfGasTX+ --signedTx <- createTransaction simpleStorageTX+ --signedTx <- createTransaction createContractTX+ --signedTx <- createTransaction sendMessageTX++ --signedTx <- createTransaction createContractTX+ --signedTx <- createTransaction paymentContract+ --signedTx <- createTransaction sendCoinTX+ --signedTx <- createTransaction keyValuePublisher+ --signedTx <- createTransaction sendKeyVal++ --liftIO $ print $ whoSignedThisTransaction signedTx++ + --liftIO $ sendMessage socket $ Transactions [signedTx]+++ --signedTxs <- createTransactions [createMysteryContract]+ --liftIO $ sendMessage socket $ Transactions signedTxs+++ readAndOutput socket++main::IO () +main = do++ args <- getArgs++ let ipNum =+ case args of+ (arg:_) -> arg+ [] -> "119" --Just default to the one I know works right now.... Yup, this is kind of dumb.++ let (ipAddress, port') = ipAddresses !! read ipNum++ connect ipAddress port' $ \(socket, _) -> do+ putStrLn "Connected"++ runResourceT $ do+ cxt <- openDBs "h"+ _ <- liftIO $ runStateT (doit socket) cxt+ return ()
+ test/Main.hs view
@@ -0,0 +1,71 @@++module Main where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Data.Default+import Data.Functor+import Data.List+import Data.Monoid+import qualified Data.Set as S+import System.Exit+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import qualified Data.NibbleString as N++import Data.Address+import Format+import DB.ModifyStateDB+import Database.MerklePatricia+import Data.RLP+import SHA+import Util++putKeyVals::MPDB->[(N.NibbleString, B.ByteString)]->ResourceT IO MPDB+putKeyVals db [(k,v)] = putKeyVal db k (rlpEncode v)+putKeyVals db ((k, v):rest) = do+ db'<- putKeyVal db k $ rlpEncode v+ putKeyVals db' rest++verifyDBDataIntegrity::MPDB->[(N.NibbleString, B.ByteString)]->ResourceT IO ()+verifyDBDataIntegrity db valuesIn = do+ db2 <- initializeBlankStateDB db+ db3 <- putKeyVals db2 valuesIn+ --return (db, stateRoot2)+ valuesOut <- getKeyVals db3 (N.EvenNibbleString B.empty)+ liftIO $ assertEqual "empty db didn't match" (S.fromList $ fmap rlpEncode <$> valuesIn) (S.fromList valuesOut)+ return ()++testShortcutNodeDataInsert::Assertion+testShortcutNodeDataInsert = do+ runResourceT $ do+ db <- openDBs False+ verifyDBDataIntegrity db+ [+ (N.EvenNibbleString $ BC.pack "abcd", BC.pack "abcd"),+ (N.EvenNibbleString $ BC.pack "aefg", BC.pack "aefg")+ ]++testFullNodeDataInsert::Assertion+testFullNodeDataInsert = do+ runResourceT $ do+ db <- openDBs False+ verifyDBDataIntegrity db+ [+ (N.EvenNibbleString $ BC.pack "abcd", BC.pack "abcd"),+ (N.EvenNibbleString $ BC.pack "bb", BC.pack "bb"),+ (N.EvenNibbleString $ BC.pack "aefg", BC.pack "aefg")+ ]++main::IO ()+main = + defaultMainWithOpts + [+ testCase "ShortcutNodeData Insert" testShortcutNodeDataInsert,+ testCase "FullNodeData Insert" testFullNodeDataInsert+ ] mempty