Block.hs

module Data.Blockchain.Mining.Block
    ( MineBlockException(..)
    , mineBlock
    , mineEmptyBlock
    , mineGenesisBlock
    ) where

import qualified Data.ByteString.Char8  as Char8
import qualified Data.List.NonEmpty     as NonEmpty
import qualified Data.Time.Clock        as Time
import qualified Data.Word              as Word

import qualified Data.Blockchain        as Blockchain
import qualified Data.Blockchain.Crypto as Crypto

data MineBlockException
    = InvalidTransactionList
  deriving (Eq, Show)

-- | Finds the next block of a blockchain. Depending on blockchain configuration, this function may take a long time to complete.
mineBlock
    :: Crypto.PublicKey         -- ^ PublicKey address where coinbase reward will be sent
    -> [Blockchain.Transaction] -- ^ List of transactions to include in transaction
    -> Blockchain.Blockchain Blockchain.Validated -- ^ Validated blockchain
    -> IO (Either MineBlockException Blockchain.Block)
mineBlock pubKey txs blockchain =
    case Blockchain.validateTransactions blockchain txs of
        Left _e  -> return (Left InvalidTransactionList)
        Right () -> Right <$> mineBlockInternal pubKey reward diff1 difficulty prevBlockHeaderHash txs
  where
    diff1               = Blockchain.difficulty1Target config
    reward              = Blockchain.targetReward config (fromIntegral $ length prevBlocks + 1)
    config              = Blockchain.blockchainConfig blockchain
    difficulty          = Blockchain.targetDifficulty config $ NonEmpty.toList prevBlocks -- TODO: next diff?
    prevBlocks          = Blockchain.longestChain blockchain
    prevBlock           = NonEmpty.last prevBlocks
    prevBlockHeaderHash = Crypto.hash (Blockchain.blockHeader prevBlock)

-- | Finds the next block of a blockchain, without including any transactions.
-- Most useful for testing - removes the invariant of an invalid transaction list.
-- Depending on blockchain configuration, this function may take a long time to complete.
mineEmptyBlock
    :: Crypto.PublicKey -- ^ PublicKey address where coinbase reward will be sent
    -> Blockchain.Blockchain Blockchain.Validated -- ^ Validated blockchain
    -> IO (Either MineBlockException Blockchain.Block)
mineEmptyBlock pubKey = mineBlock pubKey mempty

-- | Finds the first block of a blockchain.
-- Depending on blockchain configuration, this function may take a long time to complete.
-- Note: this generates a keypair but throws away the private key. Coinbase reward in genesis block cannot never be spent.
mineGenesisBlock :: Blockchain.BlockchainConfig -> IO Blockchain.Block
mineGenesisBlock config = do
    (Crypto.KeyPair pubKey _privKey) <- Crypto.generate

    mineBlockInternal pubKey reward diff1 difficulty prevBlockHeaderHash mempty
  where
    diff1               = Blockchain.difficulty1Target config
    reward              = Blockchain.initialMiningReward config
    difficulty          = Blockchain.initialDifficulty config
    prevBlockHeaderHash = Crypto.unsafeFromByteString $ Char8.replicate 64 '0'

-- TODO: accept multiple public keys
mineBlockInternal
    :: Crypto.PublicKey -> Word.Word -> Blockchain.Hex256 -> Blockchain.Difficulty
    -> Crypto.Hash Blockchain.BlockHeader -> [Blockchain.Transaction]
    -> IO Blockchain.Block
mineBlockInternal pubKey reward diff1 difficulty prevBlockHeaderHash txs = do
    header <- mineHeader
        prevBlockHeaderHash
        (Crypto.hash coinbaseTx)
        (Crypto.hashTreeRoot txs)
        diff1
        difficulty

    -- TODO: add up fees and include in coinbase reward
    -- fee = address value - total tx value
    return (Blockchain.Block header coinbaseTx txs)
  where
    coinbaseTx = Blockchain.CoinbaseTransaction $ pure (Blockchain.TransactionOut reward pubKey)

-- TODO: could clean up param list by passing config down to this level
mineHeader
    :: Crypto.Hash Blockchain.BlockHeader
    -> Crypto.Hash Blockchain.CoinbaseTransaction
    -> Crypto.HashTreeRoot Blockchain.Transaction
    -> Blockchain.Hex256
    -> Blockchain.Difficulty
    -> IO Blockchain.BlockHeader
mineHeader prevBlockHeaderHash coinbaseTransactionHash transactionHashTreeRoot diff1 difficulty = do
    time <- Time.getCurrentTime

    let version = 0
        nonce   = 0
        initialHeader = Blockchain.BlockHeader{..}

    mineHeaderInternal initialHeader
  where
    -- TODO: get current time in case of int overflow,
    -- or in case current mining operation is getting close to oldest block time
    mineHeaderInternal header =
        if Blockchain.blockHeaderHashDifficulty diff1 header >= difficulty
            then return header
            else mineHeaderInternal (incNonce header)


incNonce :: Blockchain.BlockHeader -> Blockchain.BlockHeader
incNonce header = header { Blockchain.nonce = Blockchain.nonce header + 1 }