{-# 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 ()