{-# LANGUAGE OverloadedStrings, ForeignFunctionInterface #-} module Blockchain.Data.Block ( BlockData(..), Block(..), blockHash, powFunc, headerHashWithoutNonce, addNonceToBlock, findNonce, fastFindNonce, nonceIsValid, getBlock, putBlock ) where import qualified Crypto.Hash.SHA3 as C import Data.Binary import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Base16 as B16 import Data.ByteString.Internal import Data.Functor import Data.List import Data.Maybe import Data.Time import Data.Time.Clock.POSIX import Foreign import Foreign.ForeignPtr.Unsafe import Numeric import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import Blockchain.Context import Blockchain.Data.Address import qualified Blockchain.Colors as CL import Blockchain.Database.MerklePatricia import Blockchain.ExtDBs import Blockchain.Format import Blockchain.Data.RLP import Blockchain.SHA import Blockchain.Data.SignedTransaction import Blockchain.Util --import Debug.Trace data BlockData = BlockData { parentHash::SHA, unclesHash::SHA, coinbase::Address, bStateRoot::SHAPtr, transactionsRoot::SHAPtr, receiptsRoot::SHAPtr, logBloom::B.ByteString, difficulty::Integer, number::Integer, gasLimit::Integer, gasUsed::Integer, timestamp::UTCTime, extraData::Integer, nonce::SHA } deriving (Show) data Block = Block { blockData::BlockData, receiptTransactions::[SignedTransaction], blockUncles::[BlockData] } deriving (Show) instance Format Block where format b@Block{blockData=bd, receiptTransactions=receipts, blockUncles=uncles} = CL.blue ("Block #" ++ show (number bd)) ++ " " ++ tab (show (pretty $ blockHash b) ++ "\n" ++ format bd ++ (if null receipts then " (no transactions)\n" else tab (intercalate "\n " (format <$> receipts))) ++ (if null uncles then " (no uncles)" else tab ("Uncles:" ++ tab ("\n" ++ intercalate "\n " (format <$> uncles))))) instance RLPSerializable Block where rlpDecode (RLPArray [bd, RLPArray transactionReceipts, RLPArray uncles]) = Block (rlpDecode bd) (rlpDecode <$> transactionReceipts) (rlpDecode <$> uncles) rlpDecode (RLPArray arr) = error ("rlpDecode for Block called on object with wrong amount of data, length arr = " ++ show arr) rlpDecode x = error ("rlpDecode for Block called on non block object: " ++ show x) rlpEncode Block{blockData=bd, receiptTransactions=receipts, blockUncles=uncles} = RLPArray [rlpEncode bd, RLPArray (rlpEncode <$> receipts), RLPArray $ rlpEncode <$> uncles] instance RLPSerializable BlockData where rlpDecode (RLPArray [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14]) = BlockData { parentHash = rlpDecode v1, unclesHash = rlpDecode v2, coinbase = rlpDecode v3, bStateRoot = rlpDecode v4, transactionsRoot = rlpDecode v5, receiptsRoot = rlpDecode v6, logBloom = rlpDecode v7, difficulty = rlpDecode v8, number = rlpDecode v9, gasLimit = rlpDecode v10, gasUsed = rlpDecode v11, timestamp = posixSecondsToUTCTime $ fromInteger $ rlpDecode v12, extraData = rlpDecode v13, nonce = rlpDecode v14 } rlpDecode (RLPArray arr) = error ("Error in rlpDecode for Block: wrong number of items, expected 14, got " ++ show (length arr) ++ ", arr = " ++ show (pretty arr)) rlpDecode x = error ("rlp2BlockData called on non block object: " ++ show x) rlpEncode bd = RLPArray [ rlpEncode $ parentHash bd, rlpEncode $ unclesHash bd, rlpEncode $ coinbase bd, rlpEncode $ bStateRoot bd, rlpEncode $ transactionsRoot bd, rlpEncode $ receiptsRoot bd, rlpEncode $ logBloom bd, rlpEncode $ difficulty bd, rlpEncode $ number bd, rlpEncode $ gasLimit bd, rlpEncode $ gasUsed bd, rlpEncode (round $ utcTimeToPOSIXSeconds $ timestamp bd::Integer), rlpEncode $ extraData bd, rlpEncode $ nonce bd ] blockHash::Block->SHA blockHash (Block info _ _) = hash . rlpSerialize . rlpEncode $ info instance Format BlockData where format b = "parentHash: " ++ show (pretty $ parentHash b) ++ "\n" ++ "unclesHash: " ++ show (pretty $ unclesHash b) ++ (if unclesHash b == hash (B.pack [0xc0]) then " (the empty array)\n" else "\n") ++ "coinbase: " ++ show (pretty $ coinbase b) ++ "\n" ++ "stateRoot: " ++ show (pretty $ bStateRoot b) ++ "\n" ++ "transactionsRoot: " ++ show (pretty $ transactionsRoot b) ++ "\n" ++ "receiptsRoot: " ++ show (pretty $ receiptsRoot b) ++ "\n" ++ "difficulty: " ++ show (difficulty b) ++ "\n" ++ "gasLimit: " ++ show (gasLimit b) ++ "\n" ++ "gasUsed: " ++ show (gasUsed b) ++ "\n" ++ "timestamp: " ++ show (timestamp b) ++ "\n" ++ "extraData: " ++ show (pretty $ extraData b) ++ "\n" ++ "nonce: " ++ show (pretty $ nonce b) ++ "\n" getBlock::SHA->ContextM (Maybe Block) getBlock h = fmap (rlpDecode . rlpDeserialize) <$> blockDBGet (BL.toStrict $ encode h) putBlock::Block->ContextM () putBlock b = do let bytes = rlpSerialize $ rlpEncode b blockDBPut (BL.toStrict $ encode $ blockHash b) bytes -------------------------- --Mining stuff --used as part of the powFunc noncelessBlockData2RLP::BlockData->RLPObject noncelessBlockData2RLP bd = RLPArray [ rlpEncode $ parentHash bd, rlpEncode $ unclesHash bd, rlpEncode $ coinbase bd, rlpEncode $ bStateRoot bd, rlpEncode $ transactionsRoot bd, rlpEncode $ receiptsRoot bd, rlpEncode $ logBloom bd, rlpEncode $ difficulty bd, rlpEncode $ number bd, rlpEncode $ gasLimit bd, rlpEncode $ gasUsed bd, rlpEncode (round $ utcTimeToPOSIXSeconds $ timestamp bd::Integer), rlpEncode $ extraData bd ] {- noncelessBlock2RLP::Block->RLPObject noncelessBlock2RLP Block{blockData=bd, receiptTransactions=receipts, blockUncles=[]} = RLPArray [noncelessBlockData2RLP bd, RLPArray (rlpEncode <$> receipts), RLPArray []] noncelessBlock2RLP _ = error "noncelessBock2RLP not definted for blockUncles /= []" -} sha2ByteString::SHA->B.ByteString sha2ByteString (SHA val) = BL.toStrict $ encode val headerHashWithoutNonce::Block->ByteString headerHashWithoutNonce b = C.hash 256 $ rlpSerialize $ noncelessBlockData2RLP $ blockData b powFunc::Block->Integer powFunc b = --trace (show $ headerHashWithoutNonce b) $ byteString2Integer $ C.hash 256 ( headerHashWithoutNonce b `B.append` sha2ByteString (nonce $ blockData b)) nonceIsValid::Block->Bool nonceIsValid b = powFunc b * difficulty (blockData b) < (2::Integer)^(256::Integer) addNonceToBlock::Block->Integer->Block addNonceToBlock b n = b { blockData=(blockData b) {nonce=SHA $ fromInteger n} } findNonce::Block->Integer findNonce b = fromMaybe (error "Huh? You ran out of numbers!!!!") $ find (nonceIsValid . addNonceToBlock b) [1..] ---------- fastFindNonce::Block->IO Integer fastFindNonce b = do let (theData, _, _) = toForeignPtr $ headerHashWithoutNonce b let (theThreshold, _, _) = toForeignPtr threshold retValue <- mallocArray 32 retInt <- c_fastFindNonce (unsafeForeignPtrToPtr theData) (unsafeForeignPtrToPtr theThreshold) retValue print retInt retData <- peekArray 32 retValue return $ byteString2Integer $ B.pack retData where threshold::B.ByteString threshold = fst $ B16.decode $ BC.pack $ padZeros 64 $ showHex ((2::Integer)^(256::Integer) `quot` difficulty (blockData b)) "" foreign import ccall "findNonce" c_fastFindNonce::Ptr Word8->Ptr Word8->Ptr Word8->IO Int --foreign import ccall "fastFindNonce" c_fastFindNonce::ForeignPtr Word8->ForeignPtr Word8->ForeignPtr Word8 {- fastFindNonce::Block->Integer fastFindNonce b = byteString2Integer $ BC.pack $ BC.unpack $ C.hash 256 ( first `B.append` second) where first = headerHashWithoutNonce b fastPowFunc::Block->Integer fastPowFunc b = --trace (show $ headerHashWithoutNonce b) $ byteString2Integer $ BC.pack $ BC.unpack $ C.hash 256 ( headerHashWithoutNonce b `B.append` sha2ByteString (nonce $ blockData b)) -}