blockchain 0.0.2 → 0.0.3

raw patch · 54 files changed

+1535/−1530 lines, 54 filesdep +quickcheck-instancesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: quickcheck-instances

API changes (from Hackage documentation)

Files

• README.md +4/−1
• blockchain.cabal +25/−23
• lib/Data/Blockchain.hs +9/−0
• lib/Data/Blockchain/Builder.hs +60/−0
• lib/Data/Blockchain/Core/Blockchain.hs +0/−328
• lib/Data/Blockchain/Core/Builder.hs +0/−61
• lib/Data/Blockchain/Core/Crypto.hs +0/−9
• lib/Data/Blockchain/Core/Crypto/ECDSA.hs +0/−131
• lib/Data/Blockchain/Core/Crypto/Hash.hs +0/−65
• lib/Data/Blockchain/Core/Crypto/HashTree.hs +0/−30
• lib/Data/Blockchain/Core/Types.hs +0/−13
• lib/Data/Blockchain/Core/Types/Block.hs +0/−37
• lib/Data/Blockchain/Core/Types/BlockchainConfig.hs +0/−101
• lib/Data/Blockchain/Core/Types/Difficulty.hs +0/−15
• lib/Data/Blockchain/Core/Types/Hex.hs +0/−64
• lib/Data/Blockchain/Core/Types/Transaction.hs +0/−79
• lib/Data/Blockchain/Crypto.hs +9/−0
• lib/Data/Blockchain/Crypto/ECDSA.hs +136/−0
• lib/Data/Blockchain/Crypto/Hash.hs +65/−0
• lib/Data/Blockchain/Crypto/HashTree.hs +30/−0
• lib/Data/Blockchain/Mining.hs +2/−2
• lib/Data/Blockchain/Mining/Block.hs +6/−7
• lib/Data/Blockchain/Mining/Blockchain.hs +2/−3
• lib/Data/Blockchain/Types.hs +15/−0
• lib/Data/Blockchain/Types/Block.hs +37/−0
• lib/Data/Blockchain/Types/Blockchain.hs +338/−0
• lib/Data/Blockchain/Types/BlockchainConfig.hs +103/−0
• lib/Data/Blockchain/Types/Difficulty.hs +15/−0
• lib/Data/Blockchain/Types/Hex.hs +64/−0
• lib/Data/Blockchain/Types/Transaction.hs +79/−0
• test/ArbitraryInstances.hs +7/−24
• test/Data/Blockchain/Builder/TransactionSpec.hs +73/−0
• test/Data/Blockchain/Core/BlockchainSpec.hs +0/−202
• test/Data/Blockchain/Core/Builder/TransactionSpec.hs +0/−76
• test/Data/Blockchain/Core/Crypto/ECDSASpec.hs +0/−22
• test/Data/Blockchain/Core/Crypto/HashSpec.hs +0/−23
• test/Data/Blockchain/Core/Crypto/HashTreeSpec.hs +0/−33
• test/Data/Blockchain/Core/Types/BlockchainConfigSpec.hs +0/−75
• test/Data/Blockchain/Core/Types/DifficultySpec.hs +0/−16
• test/Data/Blockchain/Core/Types/HexSpec.hs +0/−11
• test/Data/Blockchain/Core/Types/TransactionSpec.hs +0/−18
• test/Data/Blockchain/Crypto/ECDSASpec.hs +22/−0
• test/Data/Blockchain/Crypto/HashSpec.hs +23/−0
• test/Data/Blockchain/Crypto/HashTreeSpec.hs +33/−0
• test/Data/Blockchain/Mining/BlockSpec.hs +3/−4
• test/Data/Blockchain/Types/BlockchainConfigSpec.hs +75/−0
• test/Data/Blockchain/Types/BlockchainSpec.hs +203/−0
• test/Data/Blockchain/Types/DifficultySpec.hs +16/−0
• test/Data/Blockchain/Types/HexSpec.hs +11/−0
• test/Data/Blockchain/Types/TransactionSpec.hs +18/−0
• test/Integration/Mining.hs +14/−16
• test/Integration/Stats.hs +9/−10
• test/Main.hs +19/−19
• test/TestData.hs +10/−12

@@ -1,5 +1,7 @@ # blockchain +[Available on Hackage](https://hackage.haskell.org/package/blockchain)+ Generic blockchain implementation in Haskell. Heavily inspired by Bitcoin blockchain, but does not fully comply to the Bitcoin blockchain spec. Should be suitable for creating arbitrary Bitcoin-like blockchains with in various configurations.  Build@@ -37,7 +39,7 @@  ## docs -A blockchain is a config and a tree of blocks with each node having a potentially infinite set of branches. A `Blockchain` also includes a tag to note whether is has been verified to meet all the expected conditions -- `Blockchain Validated` or `Blockchain Unvalidated`. Docs are also available on [Hackage](https://hackage.haskell.org/package/blockchain).+A blockchain is a config and a tree of blocks with each node having a potentially infinite set of branches. A `Blockchain` also includes a tag to note whether is has been verified to meet all the expected conditions -- `Blockchain Validated` or `Blockchain Unvalidated`.  ```hs data Blockchain a = Blockchain@@ -78,6 +80,7 @@ * Implement max transaction count per block * Cache block header hash on block (and maybe transactions) for more efficient operations   * Maybe cache on the blockchain itself, and `validate` computes/checks hashes?+* Run lint in CI  ## references 

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.15.0.+-- This file has been generated from package.yaml by hpack version 0.14.0. -- -- see: https://github.com/sol/hpack  name:           blockchain-version:        0.0.2+version:        0.0.3 synopsis:       Generic blockchain implementation. description:    Please see README.md category:       Blockchain@@ -40,22 +40,23 @@     , transformers     , unordered-containers   exposed-modules:-      Data.Blockchain.Core.Blockchain-      Data.Blockchain.Core.Builder-      Data.Blockchain.Core.Crypto-      Data.Blockchain.Core.Types+      Data.Blockchain+      Data.Blockchain.Builder+      Data.Blockchain.Crypto+      Data.Blockchain.Types       Data.Blockchain.Mining   other-modules:-      Data.Blockchain.Core.Crypto.ECDSA-      Data.Blockchain.Core.Crypto.Hash-      Data.Blockchain.Core.Crypto.HashTree-      Data.Blockchain.Core.Types.Block-      Data.Blockchain.Core.Types.BlockchainConfig-      Data.Blockchain.Core.Types.Difficulty-      Data.Blockchain.Core.Types.Hex-      Data.Blockchain.Core.Types.Transaction+      Data.Blockchain.Crypto.ECDSA+      Data.Blockchain.Crypto.Hash+      Data.Blockchain.Crypto.HashTree       Data.Blockchain.Mining.Block       Data.Blockchain.Mining.Blockchain+      Data.Blockchain.Types.Block+      Data.Blockchain.Types.Blockchain+      Data.Blockchain.Types.BlockchainConfig+      Data.Blockchain.Types.Difficulty+      Data.Blockchain.Types.Hex+      Data.Blockchain.Types.Transaction       Paths_blockchain   default-language: Haskell2010 @@ -86,18 +87,19 @@     , deepseq     , hspec     , QuickCheck+    , quickcheck-instances   other-modules:       ArbitraryInstances-      Data.Blockchain.Core.BlockchainSpec-      Data.Blockchain.Core.Builder.TransactionSpec-      Data.Blockchain.Core.Crypto.ECDSASpec-      Data.Blockchain.Core.Crypto.HashSpec-      Data.Blockchain.Core.Crypto.HashTreeSpec-      Data.Blockchain.Core.Types.BlockchainConfigSpec-      Data.Blockchain.Core.Types.DifficultySpec-      Data.Blockchain.Core.Types.HexSpec-      Data.Blockchain.Core.Types.TransactionSpec+      Data.Blockchain.Builder.TransactionSpec+      Data.Blockchain.Crypto.ECDSASpec+      Data.Blockchain.Crypto.HashSpec+      Data.Blockchain.Crypto.HashTreeSpec       Data.Blockchain.Mining.BlockSpec+      Data.Blockchain.Types.BlockchainConfigSpec+      Data.Blockchain.Types.BlockchainSpec+      Data.Blockchain.Types.DifficultySpec+      Data.Blockchain.Types.HexSpec+      Data.Blockchain.Types.TransactionSpec       Integration.Mining       Integration.Stats       TestData

@@ -0,0 +1,9 @@+module Data.Blockchain+    ( module Data.Blockchain.Builder+    , module Data.Blockchain.Crypto+    , module Data.Blockchain.Types+    ) where++import Data.Blockchain.Builder+import Data.Blockchain.Crypto+import Data.Blockchain.Types

@@ -0,0 +1,60 @@+module Data.Blockchain.Builder+    ( CreateTransactionException(..)+    , createSimpleTransaction+    ) where++import           Control.Monad             (unless, when)+import           Control.Monad.Trans.Class (lift)++import qualified Control.Error.Util        as Error+import qualified Control.Monad.Except      as Except+import qualified Data.HashMap.Strict       as H+import qualified Data.List.NonEmpty        as NonEmpty+import qualified Data.Word                 as Word++import qualified Data.Blockchain.Crypto    as Crypto+import qualified Data.Blockchain.Types     as Blockchain++data CreateTransactionException+    = SourceAddressEmpty+    | SourceAddressInsufficientFunds+    | InvalidPrivateKey+  deriving (Eq, Show)++-- TODO+-- createTransaction+--     :: [Crypto.KeyPair] -> [(Crypto.PublicKey, Int)] -> Int -> Blockchain.Blockchain Blockchain.Validated+--     -> Either CreateTransactionException Blockchain.Transaction+-- createTransaction _srcs _targets _fee _blockchain = undefined++-- | Create a transaction from a single public key address.+createSimpleTransaction+    :: Crypto.KeyPair   -- ^ KeyPair for source address. PrivateKey will be used to sign transaction.+    -> Crypto.PublicKey -- ^ Target address+    -> Word.Word        -- ^ Transaction value+    -> Word.Word        -- ^ Fee+    -> Blockchain.Blockchain Blockchain.Validated -- ^ Validated blockchain+    -> IO (Either CreateTransactionException Blockchain.Transaction)+createSimpleTransaction (Crypto.KeyPair srcPubKey srcPrivKey) targetPubKey value fee blockchain = Except.runExceptT $ do+    let unspentTransactionOutputs = Blockchain.unspentTransactionOutputs blockchain++    txOutPairs <- Error.failWith SourceAddressEmpty $ H.lookup srcPubKey unspentTransactionOutputs++    let txOuts     = snd <$> txOutPairs+        totalValue = sum $ Blockchain.value <$> txOuts++    when (totalValue < (value + fee)) $ Except.throwError SourceAddressInsufficientFunds++    txIns <- sequence $ flip fmap txOutPairs $ \(txOutRef, txOut) -> do+        sig <- lift $ Blockchain.signTransaction srcPrivKey txOut+        unless (Blockchain.verifyTransactionSignature sig txOut) $ Except.throwError InvalidPrivateKey++        return (Blockchain.TransactionIn txOutRef sig)++    let refund           = totalValue - (value + fee)+        txOut            = Blockchain.TransactionOut value targetPubKey+        maybeRefundTxOut = if refund > 0 then Just (Blockchain.TransactionOut refund srcPubKey)+                                         else Nothing+        txOuts'          = maybe (pure txOut) (: pure txOut) maybeRefundTxOut++    return $ Blockchain.Transaction (NonEmpty.fromList txIns) (NonEmpty.fromList txOuts')

@@ -1,328 +0,0 @@-module Data.Blockchain.Core.Blockchain-    ( Validated-    , Unvalidated-    , Blockchain-    , blockchainConfig-    , blockchainNode-    , BlockchainNode(..)-    , ValidationException(..)-    , BlockException(..)-    -- * Construction-    , construct-    , validate-    , addBlock-    -- * Validation-    , validateTransaction-    , validateTransactions-    -- * Chain inspection-    , blockHeaderHashDifficulty-    , addressValues-    , unspentTransactionOutputs-    , longestChain-    , flatten-    ) where--import           Control.Monad               (unless)-import qualified Data.Aeson                  as Aeson-import qualified Data.Aeson.Types            as Aeson-import qualified Data.Char                   as Char-import qualified Data.Either                 as Either-import qualified Data.Either.Combinators     as Either-import qualified Data.Foldable               as Foldable-import qualified Data.HashMap.Strict         as H-import qualified Data.List                   as List-import qualified Data.List.NonEmpty          as NonEmpty-import           Data.Monoid                 ((<>))-import qualified Data.Ord                    as Ord-import qualified Data.Word                   as Word-import qualified GHC.Generics                as Generic--import qualified Data.Blockchain.Core.Crypto as Crypto-import           Data.Blockchain.Core.Types---- Types ------------------------------------------------------------------------------------------------------data Validated-data Unvalidated---- | Core blockchain data type. Uses a validation tag to declare if it is known to abide by expected blockchain rules.--- Will be either @'Blockchain' 'Validated'@ or @'Blockchain' 'Unvalidated'@.------ Note: both @'Blockchain' 'Validated'@ and @'Blockchain' 'Unvalidated'@ can be serialized to json,--- while only @'Blockchain' 'Unvalidated'@ can be deserialized from json.-data Blockchain a = Blockchain-    { _config :: BlockchainConfig-    , _node   :: BlockchainNode-    }-  deriving (Generic.Generic, Eq, Show)--blockchainConfig :: Blockchain a -> BlockchainConfig-blockchainConfig = _config--blockchainNode :: Blockchain a -> BlockchainNode-blockchainNode = _node--instance Aeson.FromJSON (Blockchain Unvalidated) where-    parseJSON = Aeson.genericParseJSON (stripFieldPrefix "_")--instance Aeson.ToJSON (Blockchain a) where-    toEncoding = Aeson.genericToEncoding (stripFieldPrefix "_")--data BlockchainNode = BlockchainNode-    { nodeBlock :: Block-    , nodeNodes :: [BlockchainNode]-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON BlockchainNode where-    parseJSON = Aeson.genericParseJSON (stripFieldPrefix "node")--instance Aeson.ToJSON BlockchainNode where-    toEncoding = Aeson.genericToEncoding (stripFieldPrefix "node")--data ValidationException-    = GenesisBlockHasTransactions-    | GenesisBlockException BlockException-    | BlockValidationException BlockException-  deriving (Eq, Show)--data BlockException-    = BlockAlreadyExists-    | NoParentFound-    -- timestamps-    | TimestampTooOld-    | TimestampTooFarIntoFuture-    -- difficulty-    | InvalidDifficultyReference-    | InvalidDifficulty-    -- header refs-    | InvalidCoinbaseTransactionHash-    | InvalidTransactionHashTreeRoot-    -- transactions-    | InvalidCoinbaseTransactionValue-    | InvalidTransactionValues-    | TransactionOutRefNotFound-    | InvalidTransactionSignature-  deriving (Eq, Show)----- Construction ------------------------------------------------------------------------------------------------- | Constructs an unvalidated blockchain from a config and a node.--- Allows arbitrary blockchains to be constructed. However, blockchains are generally not useful until validated.-construct :: BlockchainConfig -> BlockchainNode -> Blockchain Unvalidated-construct = Blockchain---- | Validates a blockchain. Returns a 'ValidationException' if provided blockchain does not meet expected rules.-validate :: Blockchain Unvalidated -> Either ValidationException (Blockchain Validated)-validate (Blockchain config (BlockchainNode genesisBlock nodes)) = do-    let (Block header _coinbase txs) = genesisBlock-        reward                       = initialMiningReward config-        blockchainHead               = Blockchain config (BlockchainNode genesisBlock mempty)-        blocks                       = nodes >>= getBlocks--    verify (null txs) GenesisBlockHasTransactions-    Either.mapLeft BlockValidationException $ validateBlockDifficulty header config mempty-    Either.mapLeft BlockValidationException $ validateBlockTransactions genesisBlock mempty reward-    Either.mapLeft BlockValidationException $ validateBlockHeaderReferences genesisBlock-    Either.mapLeft BlockValidationException $ Foldable.foldlM (flip addBlock) blockchainHead blocks-  where-    getBlocks (BlockchainNode block ns) = block : (ns >>= getBlocks)---- | Adds a block to a validated blockchain. Returns a 'BlockException' if block is not able to be inserted into the blockchain.-addBlock :: Block -> Blockchain Validated -> Either BlockException (Blockchain Validated)-addBlock newBlock (Blockchain config node) = Blockchain config <$> addBlockToNode mempty node-  where-    addBlockToNode :: [Block] -> BlockchainNode -> Either BlockException BlockchainNode-    addBlockToNode priorChain (BlockchainNode block nodes) =-        if isParentNode then do-            let siblingBlocks  = nodeBlock <$> nodes-                newNode        = BlockchainNode newBlock mempty-                updatedNode    = BlockchainNode block (newNode : nodes)-                height         = length previousBlocks + 1-                newBlockHeader = blockHeader newBlock--            verify (newBlock `notElem` siblingBlocks) BlockAlreadyExists-            validateBlockCreationTime newBlockHeader (blockHeader block)-            validateBlockDifficulty newBlockHeader config previousBlocks-            validateBlockTransactions newBlock previousBlocks (targetReward config $ fromIntegral height)-            validateBlockHeaderReferences newBlock--            return updatedNode-        else-            let eBlockchains = fmap (\bs -> Either.mapLeft (\e -> (e, bs)) (addBlockToNode previousBlocks bs)) nodes in-            BlockchainNode block <$> reduceAddBlockResults eBlockchains-      where-        previousBlocks = priorChain <> pure block-        isParentNode = Crypto.hash (blockHeader block) == prevBlockHeaderHash (blockHeader newBlock)--    reduceAddBlockResults :: [Either (BlockException, BlockchainNode) BlockchainNode] -> Either BlockException [BlockchainNode]-    reduceAddBlockResults results =-        case (rightResults, specificExceptions) of-            ([x], [])  -> Right (oldBlockChains <> pure x)-            ([],  [])  -> Left NoParentFound-            ([],  [e]) -> Left e-            (_,   _)   -> error "Impossible block insertion error"-      where-        (leftResults, rightResults)     = Either.partitionEithers results-        (allExceptions, oldBlockChains) = unzip leftResults-        specificExceptions              = filter (not . (==) NoParentFound) allExceptions----- Exported Validators ------------------------------------------------------------------------------------------- TODO: transaction-specific exceptions-validateTransaction :: Blockchain Validated -> Transaction -> Either BlockException ()-validateTransaction chain = validateTransactions chain . pure--validateTransactions :: Blockchain Validated -> [Transaction] -> Either BlockException ()-validateTransactions chain = \case-    [] -> return () -- slight optimization - prevents having to calculate unspent transaction outputs-    xs -> let prevBlocks          = NonEmpty.toList (longestChain chain)-              unspentTransactions = unspentTransactionOutputsInternal prevBlocks-          in sequence_ $ validateTransactionInternal unspentTransactions <$> xs---- Internal Validation ------------------------------------------------------------------------------------------- block references expected difficulty--- block header hashes to expected difficulty-validateBlockDifficulty :: BlockHeader -> BlockchainConfig -> [Block] -> Either BlockException ()-validateBlockDifficulty header config blocks = do-    verify (difficulty header == diff) InvalidDifficultyReference-    verify (blockHeaderHashDifficulty (difficulty1Target config) header >= diff) InvalidDifficulty-  where-    diff = targetDifficulty config blocks---- Exported util--- TODO: find better place for this function--blockHeaderHashDifficulty :: Hex256 -> BlockHeader -> Difficulty-blockHeaderHashDifficulty diff1 header = fromIntegral $ diff1 `div` Crypto.hashToHex (Crypto.hash header)----- block was not created before parent--- TODO: The protocol rejects blocks with a timestamp earlier than the median of the timestamps from the previous 11 blocks--- TODO: block created less than X hours, or N blocks intervals, into future-validateBlockCreationTime :: BlockHeader -> BlockHeader -> Either BlockException ()-validateBlockCreationTime newBlockHeader parentBlockHeader =-    verify (newBlockTimestamp > time parentBlockHeader) TimestampTooOld-    -- verify (newBlockTimestamp < now) TimestampTooFarIntoFuture-  where-    newBlockTimestamp = time newBlockHeader--validateBlockHeaderReferences :: Block -> Either BlockException ()-validateBlockHeaderReferences (Block header coinbase txs) = do-    verify (Crypto.hash coinbase == coinbaseTransactionHash header) InvalidCoinbaseTransactionHash-    verify (Crypto.hashTreeRoot txs == transactionHashTreeRoot header) InvalidTransactionHashTreeRoot----- TODO: transactions should be able to reference transactions within the same block--- this means we should try to apply a transaction, if it fails, try to apply next transaction--- recurse until stable--- TODO: until this is implemented it will be possible to "double spend" in the same block... : (-validateBlockTransactions :: Block -> [Block] -> Word.Word -> Either BlockException ()-validateBlockTransactions (Block _header coinbaseTx txs) prevBlocks reward = do-    -- ensure coinbase transaction is of correct value-    -- TODO: coinbase can be reward + fees-    verify (txOutValue (coinbaseTransactionOut coinbaseTx) == reward) InvalidCoinbaseTransactionValue--    sequence_ (validateTransactionInternal unspentTransactions <$> txs)-  where-    unspentTransactions = unspentTransactionOutputsInternal prevBlocks--txOutValue :: NonEmpty.NonEmpty TransactionOut -> Word.Word-txOutValue = sum . fmap value--validateTransactionInternal :: H.HashMap TransactionOutRef TransactionOut -> Transaction -> Either BlockException ()-validateTransactionInternal unspentTransactions (Transaction txIn txOut) = do-    prevTxOut <- sequence $ flip fmap txIn $ \(TransactionIn ref sig) -> do-        tx <- maybeToEither TransactionOutRefNotFound (H.lookup ref unspentTransactions)-        verify (verifyTransactionSignature sig tx) InvalidTransactionSignature-        return tx--    verify (txOutValue prevTxOut >= txOutValue txOut) InvalidTransactionValues----- Transaction State -------------------------------------------------------------------------------------------addressValues :: Blockchain Validated -> H.HashMap Crypto.PublicKey Word.Word-addressValues blockchain = H.fromListWith (+) (toPair <$> unspentTxOuts)-  where-    toPair (TransactionOut value pubKey) = (pubKey, value)-    unspentTxOuts = H.elems $ unspentTransactionOutputsInternal (NonEmpty.toList $ longestChain blockchain)--unspentTransactionOutputs :: Blockchain Validated -> H.HashMap Crypto.PublicKey [(TransactionOutRef, TransactionOut)]-unspentTransactionOutputs blockchain = H.fromListWith (<>) (toPair <$> unspentTxOuts)-  where-    toPair (txRef, txOut) = (signaturePubKey txOut, pure (txRef, txOut))-    unspentTxOuts = H.toList $ unspentTransactionOutputsInternal (NonEmpty.toList $ longestChain blockchain)---- Note: this is required to be an internal method--- As we assume the list of blocks is a verified sub-chain.--- TODO: similar issue to "verify transactions", does not recursively apply txouts within a transaction-unspentTransactionOutputsInternal :: [Block] -> H.HashMap TransactionOutRef TransactionOut-unspentTransactionOutputsInternal =-    foldr (\(Block _ coinbase txs) -> addTransactions txs . addCoinbaseTransaction coinbase) mempty-  where-    addCoinbaseTransaction :: CoinbaseTransaction -> H.HashMap TransactionOutRef TransactionOut -> H.HashMap TransactionOutRef TransactionOut-    addCoinbaseTransaction coinbase = H.unionWith onDuplicate coinbaseTxOutRefMap-      where-        -- TODO: revisit what it means to have duplicate coinbase transaction refs... probably ok?-        onDuplicate (TransactionOut v1 key) (TransactionOut v2 _) = TransactionOut (v1 + v2) key-        coinbaseTxOutRefMap = makeTxOutRefMap (Left $ Crypto.hash coinbase) (coinbaseTransactionOut coinbase)--    addTransactions :: [Transaction] -> H.HashMap TransactionOutRef TransactionOut -> H.HashMap TransactionOutRef TransactionOut-    addTransactions txs hmap = foldr addTransaction hmap txs--    addTransaction :: Transaction -> H.HashMap TransactionOutRef TransactionOut -> H.HashMap TransactionOutRef TransactionOut-    addTransaction tx@(Transaction txIns txOuts) = H.unionWith onDuplicateTxOutRef txOutRefMap . enforceDeleteAll txOutRefsFromTxIns-      where-        txOutRefsFromTxIns = NonEmpty.toList (transactionOutRef <$> txIns)-        txOutRefMap        = makeTxOutRefMap (Right $ Crypto.hash tx) txOuts-        -- Map utils, enforcing expected invariants-        enforceDelete k          = H.alter (maybe (onNotFoundTxOutRef k) (const Nothing)) k-        enforceDeleteAll ks hmap = foldr enforceDelete hmap ks--    makeTxOutRefMap :: Either (Crypto.Hash CoinbaseTransaction) (Crypto.Hash Transaction) -> NonEmpty.NonEmpty TransactionOut -> H.HashMap TransactionOutRef TransactionOut-    makeTxOutRefMap eHash txOuts = H.fromList txOutRefPair-      where-        txOutIndexed = zip (NonEmpty.toList txOuts) [0..]-        txOutRefPair = (\(txOut, i) -> (TransactionOutRef eHash i, txOut)) <$> txOutIndexed--    onDuplicateTxOutRef txOutRef = error ("Unexpected error when computing transaction map - duplicate transaction: " <> show txOutRef)-    onNotFoundTxOutRef  txOutRef = error ("Unexpected error when computing transaction map - transaction not found: " <> show txOutRef)----- Chain inspection -------------------------------------------------------------------------------------------longestChain :: Blockchain Validated -> NonEmpty.NonEmpty Block-longestChain = List.maximumBy lengthOrDifficulty . flatten-  where-    lengthOrDifficulty chain1 chain2 =-        case Ord.comparing length chain1 chain2 of-            EQ -> Ord.comparing chainDifficulty chain1 chain2-            x  -> x-    chainDifficulty = sum . fmap (difficulty . blockHeader)--flatten :: Blockchain Validated -> NonEmpty.NonEmpty (NonEmpty.NonEmpty Block)-flatten = flattenInternal . blockchainNode-  where-    flattenInternal :: BlockchainNode -> NonEmpty.NonEmpty (NonEmpty.NonEmpty Block)-    flattenInternal = \case-        BlockchainNode block []  -> pure $ pure block-        BlockchainNode block bcs -> NonEmpty.cons block <$> (NonEmpty.fromList bcs >>= flattenInternal)---- Utils ------------------------------------------------------------------------------------------------------verify :: Bool -> a -> Either a ()-verify cond = unless cond . Left--maybeToEither :: a -> Maybe b -> Either a b-maybeToEither e = maybe (Left e) Right--stripFieldPrefix :: String -> Aeson.Options-stripFieldPrefix str = Aeson.defaultOptions { Aeson.fieldLabelModifier = stripPrefix }-  where-    stripPrefix x = maybe x lowercase (List.stripPrefix str x)-    lowercase = \case []     -> []-                      (x:xs) -> Char.toLower x : xs

@@ -1,61 +0,0 @@-module Data.Blockchain.Core.Builder-    ( CreateTransactionException(..)-    , createSimpleTransaction-    ) where--import           Control.Monad                   (unless, when)-import           Control.Monad.Trans.Class       (lift)--import qualified Control.Error.Util              as Error-import qualified Control.Monad.Except            as Except-import qualified Data.HashMap.Strict             as H-import qualified Data.List.NonEmpty              as NonEmpty-import qualified Data.Word                       as Word--import qualified Data.Blockchain.Core.Blockchain as Blockchain-import qualified Data.Blockchain.Core.Crypto     as Crypto-import qualified Data.Blockchain.Core.Types      as Blockchain--data CreateTransactionException-    = SourceAddressEmpty-    | SourceAddressInsufficientFunds-    | InvalidPrivateKey-  deriving (Eq, Show)---- TODO--- createTransaction---     :: [Crypto.KeyPair] -> [(Crypto.PublicKey, Int)] -> Int -> Blockchain.Blockchain Blockchain.Validated---     -> Either CreateTransactionException Blockchain.Transaction--- createTransaction _srcs _targets _fee _blockchain = undefined---- | Create a transaction from a single public key address.-createSimpleTransaction-    :: Crypto.KeyPair   -- ^ KeyPair for source address. PrivateKey will be used to sign transaction.-    -> Crypto.PublicKey -- ^ Target address-    -> Word.Word        -- ^ Transaction value-    -> Word.Word        -- ^ Fee-    -> Blockchain.Blockchain Blockchain.Validated -- ^ Validated blockchain-    -> IO (Either CreateTransactionException Blockchain.Transaction)-createSimpleTransaction (Crypto.KeyPair srcPubKey srcPrivKey) targetPubKey value fee blockchain = Except.runExceptT $ do-    let unspentTransactionOutputs = Blockchain.unspentTransactionOutputs blockchain--    txOutPairs <- Error.failWith SourceAddressEmpty $ H.lookup srcPubKey unspentTransactionOutputs--    let txOuts     = snd <$> txOutPairs-        totalValue = sum $ Blockchain.value <$> txOuts--    when (totalValue < (value + fee)) $ Except.throwError SourceAddressInsufficientFunds--    txIns <- sequence $ flip fmap txOutPairs $ \(txOutRef, txOut) -> do-        sig <- lift $ Blockchain.signTransaction srcPrivKey txOut-        unless (Blockchain.verifyTransactionSignature sig txOut) $ Except.throwError InvalidPrivateKey--        return (Blockchain.TransactionIn txOutRef sig)--    let refund           = totalValue - (value + fee)-        txOut            = Blockchain.TransactionOut value targetPubKey-        maybeRefundTxOut = if refund > 0 then Just (Blockchain.TransactionOut refund srcPubKey)-                                         else Nothing-        txOuts'          = maybe (pure txOut) (: pure txOut) maybeRefundTxOut--    return $ Blockchain.Transaction (NonEmpty.fromList txIns) (NonEmpty.fromList txOuts')

@@ -1,9 +0,0 @@-module Data.Blockchain.Core.Crypto-    ( module Data.Blockchain.Core.Crypto.ECDSA-    , module Data.Blockchain.Core.Crypto.Hash-    , module Data.Blockchain.Core.Crypto.HashTree-    ) where--import           Data.Blockchain.Core.Crypto.ECDSA-import           Data.Blockchain.Core.Crypto.Hash-import           Data.Blockchain.Core.Crypto.HashTree

@@ -1,131 +0,0 @@-module Data.Blockchain.Core.Crypto.ECDSA-    ( KeyPair(..)-    , Signature(..)-    , PublicKey(..)-    , PrivateKey(..)-    , sign-    , verify-    , generate-    ) where--import qualified Crypto.Hash                    as Crypto-import qualified Crypto.PubKey.ECC.ECDSA        as Crypto-import qualified Crypto.PubKey.ECC.Generate     as Crypto-import qualified Crypto.PubKey.ECC.Types        as Crypto-import qualified Data.Aeson                     as Aeson-import qualified Data.ByteString                as BS-import qualified Data.Hashable                  as H-import           Data.Monoid                    ((<>))-import qualified Data.Text                      as Text--import           Data.Blockchain.Core.Types.Hex---- Types -------------------------------------------------------------------------------------------------------data KeyPair = KeyPair-    { publicKey  :: PublicKey-    , privateKey :: PrivateKey-    }---- Signature--newtype Signature = Signature { unSignature :: Crypto.Signature }-  deriving (Eq)--instance Show Signature where-    show (Signature (Crypto.Signature r s)) = show (hex256FromInteger r) <> show (hex256FromInteger s)--instance Aeson.ToJSON Signature where-    toJSON = Aeson.toJSON . show--instance Aeson.FromJSON Signature where-    parseJSON = Aeson.withText "Signature" $ \txt -> do-        (rHex, sHex) <- parseHex256Tuple txt--        let sig = Crypto.Signature (toInteger rHex) (toInteger sHex)--        return (Signature sig)---- PublicKey--newtype PublicKey = PublicKey { unPublicKey :: Crypto.PublicPoint }-  deriving (Eq)--instance H.Hashable PublicKey where-    hashWithSalt _ = H.hash . show--instance Show PublicKey where-    show = \case PublicKey Crypto.PointO      -> show $ PublicKey (Crypto.Point 0 0)-                 PublicKey (Crypto.Point x y) -> show (hex256FromInteger x) <> show (hex256FromInteger y)--instance Aeson.ToJSON PublicKey where-    toJSON = Aeson.toJSON . show--instance Aeson.FromJSON PublicKey where-    parseJSON = Aeson.withText "PublicKey" $ \txt -> do-        (xHex, yHex) <- parseHex256Tuple txt--        let point = Crypto.Point (toInteger xHex) (toInteger yHex)--        return (PublicKey point)---- PrivateKey--newtype PrivateKey = PrivateKey { unPrivateKey :: Crypto.PrivateNumber }-  deriving (Eq)--instance Show PrivateKey where-    show = show . hex256FromInteger . unPrivateKey--instance Aeson.ToJSON PrivateKey where-    toJSON = Aeson.toJSON . show--instance Aeson.FromJSON PrivateKey where-    parseJSON = Aeson.withText "PrivateKey" $ fmap (PrivateKey . toInteger) . parseHex256---- Core functions ------------------------------------------------------------------------------------------------ Constants--hashType :: Crypto.SHA256-hashType = Crypto.SHA256--curve :: Crypto.Curve-curve = Crypto.getCurveByName Crypto.SEC_p256k1--sign :: PrivateKey -> BS.ByteString -> IO Signature-sign (PrivateKey number) = fmap Signature . Crypto.sign privKey hashType-  where-    privKey = Crypto.PrivateKey curve number--verify :: PublicKey -> Signature -> BS.ByteString -> Bool-verify (PublicKey point) (Signature sig) = Crypto.verify hashType pubKey sig-  where-    pubKey = Crypto.PublicKey curve point--generate :: IO KeyPair-generate = do-    (pub, priv) <- Crypto.generate curve--    let publicPoint   = Crypto.public_q pub-        privateNumber = Crypto.private_d priv--    return $ KeyPair (PublicKey publicPoint) (PrivateKey privateNumber)---- Util --------------------------------------------------------------------------------------------------------parseHex256 :: Monad m => Text.Text -> m Hex256-parseHex256 = maybe (fail "Invalid hex 256 string") return . hex256 . Text.unpack--parseHex256Tuple :: Monad m => Text.Text -> m (Hex256, Hex256)-parseHex256Tuple txt = do-    let (xStr, yStr) = Text.splitAt 64 txt--    x <- parseHex256 xStr-    y <- parseHex256 yStr--    return (x, y)---- unsafe, but used internally on integers we know will always be positive-hex256FromInteger :: Integer -> Hex256-hex256FromInteger = fromInteger

@@ -1,65 +0,0 @@-module Data.Blockchain.Core.Crypto.Hash-    ( Hash-    , ToHash(..)-    , hashToHex-    , fromByteString-    , unsafeFromByteString-    ) where--import qualified Crypto.Hash                    as Crypto-import qualified Data.Aeson                     as Aeson-import qualified Data.ByteArray.Encoding        as Byte-import qualified Data.ByteString                as BS-import qualified Data.ByteString.Lazy           as Lazy-import qualified Data.Hashable                  as H-import qualified Data.Maybe                     as Maybe-import qualified Data.Text                      as Text-import qualified Data.Text.Encoding             as Text--import qualified Data.Blockchain.Core.Types.Hex as Hex---- Types -------------------------------------------------------------------------------------------------------data Hash a = Hash { unHash :: Crypto.Digest Crypto.SHA256 }-  deriving (Eq, Ord)--instance H.Hashable (Hash a) where-    hashWithSalt _ = H.hash . show--instance Show (Hash a) where-    show = show . unHash--instance Aeson.ToJSON (Hash a) where-    toJSON = Aeson.String . Text.pack . show . unHash--instance Aeson.FromJSON (Hash a) where-    parseJSON = Aeson.withText "Hash" $-        maybe (fail "Invalid bytestring hash") return . fromByteString . Text.encodeUtf8--instance Monoid (Hash a) where-    mempty = Hash $ Crypto.hash (mempty :: BS.ByteString)-    mappend (Hash h1) (Hash h2) = Hash $ Crypto.hashFinalize $ Crypto.hashUpdates Crypto.hashInit [h1, h2]--class ToHash a where-    hash :: a -> Hash a--    default hash :: Aeson.ToJSON a => a -> Hash a-    hash = Hash . Crypto.hash . Lazy.toStrict . Aeson.encode--instance ToHash BS.ByteString where-    hash = Hash . Crypto.hash---- Utils --------------------------------------------------------------------------------------------------------- Note: ignore all possible invariants that `Numeric.readHex` would normally need to check.--- We are only converting string-ified hashes, which should always be valid hex strings.-hashToHex :: Hash a -> Hex.Hex256-hashToHex = Maybe.fromMaybe (error "Unexpected hex conversion failure") . Hex.hex256 . show . unHash--fromByteString :: BS.ByteString -> Maybe (Hash a)-fromByteString bs = case Byte.convertFromBase Byte.Base16 bs of-    Left _    -> Nothing-    Right bs' -> Hash <$> Crypto.digestFromByteString (bs' :: BS.ByteString)--unsafeFromByteString :: BS.ByteString -> Hash a-unsafeFromByteString = Maybe.fromMaybe (error "Invalid hash string") . fromByteString

@@ -1,30 +0,0 @@-module Data.Blockchain.Core.Crypto.HashTree-    ( HashTreeRoot-    , unHashTreeRoot-    , hashTreeRoot-    ) where--import qualified Data.Aeson                       as Aeson--import           Data.Blockchain.Core.Crypto.Hash--newtype HashTreeRoot a = HashTreeRoot { unHashTreeRoot :: Hash a }-  deriving (Aeson.FromJSON, Aeson.ToJSON, Eq, Ord, Show)---- Note: hash tree constructed with extra leaves at end of tree.--- This is NOT compatible with the Bitcoin implementation.---      ┌───┴──┐       ┌────┴───┐         ┌─────┴─────┐---   ┌──┴──┐   │    ┌──┴──┐     │      ┌──┴──┐     ┌──┴──┐--- ┌─┴─┐ ┌─┴─┐ │  ┌─┴─┐ ┌─┴─┐ ┌─┴─┐  ┌─┴─┐ ┌─┴─┐ ┌─┴─┐   │---    (5-leaf)         (6-leaf)             (7-leaf)--hashTreeRoot :: forall a. ToHash a => [a] -> HashTreeRoot a-hashTreeRoot = HashTreeRoot . buildHash-  where-    buildHash :: [a] -> Hash a-    buildHash []  = mempty-    buildHash [x] = hash x-    buildHash xs  = mappend (buildHash left) (buildHash right)-      where-        (left, right) = splitAt i xs-        i = until (\x -> x * 2 >= length xs) (*2) 1

@@ -1,13 +0,0 @@-module Data.Blockchain.Core.Types-    ( module Data.Blockchain.Core.Types.Block-    , module Data.Blockchain.Core.Types.BlockchainConfig-    , module Data.Blockchain.Core.Types.Difficulty-    , module Data.Blockchain.Core.Types.Hex-    , module Data.Blockchain.Core.Types.Transaction-    ) where--import           Data.Blockchain.Core.Types.Block-import           Data.Blockchain.Core.Types.BlockchainConfig-import           Data.Blockchain.Core.Types.Difficulty-import           Data.Blockchain.Core.Types.Hex-import           Data.Blockchain.Core.Types.Transaction

@@ -1,37 +0,0 @@-module Data.Blockchain.Core.Types.Block-    ( Block(..)-    , BlockHeader(..)-    ) where--import qualified Data.Aeson                             as Aeson-import qualified Data.Time.Clock                        as Time-import qualified GHC.Generics                           as Generic--import qualified Data.Blockchain.Core.Crypto            as Crypto-import           Data.Blockchain.Core.Types.Difficulty-import           Data.Blockchain.Core.Types.Transaction--data Block = Block-    { blockHeader         :: BlockHeader-    , coinbaseTransaction :: CoinbaseTransaction-    , transactions        :: [Transaction]-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON Block-instance Aeson.ToJSON Block--data BlockHeader = BlockHeader-    { version                 :: Int-    , prevBlockHeaderHash     :: Crypto.Hash BlockHeader-    , coinbaseTransactionHash :: Crypto.Hash CoinbaseTransaction-    , transactionHashTreeRoot :: Crypto.HashTreeRoot Transaction-    , time                    :: Time.UTCTime-    , difficulty              :: Difficulty-    , nonce                   :: Int-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON BlockHeader-instance Aeson.ToJSON BlockHeader-instance Crypto.ToHash BlockHeader

@@ -1,101 +0,0 @@-module Data.Blockchain.Core.Types.BlockchainConfig-    ( BlockchainConfig(..)-    , defaultConfig-    , targetReward-    , targetDifficulty-    ) where--import           Control.Monad                         (when)-import qualified Data.Aeson                            as Aeson-import qualified Data.Time.Clock                       as Time-import qualified Data.Word                             as Word-import qualified GHC.Generics                          as Generic--import           Data.Blockchain.Core.Types.Block-import           Data.Blockchain.Core.Types.Difficulty-import           Data.Blockchain.Core.Types.Hex--data BlockchainConfig = BlockchainConfig-    { initialDifficulty             :: Difficulty-    -- Maximum hash - difficulties will be calculated using this value-    , difficulty1Target             :: Hex256-    , targetSecondsPerBlock         :: Word.Word-    , difficultyRecalculationHeight :: Word.Word-    , initialMiningReward           :: Word.Word-    -- Defines num blocks when reward is halved --  `0` means reward never changes-    , miningRewardHalvingHeight     :: Word.Word-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON BlockchainConfig-instance Aeson.ToJSON BlockchainConfig---- | A reasonable default config to use for testing. Mines blocks quickly and changes difficulty and rewards frequently.--- Note: reward will go to zero after 1100 blocks, which will take about 180 minutes of mining.------ @--- defaultConfig :: BlockchainConfig--- defaultConfig = BlockchainConfig---     { initialDifficulty             = Difficulty 1---     , difficulty1Target             = hex256LeadingZeros 4---     , targetSecondsPerBlock         = 10---     , difficultyRecalculationHeight = 50---     , initialMiningReward           = 1024---     , miningRewardHalvingHeight     = 100---     }--- @----defaultConfig :: BlockchainConfig-defaultConfig = BlockchainConfig-    { initialDifficulty             = Difficulty 1-    , difficulty1Target             = hex256LeadingZeros 4-    , targetSecondsPerBlock         = 10-    , difficultyRecalculationHeight = 50-    , initialMiningReward           = 1024-    , miningRewardHalvingHeight     = 100-    }---- | Calculates the target reward for a blockchain. Uses the longest chain.-targetReward :: BlockchainConfig -> Word.Word -> Word.Word-targetReward config height = either id id $ do-    let initialReward = initialMiningReward config-        halveHeight   = miningRewardHalvingHeight config--    when (halveHeight == 0) $ Left initialReward--    let numHalves = height `div` halveHeight--    -- 2^64 is greater than maxBound :: Word-    -- And any word halved 64 times will be zero-    when (numHalves >= 64) $ Left 0--    return $ initialReward `div` (2 ^ numHalves)---- TODO: array of blocks hold no assurances of expected invariants--- for example block1 could be created more recently than blockN--- should create a `SingleChain` wrapper--- TODO: take in entire blockchain--- | Calculates the target difficulty for a blockchain. Uses the longest chain.-targetDifficulty :: BlockchainConfig -> [Block] -> Difficulty-targetDifficulty config []                                            = initialDifficulty config-targetDifficulty config _ | difficultyRecalculationHeight config == 0 = initialDifficulty config-targetDifficulty config _ | difficultyRecalculationHeight config == 1 = initialDifficulty config-targetDifficulty config _ | targetSecondsPerBlock config == 0         = initialDifficulty config-targetDifficulty config blocks =-    case length blocks `mod` fromIntegral recalcHeight of-        0 ->-            let recentBlocks   = take (fromIntegral recalcHeight) (reverse blocks)-                lastBlock      = head recentBlocks-                firstBlock     = last recentBlocks-                -- TODO: get rid of `abs`, move invariant into types-                diffTime       = abs $ Time.diffUTCTime (blockTime lastBlock) (blockTime firstBlock)-                avgSolveTime   = realToFrac diffTime / fromIntegral recalcHeight-                solveRate      = fromIntegral (targetSecondsPerBlock config) / avgSolveTime-                lastDifficulty = difficulty (blockHeader lastBlock)-                nextDifficulty = Difficulty $ round $ solveRate * toRational lastDifficulty-            in nextDifficulty--        _ -> difficulty $ blockHeader $ last blocks-  where-    recalcHeight = difficultyRecalculationHeight config-    blockTime    = time . blockHeader

@@ -1,15 +0,0 @@-module Data.Blockchain.Core.Types.Difficulty-    ( Difficulty(..)-    ) where--import qualified Data.Aeson                     as Aeson-import qualified Numeric.Natural                as Natural--import qualified Data.Blockchain.Core.Types.Hex as Hex--newtype Difficulty = Difficulty { unDifficulty :: Natural.Natural }-  deriving (Aeson.FromJSON, Aeson.ToJSON, Enum, Eq, Integral, Num, Real, Ord, Show)--instance Bounded Difficulty where-    minBound = 0-    maxBound = fromIntegral (maxBound :: Hex.Hex256)

@@ -1,64 +0,0 @@-module Data.Blockchain.Core.Types.Hex-    ( Hex256(..)-    , hex256-    , hex256LeadingZeros-    ) where--import           Control.Monad   (unless)-import qualified Data.Aeson      as Aeson-import qualified Data.Maybe      as Maybe-import           Data.Monoid     ((<>))-import qualified Data.Text       as Text-import qualified Data.Word       as Word-import qualified Numeric-import qualified Numeric.Natural as Natural---- Types -------------------------------------------------------------------------------------------------------newtype Hex256 = Hex256 { unHex256 :: Natural.Natural }-  deriving (Enum, Eq, Integral, Num, Real, Ord)--instance Show Hex256 where-    show = zeroPadded 64 . showHex . unHex256--instance Bounded Hex256 where-    minBound = 0-    maxBound = Maybe.fromMaybe (error "Unexpected parse failure") $ readHexMaybe $ replicate 64 'f'--instance Aeson.ToJSON Hex256 where-    toJSON = Aeson.String . Text.pack . show--instance Aeson.FromJSON Hex256 where-    parseJSON = Aeson.withText "Hex256" parseHex256-      where-        parseHex256 = maybe (fail "Invalid hex 256 string") return . hex256 . Text.unpack---- Construction helpers ------------------------------------------------------------------------------------------ | Create a Hex256 value with the specificed amount of leading zeros.--- Useful for creating a 'Data.Blockchain.Core.Types.BlockchainConfig.difficulty1Target' when creating a blockchain.------ >>> hex256LeadingZeros 4--- 0000ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff----hex256LeadingZeros :: Word.Word -> Hex256-hex256LeadingZeros n = maxBound `div` Hex256 (16 ^ n)--hex256 :: String -> Maybe Hex256-hex256 str = do-    unless (length str == 64) Nothing-    x <- readHexMaybe str-    return (Hex256 x)--readHexMaybe :: (Num a, Eq a) => String -> Maybe a-readHexMaybe str = case Numeric.readHex str of-    [(x, "")] -> Just x-    _         -> Nothing---- Utils -------------------------------------------------------------------------------------------------------showHex :: (Show a, Integral a) => a -> String-showHex x = Numeric.showHex x mempty--zeroPadded :: Int -> String -> String-zeroPadded x str = replicate (x - length str) '0' <> str

@@ -1,79 +0,0 @@-module Data.Blockchain.Core.Types.Transaction-    ( Transaction(..)-    , CoinbaseTransaction(..)-    , TransactionIn(..)-    , TransactionOutRef(..)-    , TransactionOut(..)-    , signTransaction-    , verifyTransactionSignature-    ) where--import qualified Data.Aeson                  as Aeson-import qualified Data.ByteString.Lazy        as Lazy-import qualified Data.Hashable               as H-import qualified Data.List.NonEmpty          as NonEmpty-import qualified Data.Word                   as Word-import qualified GHC.Generics                as Generic---import qualified Data.Blockchain.Core.Crypto as Crypto--data Transaction = Transaction-    { transactionIn  :: NonEmpty.NonEmpty TransactionIn-    , transactionOut :: NonEmpty.NonEmpty TransactionOut-    -- TODO: arbitrary bytes?-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON Transaction-instance Aeson.ToJSON  Transaction-instance Crypto.ToHash Transaction--newtype CoinbaseTransaction = CoinbaseTransaction-    { coinbaseTransactionOut :: NonEmpty.NonEmpty TransactionOut-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON CoinbaseTransaction-instance Aeson.ToJSON CoinbaseTransaction-instance Crypto.ToHash CoinbaseTransaction--data TransactionIn = TransactionIn-    { transactionOutRef :: TransactionOutRef-    , signature         :: Crypto.Signature -- ^ Signature from prev transaction, using pubkey from prev transaction-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.ToJSON TransactionIn-instance Aeson.FromJSON TransactionIn-instance Crypto.ToHash TransactionIn---- | Pointer to a specific TransactionOut-data TransactionOutRef = TransactionOutRef-    { transactionHash     :: Either (Crypto.Hash CoinbaseTransaction) (Crypto.Hash Transaction)-    , transactionOutIndex :: Word.Word-    }-  deriving (Generic.Generic, Eq, Show)--instance H.Hashable TransactionOutRef--instance Aeson.FromJSON TransactionOutRef-instance Aeson.ToJSON TransactionOutRef--data TransactionOut = TransactionOut-    { value           :: Word.Word-    , signaturePubKey :: Crypto.PublicKey -- ^ Address of where funds go-    }-  deriving (Generic.Generic, Eq, Show)--instance Aeson.FromJSON TransactionOut-instance Aeson.ToJSON TransactionOut-instance Crypto.ToHash TransactionOut--signTransaction :: Crypto.PrivateKey -> TransactionOut -> IO Crypto.Signature-signTransaction priv = Crypto.sign priv . Lazy.toStrict . Aeson.encode--verifyTransactionSignature :: Crypto.Signature -> TransactionOut -> Bool-verifyTransactionSignature sig txOut = Crypto.verify pub sig $ Lazy.toStrict (Aeson.encode txOut)-  where-    pub = signaturePubKey txOut

@@ -0,0 +1,9 @@+module Data.Blockchain.Crypto+    ( module Data.Blockchain.Crypto.ECDSA+    , module Data.Blockchain.Crypto.Hash+    , module Data.Blockchain.Crypto.HashTree+    ) where++import Data.Blockchain.Crypto.ECDSA+import Data.Blockchain.Crypto.Hash+import Data.Blockchain.Crypto.HashTree

@@ -0,0 +1,136 @@+module Data.Blockchain.Crypto.ECDSA+    ( KeyPair(..)+    , generate+    , Signature(..)+    , PublicKey(..)+    , PrivateKey(..)+    , sign+    , verify+    ) where++import qualified Crypto.Hash                as Crypto+import qualified Crypto.PubKey.ECC.ECDSA    as Crypto+import qualified Crypto.PubKey.ECC.Generate as Crypto+import qualified Crypto.PubKey.ECC.Types    as Crypto+import qualified Data.Aeson                 as Aeson+import qualified Data.ByteString            as BS+import qualified Data.Hashable              as H+import           Data.Monoid                ((<>))+import qualified Data.Text                  as Text++import           Data.Blockchain.Types.Hex++-- Types -----------------------------------------------------------------------------------------------------++-- | KeyPairs are used to store and sign transactions.+-- The 'PublicKey' piece is used as the public address on the blockchain where funds can be sent to and from.+-- The 'PrivateKey' is used to sign transactions, which provides a guarantee that+-- the transaction was initiated by the owner of the address.+data KeyPair = KeyPair+    { publicKey  :: PublicKey+    , privateKey :: PrivateKey+    }++-- Signature++newtype Signature = Signature { unSignature :: Crypto.Signature }+  deriving (Eq)++instance Show Signature where+    show (Signature (Crypto.Signature r s)) = show (hex256FromInteger r) <> show (hex256FromInteger s)++instance Aeson.ToJSON Signature where+    toJSON = Aeson.toJSON . show++instance Aeson.FromJSON Signature where+    parseJSON = Aeson.withText "Signature" $ \txt -> do+        (rHex, sHex) <- parseHex256Tuple txt++        let sig = Crypto.Signature (toInteger rHex) (toInteger sHex)++        return (Signature sig)++-- PublicKey++newtype PublicKey = PublicKey { unPublicKey :: Crypto.PublicPoint }+  deriving (Eq)++instance H.Hashable PublicKey where+    hashWithSalt _ = H.hash . show++instance Show PublicKey where+    show = \case PublicKey Crypto.PointO      -> show $ PublicKey (Crypto.Point 0 0)+                 PublicKey (Crypto.Point x y) -> show (hex256FromInteger x) <> show (hex256FromInteger y)++instance Aeson.ToJSON PublicKey where+    toJSON = Aeson.toJSON . show++instance Aeson.FromJSON PublicKey where+    parseJSON = Aeson.withText "PublicKey" $ \txt -> do+        (xHex, yHex) <- parseHex256Tuple txt++        let point = Crypto.Point (toInteger xHex) (toInteger yHex)++        return (PublicKey point)++-- PrivateKey++newtype PrivateKey = PrivateKey { unPrivateKey :: Crypto.PrivateNumber }+  deriving (Eq)++instance Show PrivateKey where+    show = show . hex256FromInteger . unPrivateKey++instance Aeson.ToJSON PrivateKey where+    toJSON = Aeson.toJSON . show++instance Aeson.FromJSON PrivateKey where+    parseJSON = Aeson.withText "PrivateKey" $ fmap (PrivateKey . toInteger) . parseHex256++-- Core functions --------------------------------------------------------------------------------------------++-- Constants++hashType :: Crypto.SHA256+hashType = Crypto.SHA256++curve :: Crypto.Curve+curve = Crypto.getCurveByName Crypto.SEC_p256k1++sign :: PrivateKey -> BS.ByteString -> IO Signature+sign (PrivateKey number) = fmap Signature . Crypto.sign privKey hashType+  where+    privKey = Crypto.PrivateKey curve number++verify :: PublicKey -> Signature -> BS.ByteString -> Bool+verify (PublicKey point) (Signature sig) = Crypto.verify hashType pubKey sig+  where+    pubKey = Crypto.PublicKey curve point++-- | Generates a new 'KeyPair'. The 'PublicKey' can be shared openly, while the 'PrivateKey' should be kept secret.+generate :: IO KeyPair+generate = do+    (pub, priv) <- Crypto.generate curve++    let publicPoint   = Crypto.public_q pub+        privateNumber = Crypto.private_d priv++    return $ KeyPair (PublicKey publicPoint) (PrivateKey privateNumber)++-- Util ------------------------------------------------------------------------------------------------------++parseHex256 :: Monad m => Text.Text -> m Hex256+parseHex256 = maybe (fail "Invalid hex 256 string") return . hex256 . Text.unpack++parseHex256Tuple :: Monad m => Text.Text -> m (Hex256, Hex256)+parseHex256Tuple txt = do+    let (xStr, yStr) = Text.splitAt 64 txt++    x <- parseHex256 xStr+    y <- parseHex256 yStr++    return (x, y)++-- unsafe, but used internally on integers we know will always be positive+hex256FromInteger :: Integer -> Hex256+hex256FromInteger = fromInteger

@@ -0,0 +1,65 @@+module Data.Blockchain.Crypto.Hash+    ( Hash+    , ToHash(..)+    , hashToHex+    , fromByteString+    , unsafeFromByteString+    ) where++import qualified Crypto.Hash               as Crypto+import qualified Data.Aeson                as Aeson+import qualified Data.ByteArray.Encoding   as Byte+import qualified Data.ByteString           as BS+import qualified Data.ByteString.Lazy      as Lazy+import qualified Data.Hashable             as H+import qualified Data.Maybe                as Maybe+import qualified Data.Text                 as Text+import qualified Data.Text.Encoding        as Text++import qualified Data.Blockchain.Types.Hex as Hex++-- Types -----------------------------------------------------------------------------------------------------++newtype Hash a = Hash { unHash :: Crypto.Digest Crypto.SHA256 }+  deriving (Eq, Ord)++instance H.Hashable (Hash a) where+    hashWithSalt _ = H.hash . show++instance Show (Hash a) where+    show = show . unHash++instance Aeson.ToJSON (Hash a) where+    toJSON = Aeson.String . Text.pack . show . unHash++instance Aeson.FromJSON (Hash a) where+    parseJSON = Aeson.withText "Hash" $+        maybe (fail "Invalid bytestring hash") return . fromByteString . Text.encodeUtf8++instance Monoid (Hash a) where+    mempty = Hash $ Crypto.hash (mempty :: BS.ByteString)+    mappend (Hash h1) (Hash h2) = Hash $ Crypto.hashFinalize $ Crypto.hashUpdates Crypto.hashInit [h1, h2]++class ToHash a where+    hash :: a -> Hash a++    default hash :: Aeson.ToJSON a => a -> Hash a+    hash = Hash . Crypto.hash . Lazy.toStrict . Aeson.encode++instance ToHash BS.ByteString where+    hash = Hash . Crypto.hash++-- Utils -----------------------------------------------------------------------------------------------------++-- Note: ignore all possible invariants that `Numeric.readHex` would normally need to check.+-- We are only converting string-ified hashes, which should always be valid hex strings.+hashToHex :: Hash a -> Hex.Hex256+hashToHex = Maybe.fromMaybe (error "Unexpected hex conversion failure") . Hex.hex256 . show . unHash++fromByteString :: BS.ByteString -> Maybe (Hash a)+fromByteString bs = case Byte.convertFromBase Byte.Base16 bs of+    Left _    -> Nothing+    Right bs' -> Hash <$> Crypto.digestFromByteString (bs' :: BS.ByteString)++unsafeFromByteString :: BS.ByteString -> Hash a+unsafeFromByteString = Maybe.fromMaybe (error "Invalid hash string") . fromByteString

@@ -0,0 +1,30 @@+module Data.Blockchain.Crypto.HashTree+    ( HashTreeRoot+    , unHashTreeRoot+    , hashTreeRoot+    ) where++import qualified Data.Aeson                  as Aeson++import           Data.Blockchain.Crypto.Hash++newtype HashTreeRoot a = HashTreeRoot { unHashTreeRoot :: Hash a }+  deriving (Aeson.FromJSON, Aeson.ToJSON, Eq, Ord, Show)++-- Note: hash tree constructed with extra leaves at end of tree.+-- This is NOT compatible with the Bitcoin implementation.+--      ┌───┴──┐       ┌────┴───┐         ┌─────┴─────┐+--   ┌──┴──┐   │    ┌──┴──┐     │      ┌──┴──┐     ┌──┴──┐+-- ┌─┴─┐ ┌─┴─┐ │  ┌─┴─┐ ┌─┴─┐ ┌─┴─┐  ┌─┴─┐ ┌─┴─┐ ┌─┴─┐   │+--    (5-leaf)         (6-leaf)             (7-leaf)++hashTreeRoot :: forall a. ToHash a => [a] -> HashTreeRoot a+hashTreeRoot = HashTreeRoot . buildHash+  where+    buildHash :: [a] -> Hash a+    buildHash []  = mempty+    buildHash [x] = hash x+    buildHash xs  = mappend (buildHash left) (buildHash right)+      where+        (left, right) = splitAt i xs+        i = until (\x -> x * 2 >= length xs) (*2) 1

@@ -3,5 +3,5 @@     , module Data.Blockchain.Mining.Blockchain     ) where -import           Data.Blockchain.Mining.Block-import           Data.Blockchain.Mining.Blockchain+import Data.Blockchain.Mining.Block+import Data.Blockchain.Mining.Blockchain

@@ -5,14 +5,13 @@     , 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.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.Core.Blockchain as Blockchain-import qualified Data.Blockchain.Core.Crypto     as Crypto-import qualified Data.Blockchain.Core.Types      as Blockchain+import qualified Data.Blockchain        as Blockchain+import qualified Data.Blockchain.Crypto as Crypto  data MineBlockException     = InvalidTransactionList

@@ -2,10 +2,9 @@     ( mineBlockchain     ) where -import           Data.Monoid                     ((<>))+import           Data.Monoid                  ((<>)) -import qualified Data.Blockchain.Core.Blockchain as Blockchain-import qualified Data.Blockchain.Core.Types      as Blockchain+import qualified Data.Blockchain              as Blockchain import           Data.Blockchain.Mining.Block  -- | Creates a blockchain from the given config.

@@ -0,0 +1,15 @@+module Data.Blockchain.Types+    ( module Data.Blockchain.Types.Blockchain+    , module Data.Blockchain.Types.Block+    , module Data.Blockchain.Types.BlockchainConfig+    , module Data.Blockchain.Types.Difficulty+    , module Data.Blockchain.Types.Hex+    , module Data.Blockchain.Types.Transaction+    ) where++import Data.Blockchain.Types.Block+import Data.Blockchain.Types.Blockchain+import Data.Blockchain.Types.BlockchainConfig+import Data.Blockchain.Types.Difficulty+import Data.Blockchain.Types.Hex+import Data.Blockchain.Types.Transaction

@@ -0,0 +1,37 @@+module Data.Blockchain.Types.Block+    ( Block(..)+    , BlockHeader(..)+    ) where++import qualified Data.Aeson                        as Aeson+import qualified Data.Time.Clock                   as Time+import qualified GHC.Generics                      as Generic++import qualified Data.Blockchain.Crypto            as Crypto+import           Data.Blockchain.Types.Difficulty+import           Data.Blockchain.Types.Transaction++data Block = Block+    { blockHeader         :: BlockHeader+    , coinbaseTransaction :: CoinbaseTransaction+    , transactions        :: [Transaction]+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON Block+instance Aeson.ToJSON Block++data BlockHeader = BlockHeader+    { version                 :: Int+    , prevBlockHeaderHash     :: Crypto.Hash BlockHeader+    , coinbaseTransactionHash :: Crypto.Hash CoinbaseTransaction+    , transactionHashTreeRoot :: Crypto.HashTreeRoot Transaction+    , time                    :: Time.UTCTime+    , difficulty              :: Difficulty+    , nonce                   :: Int+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON BlockHeader+instance Aeson.ToJSON BlockHeader+instance Crypto.ToHash BlockHeader

@@ -0,0 +1,338 @@+module Data.Blockchain.Types.Blockchain+    ( Validated+    , Unvalidated+    , Blockchain+    , blockchainConfig+    , blockchainNode+    , BlockchainNode(..)+    , ValidationException(..)+    , BlockException(..)+    -- * Construction+    , construct+    , validate+    , unvalidate+    , addBlock+    -- * Validation+    , validateTransaction+    , validateTransactions+    -- * Chain inspection+    , blockHeaderHashDifficulty+    , addressValues+    , unspentTransactionOutputs+    , longestChain+    , flatten+    ) where++import           Control.Monad                          (unless)+import qualified Data.Aeson                             as Aeson+import qualified Data.Aeson.Types                       as Aeson+import qualified Data.Char                              as Char+import qualified Data.Either                            as Either+import qualified Data.Either.Combinators                as Either+import qualified Data.Foldable                          as Foldable+import qualified Data.HashMap.Strict                    as H+import qualified Data.List                              as List+import qualified Data.List.NonEmpty                     as NonEmpty+import           Data.Monoid                            ((<>))+import qualified Data.Ord                               as Ord+import qualified Data.Word                              as Word+import qualified GHC.Generics                           as Generic++import qualified Data.Blockchain.Crypto                 as Crypto++import           Data.Blockchain.Types.Block+import           Data.Blockchain.Types.BlockchainConfig+import           Data.Blockchain.Types.Difficulty+import           Data.Blockchain.Types.Hex+import           Data.Blockchain.Types.Transaction++-- Types ----------------------------------------------------------------------------------------------------++data Validated+data Unvalidated++-- | Core blockchain data type. Uses a validation tag to declare if it is known to abide by expected blockchain rules.+-- Will be either @'Blockchain' 'Validated'@ or @'Blockchain' 'Unvalidated'@.+--+-- Note: both @'Blockchain' 'Validated'@ and @'Blockchain' 'Unvalidated'@ can be serialized to json,+-- while only @'Blockchain' 'Unvalidated'@ can be deserialized from json.+data Blockchain a = Blockchain+    { _config :: BlockchainConfig+    , _node   :: BlockchainNode+    }+  deriving (Generic.Generic, Eq, Show)++blockchainConfig :: Blockchain a -> BlockchainConfig+blockchainConfig = _config++blockchainNode :: Blockchain a -> BlockchainNode+blockchainNode = _node++instance Aeson.FromJSON (Blockchain Unvalidated) where+    parseJSON = Aeson.genericParseJSON (stripFieldPrefix "_")++instance Aeson.ToJSON (Blockchain a) where+    toEncoding = Aeson.genericToEncoding (stripFieldPrefix "_")++data BlockchainNode = BlockchainNode+    { nodeBlock :: Block+    , nodeNodes :: [BlockchainNode]+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON BlockchainNode where+    parseJSON = Aeson.genericParseJSON (stripFieldPrefix "node")++instance Aeson.ToJSON BlockchainNode where+    toEncoding = Aeson.genericToEncoding (stripFieldPrefix "node")++data ValidationException+    = GenesisBlockHasTransactions+    | GenesisBlockException BlockException+    | BlockValidationException BlockException+  deriving (Eq, Show)++data BlockException+    = BlockAlreadyExists+    | NoParentFound+    -- timestamps+    | TimestampTooOld+    | TimestampTooFarIntoFuture+    -- difficulty+    | InvalidDifficultyReference+    | InvalidDifficulty+    -- header refs+    | InvalidCoinbaseTransactionHash+    | InvalidTransactionHashTreeRoot+    -- transactions+    | InvalidCoinbaseTransactionValue+    | InvalidTransactionValues+    | TransactionOutRefNotFound+    | InvalidTransactionSignature+  deriving (Eq, Show)+++-- Construction ---------------------------------------------------------------------------------------------++-- | Constructs an unvalidated blockchain from a config and a node.+-- Allows arbitrary blockchains to be constructed. However, blockchains are generally not useful until validated.+construct :: BlockchainConfig -> BlockchainNode -> Blockchain Unvalidated+construct = Blockchain++-- | Validates a blockchain. Returns a 'ValidationException' if provided blockchain does not meet expected rules.+validate :: Blockchain Unvalidated -> Either ValidationException (Blockchain Validated)+validate (Blockchain config (BlockchainNode genesisBlock nodes)) = do+    let (Block header _coinbase txs) = genesisBlock+        reward                       = initialMiningReward config+        blockchainHead               = Blockchain config (BlockchainNode genesisBlock mempty)+        blocks                       = nodes >>= getBlocks++    verify (null txs) GenesisBlockHasTransactions+    Either.mapLeft BlockValidationException $ validateBlockDifficulty header config mempty+    Either.mapLeft BlockValidationException $ validateBlockTransactions genesisBlock mempty reward+    Either.mapLeft BlockValidationException $ validateBlockHeaderReferences genesisBlock+    Either.mapLeft BlockValidationException $ Foldable.foldlM (flip addBlock) blockchainHead blocks+  where+    getBlocks (BlockchainNode block ns) = block : (ns >>= getBlocks)++-- | Isomorphic - useful for sending api responses+unvalidate :: Blockchain Validated -> Blockchain Unvalidated+unvalidate (Blockchain config node) = Blockchain config node++-- | Adds a block to a validated blockchain. Returns a 'BlockException' if block is not able to be inserted into the blockchain.+addBlock :: Block -> Blockchain Validated -> Either BlockException (Blockchain Validated)+addBlock newBlock (Blockchain config node) = Blockchain config <$> addBlockToNode mempty node+  where+    addBlockToNode :: [Block] -> BlockchainNode -> Either BlockException BlockchainNode+    addBlockToNode priorChain (BlockchainNode block nodes) =+        if isParentNode then do+            let siblingBlocks  = nodeBlock <$> nodes+                newNode        = BlockchainNode newBlock mempty+                updatedNode    = BlockchainNode block (newNode : nodes)+                height         = length previousBlocks + 1+                newBlockHeader = blockHeader newBlock++            verify (newBlock `notElem` siblingBlocks) BlockAlreadyExists+            validateBlockCreationTime newBlockHeader (blockHeader block)+            validateBlockDifficulty newBlockHeader config previousBlocks+            validateBlockTransactions newBlock previousBlocks (targetReward config $ fromIntegral height)+            validateBlockHeaderReferences newBlock++            return updatedNode+        else+            let eBlockchains = fmap (\bs -> Either.mapLeft (\e -> (e, bs)) (addBlockToNode previousBlocks bs)) nodes in+            BlockchainNode block <$> reduceAddBlockResults eBlockchains+      where+        previousBlocks = priorChain <> pure block+        isParentNode = Crypto.hash (blockHeader block) == prevBlockHeaderHash (blockHeader newBlock)++    reduceAddBlockResults :: [Either (BlockException, BlockchainNode) BlockchainNode] -> Either BlockException [BlockchainNode]+    reduceAddBlockResults results =+        case (rightResults, specificExceptions) of+            ([x], [])  -> Right (oldBlockChains <> pure x)+            ([],  [])  -> Left NoParentFound+            ([],  [e]) -> Left e+            (_,   _)   -> error "Impossible block insertion error"+      where+        (leftResults, rightResults)     = Either.partitionEithers results+        (allExceptions, oldBlockChains) = unzip leftResults+        specificExceptions              = filter (not . (==) NoParentFound) allExceptions+++-- Exported Validators ---------------------------------------------------------------------------------------++-- TODO: transaction-specific exceptions+validateTransaction :: Blockchain Validated -> Transaction -> Either BlockException ()+validateTransaction chain = validateTransactions chain . pure++validateTransactions :: Blockchain Validated -> [Transaction] -> Either BlockException ()+validateTransactions chain = \case+    [] -> return () -- slight optimization - prevents having to calculate unspent transaction outputs+    xs -> let prevBlocks          = NonEmpty.toList (longestChain chain)+              unspentTransactions = unspentTransactionOutputsInternal prevBlocks+          in sequence_ $ validateTransactionInternal unspentTransactions <$> xs++-- Internal Validation ---------------------------------------------------------------------------------------++-- block references expected difficulty+-- block header hashes to expected difficulty+validateBlockDifficulty :: BlockHeader -> BlockchainConfig -> [Block] -> Either BlockException ()+validateBlockDifficulty header config blocks = do+    verify (difficulty header == diff) InvalidDifficultyReference+    verify (blockHeaderHashDifficulty (difficulty1Target config) header >= diff) InvalidDifficulty+  where+    diff = targetDifficulty config blocks++-- Exported util+-- TODO: find better place for this function++blockHeaderHashDifficulty :: Hex256 -> BlockHeader -> Difficulty+blockHeaderHashDifficulty diff1 header = fromIntegral $ diff1 `div` Crypto.hashToHex (Crypto.hash header)+++-- block was not created before parent+-- TODO: The protocol rejects blocks with a timestamp earlier than the median of the timestamps from the previous 11 blocks+-- TODO: block created less than X hours, or N blocks intervals, into future+validateBlockCreationTime :: BlockHeader -> BlockHeader -> Either BlockException ()+validateBlockCreationTime newBlockHeader parentBlockHeader =+    verify (newBlockTimestamp > time parentBlockHeader) TimestampTooOld+    -- verify (newBlockTimestamp < now) TimestampTooFarIntoFuture+  where+    newBlockTimestamp = time newBlockHeader++validateBlockHeaderReferences :: Block -> Either BlockException ()+validateBlockHeaderReferences (Block header coinbase txs) = do+    verify (Crypto.hash coinbase == coinbaseTransactionHash header) InvalidCoinbaseTransactionHash+    verify (Crypto.hashTreeRoot txs == transactionHashTreeRoot header) InvalidTransactionHashTreeRoot+++-- TODO: transactions should be able to reference transactions within the same block+-- this means we should try to apply a transaction, if it fails, try to apply next transaction+-- recurse until stable+-- TODO: until this is implemented it will be possible to "double spend" in the same block... : (+validateBlockTransactions :: Block -> [Block] -> Word.Word -> Either BlockException ()+validateBlockTransactions (Block _header coinbaseTx txs) prevBlocks reward = do+    -- ensure coinbase transaction is of correct value+    -- TODO: coinbase can be reward + fees+    verify (txOutValue (coinbaseTransactionOut coinbaseTx) == reward) InvalidCoinbaseTransactionValue++    sequence_ (validateTransactionInternal unspentTransactions <$> txs)+  where+    unspentTransactions = unspentTransactionOutputsInternal prevBlocks++txOutValue :: NonEmpty.NonEmpty TransactionOut -> Word.Word+txOutValue = sum . fmap value++validateTransactionInternal :: H.HashMap TransactionOutRef TransactionOut -> Transaction -> Either BlockException ()+validateTransactionInternal unspentTransactions (Transaction txIn txOut) = do+    prevTxOut <- sequence $ flip fmap txIn $ \(TransactionIn ref sig) -> do+        tx <- maybeToEither TransactionOutRefNotFound (H.lookup ref unspentTransactions)+        verify (verifyTransactionSignature sig tx) InvalidTransactionSignature+        return tx++    verify (txOutValue prevTxOut >= txOutValue txOut) InvalidTransactionValues+++-- Transaction State -----------------------------------------------------------------------------------------++addressValues :: Blockchain Validated -> H.HashMap Crypto.PublicKey Word.Word+addressValues blockchain = H.fromListWith (+) (toPair <$> unspentTxOuts)+  where+    toPair (TransactionOut value pubKey) = (pubKey, value)+    unspentTxOuts = H.elems $ unspentTransactionOutputsInternal (NonEmpty.toList $ longestChain blockchain)++unspentTransactionOutputs :: Blockchain Validated -> H.HashMap Crypto.PublicKey [(TransactionOutRef, TransactionOut)]+unspentTransactionOutputs blockchain = H.fromListWith (<>) (toPair <$> unspentTxOuts)+  where+    toPair (txRef, txOut) = (signaturePubKey txOut, pure (txRef, txOut))+    unspentTxOuts = H.toList $ unspentTransactionOutputsInternal (NonEmpty.toList $ longestChain blockchain)++-- Note: this is required to be an internal method+-- As we assume the list of blocks is a verified sub-chain.+-- TODO: similar issue to "verify transactions", does not recursively apply txouts within a transaction+unspentTransactionOutputsInternal :: [Block] -> H.HashMap TransactionOutRef TransactionOut+unspentTransactionOutputsInternal =+    foldr (\(Block _ coinbase txs) -> addTransactions txs . addCoinbaseTransaction coinbase) mempty+  where+    addCoinbaseTransaction :: CoinbaseTransaction -> H.HashMap TransactionOutRef TransactionOut -> H.HashMap TransactionOutRef TransactionOut+    addCoinbaseTransaction coinbase = H.unionWith onDuplicate coinbaseTxOutRefMap+      where+        -- TODO: revisit what it means to have duplicate coinbase transaction refs... probably ok?+        onDuplicate (TransactionOut v1 key) (TransactionOut v2 _) = TransactionOut (v1 + v2) key+        coinbaseTxOutRefMap = makeTxOutRefMap (Left $ Crypto.hash coinbase) (coinbaseTransactionOut coinbase)++    addTransactions :: [Transaction] -> H.HashMap TransactionOutRef TransactionOut -> H.HashMap TransactionOutRef TransactionOut+    addTransactions txs hmap = foldr addTransaction hmap txs++    addTransaction :: Transaction -> H.HashMap TransactionOutRef TransactionOut -> H.HashMap TransactionOutRef TransactionOut+    addTransaction tx@(Transaction txIns txOuts) = H.unionWith onDuplicateTxOutRef txOutRefMap . enforceDeleteAll txOutRefsFromTxIns+      where+        txOutRefsFromTxIns = NonEmpty.toList (transactionOutRef <$> txIns)+        txOutRefMap        = makeTxOutRefMap (Right $ Crypto.hash tx) txOuts+        -- Map utils, enforcing expected invariants+        enforceDelete k          = H.alter (maybe (onNotFoundTxOutRef k) (const Nothing)) k+        enforceDeleteAll ks hmap = foldr enforceDelete hmap ks++    makeTxOutRefMap :: Either (Crypto.Hash CoinbaseTransaction) (Crypto.Hash Transaction) -> NonEmpty.NonEmpty TransactionOut -> H.HashMap TransactionOutRef TransactionOut+    makeTxOutRefMap eHash txOuts = H.fromList txOutRefPair+      where+        txOutIndexed = zip (NonEmpty.toList txOuts) [0..]+        txOutRefPair = (\(txOut, i) -> (TransactionOutRef eHash i, txOut)) <$> txOutIndexed++    onDuplicateTxOutRef txOutRef = error ("Unexpected error when computing transaction map - duplicate transaction: " <> show txOutRef)+    onNotFoundTxOutRef  txOutRef = error ("Unexpected error when computing transaction map - transaction not found: " <> show txOutRef)+++-- Chain inspection -----------------------------------------------------------------------------------------++longestChain :: Blockchain Validated -> NonEmpty.NonEmpty Block+longestChain = List.maximumBy lengthOrDifficulty . flatten+  where+    lengthOrDifficulty chain1 chain2 =+        case Ord.comparing length chain1 chain2 of+            EQ -> Ord.comparing chainDifficulty chain1 chain2+            x  -> x+    chainDifficulty = sum . fmap (difficulty . blockHeader)++flatten :: Blockchain Validated -> NonEmpty.NonEmpty (NonEmpty.NonEmpty Block)+flatten = flattenInternal . blockchainNode+  where+    flattenInternal :: BlockchainNode -> NonEmpty.NonEmpty (NonEmpty.NonEmpty Block)+    flattenInternal = \case+        BlockchainNode block []  -> pure $ pure block+        BlockchainNode block bcs -> NonEmpty.cons block <$> (NonEmpty.fromList bcs >>= flattenInternal)++-- Utils ----------------------------------------------------------------------------------------------------++verify :: Bool -> a -> Either a ()+verify cond = unless cond . Left++maybeToEither :: a -> Maybe b -> Either a b+maybeToEither e = maybe (Left e) Right++stripFieldPrefix :: String -> Aeson.Options+stripFieldPrefix str = Aeson.defaultOptions { Aeson.fieldLabelModifier = stripPrefix }+  where+    stripPrefix x = maybe x lowercase (List.stripPrefix str x)+    lowercase = \case []     -> []+                      (x:xs) -> Char.toLower x : xs

@@ -0,0 +1,103 @@+module Data.Blockchain.Types.BlockchainConfig+    ( BlockchainConfig(..)+    , defaultConfig+    , targetReward+    , targetDifficulty+    ) where++import           Control.Monad                    (when)+import qualified Data.Aeson                       as Aeson+import qualified Data.Time.Clock                  as Time+import qualified Data.Word                        as Word+import qualified GHC.Generics                     as Generic++import           Data.Blockchain.Types.Block+import           Data.Blockchain.Types.Difficulty+import           Data.Blockchain.Types.Hex++data BlockchainConfig = BlockchainConfig+    { initialDifficulty             :: Difficulty+    -- Maximum hash - difficulties will be calculated using this value+    , difficulty1Target             :: Hex256+    , targetSecondsPerBlock         :: Word.Word+    , difficultyRecalculationHeight :: Word.Word+    , initialMiningReward           :: Word.Word+    -- Defines num blocks when reward is halved --  `0` means reward never changes+    , miningRewardHalvingHeight     :: Word.Word+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON BlockchainConfig+instance Aeson.ToJSON BlockchainConfig++-- | A reasonable default config to use for testing. Mines blocks quickly and changes difficulty and rewards frequently.+-- Note: reward will go to zero after 1100 blocks, which will take about 180 minutes of mining.+--+-- @+-- defaultConfig :: BlockchainConfig+-- defaultConfig = BlockchainConfig+--     { initialDifficulty             = Difficulty 1+--     , difficulty1Target             = hex256LeadingZeros 4+--     , targetSecondsPerBlock         = 10+--     , difficultyRecalculationHeight = 50+--     , initialMiningReward           = 1024+--     , miningRewardHalvingHeight     = 100+--     }+-- @+--+defaultConfig :: BlockchainConfig+defaultConfig = BlockchainConfig+    { initialDifficulty             = Difficulty 1+    , difficulty1Target             = hex256LeadingZeros 4+    , targetSecondsPerBlock         = 10+    , difficultyRecalculationHeight = 50+    , initialMiningReward           = 1024+    , miningRewardHalvingHeight     = 100+    }++-- | Calculates the target reward for a blockchain. Uses the longest chain.+targetReward :: BlockchainConfig -> Word.Word -> Word.Word+targetReward config height = either id id $ do+    let initialReward = initialMiningReward config+        halveHeight   = miningRewardHalvingHeight config++    when (halveHeight == 0) $ Left initialReward++    let numHalves = height `div` halveHeight++    -- 2^64 is greater than maxBound :: Word+    -- And any word halved 64 times will be zero+    when (numHalves >= 64) $ Left 0++    return $ initialReward `div` (2 ^ numHalves)++-- TODO: array of blocks hold no assurances of expected invariants+-- for example block1 could be created more recently than blockN+-- should create a `SingleChain` wrapper+-- TODO: take in entire blockchain+-- | Calculates the target difficulty for a blockchain. Uses the longest chain.+targetDifficulty :: BlockchainConfig -> [Block] -> Difficulty+targetDifficulty config []                                            = initialDifficulty config+targetDifficulty config _ | difficultyRecalculationHeight config == 0 = initialDifficulty config+targetDifficulty config _ | difficultyRecalculationHeight config == 1 = initialDifficulty config+targetDifficulty config _ | targetSecondsPerBlock config == 0         = initialDifficulty config+-- targetDifficulty config blocks | length blocks == 1                   = initialDifficulty config -- super messy...+targetDifficulty config blocks =+    case length blocks `mod` fromIntegral recalcHeight of+        -- Note: this includes the genesis block, is that correct?+        0 ->+            let recentBlocks   = take (fromIntegral recalcHeight) (reverse blocks) -- TODO: (drop (length blocks - recalcHeight))+                lastBlock      = head recentBlocks+                firstBlock     = last recentBlocks+                -- TODO: get rid of `abs`, move invariant into types+                diffTime       = abs $ Time.diffUTCTime (blockTime lastBlock) (blockTime firstBlock)+                avgSolveTime   = realToFrac diffTime / fromIntegral recalcHeight+                solveRate      = fromIntegral (targetSecondsPerBlock config) / avgSolveTime+                lastDifficulty = difficulty (blockHeader lastBlock)+                nextDifficulty = Difficulty $ round $ solveRate * toRational lastDifficulty+            in nextDifficulty++        _ -> difficulty $ blockHeader $ last blocks+  where+    recalcHeight = difficultyRecalculationHeight config+    blockTime    = time . blockHeader

@@ -0,0 +1,15 @@+module Data.Blockchain.Types.Difficulty+    ( Difficulty(..)+    ) where++import qualified Data.Aeson                as Aeson+import qualified Numeric.Natural           as Natural++import qualified Data.Blockchain.Types.Hex as Hex++newtype Difficulty = Difficulty { unDifficulty :: Natural.Natural }+  deriving (Aeson.FromJSON, Aeson.ToJSON, Enum, Eq, Integral, Num, Real, Ord, Show)++instance Bounded Difficulty where+    minBound = 0+    maxBound = fromIntegral (maxBound :: Hex.Hex256)

@@ -0,0 +1,64 @@+module Data.Blockchain.Types.Hex+    ( Hex256(..)+    , hex256+    , hex256LeadingZeros+    ) where++import           Control.Monad   (unless)+import qualified Data.Aeson      as Aeson+import qualified Data.Maybe      as Maybe+import           Data.Monoid     ((<>))+import qualified Data.Text       as Text+import qualified Data.Word       as Word+import qualified Numeric+import qualified Numeric.Natural as Natural++-- Types -----------------------------------------------------------------------------------------------------++newtype Hex256 = Hex256 { unHex256 :: Natural.Natural }+  deriving (Enum, Eq, Integral, Num, Real, Ord)++instance Show Hex256 where+    show = zeroPadded 64 . showHex . unHex256++instance Bounded Hex256 where+    minBound = 0+    maxBound = Maybe.fromMaybe (error "Unexpected parse failure") $ readHexMaybe $ replicate 64 'f'++instance Aeson.ToJSON Hex256 where+    toJSON = Aeson.String . Text.pack . show++instance Aeson.FromJSON Hex256 where+    parseJSON = Aeson.withText "Hex256" parseHex256+      where+        parseHex256 = maybe (fail "Invalid hex 256 string") return . hex256 . Text.unpack++-- Construction helpers --------------------------------------------------------------------------------------++-- | Create a Hex256 value with the specificed amount of leading zeros.+-- Useful for creating a 'Data.Blockchain.Types.BlockchainConfig.difficulty1Target' when creating a blockchain.+--+-- >>> hex256LeadingZeros 4+-- 0000ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff+--+hex256LeadingZeros :: Word.Word -> Hex256+hex256LeadingZeros n = maxBound `div` Hex256 (16 ^ n)++hex256 :: String -> Maybe Hex256+hex256 str = do+    unless (length str == 64) Nothing+    x <- readHexMaybe str+    return (Hex256 x)++readHexMaybe :: (Num a, Eq a) => String -> Maybe a+readHexMaybe str = case Numeric.readHex str of+    [(x, "")] -> Just x+    _         -> Nothing++-- Utils -----------------------------------------------------------------------------------------------------++showHex :: (Show a, Integral a) => a -> String+showHex x = Numeric.showHex x mempty++zeroPadded :: Int -> String -> String+zeroPadded x str = replicate (x - length str) '0' <> str

@@ -0,0 +1,79 @@+module Data.Blockchain.Types.Transaction+    ( Transaction(..)+    , CoinbaseTransaction(..)+    , TransactionIn(..)+    , TransactionOutRef(..)+    , TransactionOut(..)+    , signTransaction+    , verifyTransactionSignature+    ) where++import qualified Data.Aeson             as Aeson+import qualified Data.ByteString.Lazy   as Lazy+import qualified Data.Hashable          as H+import qualified Data.List.NonEmpty     as NonEmpty+import qualified Data.Word              as Word+import qualified GHC.Generics           as Generic+++import qualified Data.Blockchain.Crypto as Crypto++data Transaction = Transaction+    { transactionIn  :: NonEmpty.NonEmpty TransactionIn+    , transactionOut :: NonEmpty.NonEmpty TransactionOut+    -- TODO: arbitrary bytes?+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON Transaction+instance Aeson.ToJSON  Transaction+instance Crypto.ToHash Transaction++newtype CoinbaseTransaction = CoinbaseTransaction+    { coinbaseTransactionOut :: NonEmpty.NonEmpty TransactionOut+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON CoinbaseTransaction+instance Aeson.ToJSON CoinbaseTransaction+instance Crypto.ToHash CoinbaseTransaction++data TransactionIn = TransactionIn+    { transactionOutRef :: TransactionOutRef+    , signature         :: Crypto.Signature -- ^ Signature from prev transaction, using pubkey from prev transaction+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.ToJSON TransactionIn+instance Aeson.FromJSON TransactionIn+instance Crypto.ToHash TransactionIn++-- | Pointer to a specific TransactionOut+data TransactionOutRef = TransactionOutRef+    { transactionHash     :: Either (Crypto.Hash CoinbaseTransaction) (Crypto.Hash Transaction)+    , transactionOutIndex :: Word.Word+    }+  deriving (Generic.Generic, Eq, Show)++instance H.Hashable TransactionOutRef++instance Aeson.FromJSON TransactionOutRef+instance Aeson.ToJSON TransactionOutRef++data TransactionOut = TransactionOut+    { value           :: Word.Word+    , signaturePubKey :: Crypto.PublicKey -- ^ Address of where funds go+    }+  deriving (Generic.Generic, Eq, Show)++instance Aeson.FromJSON TransactionOut+instance Aeson.ToJSON TransactionOut+instance Crypto.ToHash TransactionOut++signTransaction :: Crypto.PrivateKey -> TransactionOut -> IO Crypto.Signature+signTransaction priv = Crypto.sign priv . Lazy.toStrict . Aeson.encode++verifyTransactionSignature :: Crypto.Signature -> TransactionOut -> Bool+verifyTransactionSignature sig txOut = Crypto.verify pub sig $ Lazy.toStrict (Aeson.encode txOut)+  where+    pub = signaturePubKey txOut

@@ -5,18 +5,15 @@     ) where  import           Test.QuickCheck+import           Test.QuickCheck.Instances () -import qualified Crypto.PubKey.ECC.ECDSA     as Crypto-import qualified Crypto.PubKey.ECC.Types     as Crypto-import qualified Data.ByteString.Char8       as BS-import qualified Data.List.NonEmpty          as NonEmpty-import           Data.Monoid                 ((<>))-import qualified Data.Time.Calendar          as Time-import qualified Data.Time.Clock             as Time-import qualified Data.Word                   as Word+import qualified Crypto.PubKey.ECC.ECDSA   as Crypto+import qualified Crypto.PubKey.ECC.Types   as Crypto+import qualified Data.ByteString.Char8     as BS+import           Data.Monoid               ((<>))+import qualified Data.Word                 as Word -import           Data.Blockchain.Core.Crypto-import           Data.Blockchain.Core.Types+import           Data.Blockchain  -- Blockchain types @@ -91,20 +88,6 @@  instance Arbitrary Hex256 where     arbitrary = Hex256 <$> arbitrary--instance Arbitrary a => Arbitrary (NonEmpty.NonEmpty a) where-    arbitrary = NonEmpty.fromList <$> listOf1 arbitrary--instance Arbitrary BS.ByteString where-    arbitrary = BS.pack <$> arbitrary--instance Arbitrary Time.UTCTime where-    arbitrary = Time.UTCTime <$> dayDen <*> dayTimeGen-      where-        -- The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17.-        dayDen     = Time.ModifiedJulianDay <$> elements [0 .. 60000]-        -- The time from midnight, 0 <= t < 86401s (because of leap-seconds)-        dayTimeGen = Time.secondsToDiffTime <$> elements [0 .. 86400]  newtype MediumWord = MediumWord Word.Word deriving (Eq, Show) instance Arbitrary MediumWord where

@@ -0,0 +1,73 @@+module Data.Blockchain.Builder.TransactionSpec (spec) where++import           TestUtil++import qualified Data.List.NonEmpty as NonEmpty++import           Data.Blockchain++blockchainItems :: IO (Blockchain Validated, KeyPair)+blockchainItems = do+    blockchain <- blockchain1Block+    block      <- block1A+    privateKey <- block1ACoinbasePrivateKey++    return (blockchain, KeyPair (coinbasePublicKey block) privateKey)++coinbasePublicKey :: Block -> PublicKey+coinbasePublicKey = signaturePubKey . NonEmpty.head . coinbaseTransactionOut . coinbaseTransaction++spec :: Spec+spec = describe "Data.Blockchain.Builder.Transaction" $+    describe "createSimpleTransaction" $ do+        propNumTests 5 "should create a valid transaction" $+            \(Small value) (Small fee) targetPublicKey -> value + fee < 100 ==> ioProperty $ do+                (blockchain, keyPair) <- blockchainItems++                (Transaction txIn txOut) <- throwLeft <$>+                    createSimpleTransaction keyPair targetPublicKey value fee blockchain++                return $+                    length txIn == 1 &&+                    txOut == NonEmpty.fromList+                        [ TransactionOut (100 - value - fee) (publicKey keyPair)+                        , TransactionOut value targetPublicKey+                        ]++        propNumTests 5 "should not issue a refund if entire balance is spent" $+            \(Small value) targetPublicKey -> value < 100 ==> ioProperty $ do+                (blockchain, keyPair) <- blockchainItems++                let fee = 100 - value++                (Transaction txIn txOut) <- throwLeft <$>+                    createSimpleTransaction keyPair targetPublicKey value fee blockchain++                return $+                    length txIn == 1 &&+                    txOut       == NonEmpty.fromList [ TransactionOut value targetPublicKey ]++        propNumTests 5 "should reject transactions attempting to spend from empty address" $+            \(Small value) (Small fee) publicKey targetPublicKey -> value + fee < 100 ==> ioProperty $ do+                (blockchain, KeyPair _ privKey) <- blockchainItems++                let keyPair = KeyPair publicKey privKey++                res <- createSimpleTransaction keyPair targetPublicKey value fee blockchain+                return $ res === Left SourceAddressEmpty++        propNumTests 5 "should reject transactions attempting to spend more than is available in the address" $+            \(MediumWord value) (MediumWord fee) targetPublicKey -> value + fee > 100 ==> ioProperty $ do+                  (blockchain, keyPair) <- blockchainItems++                  res <- createSimpleTransaction keyPair targetPublicKey value fee blockchain+                  return $ res === Left SourceAddressInsufficientFunds++        propNumTests 5 "should reject transactions with invalid private key" $+            \(Small value) (Small fee) privateKey targetPublicKey -> value + fee < 100 ==> ioProperty $ do+                  (blockchain, KeyPair pubKey _) <- blockchainItems++                  let keyPair = KeyPair pubKey privateKey++                  res <- createSimpleTransaction keyPair targetPublicKey value fee blockchain+                  return $ res === Left InvalidPrivateKey

@@ -1,202 +0,0 @@-module Data.Blockchain.Core.BlockchainSpec (spec) where--import           TestUtil--import qualified Control.Arrow                   as Arrow-import qualified Data.Aeson                      as Aeson-import qualified Data.HashMap.Strict             as H-import qualified Data.List.NonEmpty              as NonEmpty--import           Data.Blockchain.Core.Blockchain-import           Data.Blockchain.Core.Types--spec :: Spec-spec = describe "Data.Blockchain.Core.Blockchain" $ do-    it "should serialize and validate round-trip" $ once $ ioProperty $ do-        chain <- blockchain3Block--        let unverifiedBlockchain = throwLeft $ Aeson.eitherDecode (Aeson.encode chain)--        return $ validate unverifiedBlockchain === Right chain--    describe "validate" $ do-        it "should reject a chain with invalid difficulty reference in genesis block" $ once $ ioProperty $ do-            chain <- singletonBlockchainUnvalidated-            let config = (blockchainConfig chain) { initialDifficulty = minBound }-                chain' = construct config (blockchainNode chain)--            return $ validate chain' === Left (BlockValidationException InvalidDifficultyReference)--        it "should reject a chain with invalid genesis block difficulty" $ once $ ioProperty $ do-            chain <- singletonBlockchainUnvalidated--            let (BlockchainNode block nodes) = blockchainNode chain-                blockHeader' = (blockHeader block) { nonce = 1 }-                block'       = block { blockHeader = blockHeader' }-                chain'       = construct (blockchainConfig chain) (BlockchainNode block' nodes)--            return $ validate chain' === Left (BlockValidationException InvalidDifficulty)--        it "should reject a chain with transactions in genesis block" $ once $-            \tx -> ioProperty $ do-                chain <- singletonBlockchainUnvalidated--                let (BlockchainNode block nodes) = blockchainNode chain-                    block' = block { transactions = pure tx }-                    chain' = construct (blockchainConfig chain) (BlockchainNode block' nodes)--                return $ validate chain' === Left GenesisBlockHasTransactions--        it "should reject a chain with invalid coinbase reward in genesis block" $ once $-            \txOut -> ioProperty $ do-                chain <- singletonBlockchainUnvalidated--                let (BlockchainNode block nodes) = blockchainNode chain-                    coinbase = CoinbaseTransaction $ pure $ txOut { value = 999 }-                    block'   = block { coinbaseTransaction = coinbase }-                    chain'   = construct (blockchainConfig chain) (BlockchainNode block' nodes)--                return $ validate chain' === Left (BlockValidationException InvalidCoinbaseTransactionValue)--        it "should reject a chain with invalid coinbase hash in genesis block header" $ once $-            \txOut -> ioProperty $ do-                chain <- singletonBlockchainUnvalidated--                let (BlockchainNode block nodes) = blockchainNode chain-                    coinbase = CoinbaseTransaction $ pure $ txOut { value = 100 }-                    block'   = block { coinbaseTransaction = coinbase }-                    chain'   = construct (blockchainConfig chain) (BlockchainNode block' nodes)--                return $ validate chain' === Left (BlockValidationException InvalidCoinbaseTransactionHash)--        -- TODO: test if possible, hard to do with empty transaction rule & expected header hash-        -- it "should reject a chain with invalid transaction hash in genesis block header" $ once $--    describe "addBlock" $ do-        -- Note: adding valid blocks is already tested by generating by loading test data-        -- it "should add a valid block" ...--        it "should reject a duplicate block" $ once $ ioProperty $ do-            blockchain <- blockchain1Block-            block      <- block1A--            return $ addBlock block blockchain === Left BlockAlreadyExists--        it "should reject a block without a parent" $ once $ ioProperty $ do-            blockchain <- singletonBlockchain-            block      <- block2A--            return $ addBlock block blockchain === Left NoParentFound--        it "should reject a block with invalid genesis block difficulty" $ once $ ioProperty $ do-            blockchain                  <- blockchain1Block-            (Block header coinbase txs) <- block2A--            let header' = header { nonce = 1 }-                block   = Block header' coinbase txs--            return $ addBlock block blockchain === Left InvalidDifficulty--        it "should reject a block with invalid coinbase reward in block" $ once $-            \txOut -> ioProperty $ do-                blockchain                   <- blockchain1Block-                (Block header _coinbase txs) <- block2A--                let coinbase = CoinbaseTransaction $ pure $ txOut { value = 999 }-                    block    = Block header coinbase txs--                return $ addBlock block blockchain === Left InvalidCoinbaseTransactionValue--        it "should reject a block with invalid coinbase hash in block header" $ once $-            \txOut -> ioProperty $ do-                blockchain                   <- blockchain1Block-                (Block header _coinbase txs) <- block2A--                let coinbase = CoinbaseTransaction $ pure $ txOut { value = 100 }-                    block    = Block header coinbase txs--                return $ addBlock block blockchain === Left InvalidCoinbaseTransactionHash--        -- it "should reject a block with invalid transaction hash in block header" $ once $-        --     \tx -> ioProperty $ do-        --         (blockchain, block) <- loadVerifiedTestBlockchainWithValidBlock-        --         let block' = block { transactions = pure tx }-        ---        --         return $ addBlock block' blockchain === Left InvalidTransactionHashTreeRoot--        it "should reject a block with an invalid transaction out ref" $ once $-            \txOutRef -> ioProperty $ do-                blockchain                  <- blockchain1Block-                (Block header coinbase txs) <- block2A--                let (Transaction txIn txOut) = head txs-                    txIn'                    = pure $ (NonEmpty.head txIn) { transactionOutRef = txOutRef }-                    block                    = Block header coinbase $ pure $ Transaction txIn' txOut--                return $ addBlock block blockchain === Left TransactionOutRefNotFound--        it "should reject a block with an invalid transaction signature" $ once $-            \sig -> ioProperty $ do-                blockchain                  <- blockchain1Block-                (Block header coinbase txs) <- block2A--                let (Transaction txIn txOut) = head txs-                    txIn'                    = pure $ (NonEmpty.head txIn) { signature = sig }-                    block                    = Block header coinbase $ pure $ Transaction txIn' txOut--                return $ addBlock block blockchain === Left InvalidTransactionSignature--        it "should reject a block with an invalid transaction value" $ once $ ioProperty $ do-            blockchain                  <- blockchain1Block-            (Block header coinbase txs) <- block2A--            let (Transaction txIn txOut) = head txs-                txOut'                   = pure $ (NonEmpty.head txOut) { value = 999 }-                block                    = Block header coinbase $ pure $ Transaction txIn txOut'--            return $ addBlock block blockchain === Left InvalidTransactionValues--        -- TODO: test-        -- it "should reject a block with a duplicate transaction" $ once $ ioProperty $ do--    describe "addressValues" $-        it "should calculate unspent transaction outputs" $ once $ ioProperty $ do-            blockchain <- blockchain3Block--            return $ showKeys (addressValues blockchain) === H.fromList-                -- genesis coinbase, value can never be spent-                [ ("8330da21047df515590bc752ac27210d3eb11bc1ec1b4dcb8f6c6b0b018fb5d44feb11798ca599b0c1549146508933833c4553d420504bef2c5f96dd42e143df", 100)-                -- mined 1st and 2nd block, spent 90 of 1st block coinbase-                , ("74bbe6d5f70f7d7e433b9b6d5d77a391492cc93161d9f108cef18d64959930cf1d55ef0844c0607f5568d1cd9233995154b5758915eb595e1dee472d13a18517", 110)-                -- received 90 of 1st block coinbase-                , ("c21609f09388037802a7c58e8135e264e8f4bac3354ee300ee73b887a7976a94614e77bcec828579562b9b3c0ac6f0de7323f3f5bcfdb3dfb190cfca1692d735", 90)-                ]--    describe "flatten" $-        it "should flatten the blockchain" $ once $ ioProperty $ do-            blockchain <- blockchain3Block-            b0         <- genesisBlock-            b1a        <- block1A-            b1b        <- block1B-            b2a        <- block2A--            return $ flatten blockchain === NonEmpty.fromList-                    [ NonEmpty.fromList [b0, b1b]-                    , NonEmpty.fromList [b0, b1a, b2a]-                    ]--    describe "longestChain" $-        it "should find the longest chain" $ once $ ioProperty $ do-            blockchain   <- blockchain1Block-            blockchain'  <- blockchain2BlockFork-            blockchain'' <- blockchain3Block-            b0           <- genesisBlock-            b1a          <- block1A-            b2a          <- block2A--            return $ (longestChain blockchain   == NonEmpty.fromList [b0, b1a]) &&-                     (longestChain blockchain'  == NonEmpty.fromList [b0, b1a]) &&-                     (longestChain blockchain'' == NonEmpty.fromList [b0, b1a, b2a])--showKeys :: Show k => H.HashMap k v -> H.HashMap String v-showKeys = H.fromList . fmap (Arrow.first show) . H.toList

@@ -1,76 +0,0 @@-module Data.Blockchain.Core.Builder.TransactionSpec (spec) where--import           TestUtil--import qualified Data.List.NonEmpty              as NonEmpty--import           Data.Blockchain.Core.Blockchain-import           Data.Blockchain.Core.Builder-import           Data.Blockchain.Core.Crypto-import           Data.Blockchain.Core.Types--blockchainItems :: IO (Blockchain Validated, KeyPair)-blockchainItems = do-    blockchain <- blockchain1Block-    block      <- block1A-    privateKey <- block1ACoinbasePrivateKey--    return (blockchain, KeyPair (coinbasePublicKey block) privateKey)--coinbasePublicKey :: Block -> PublicKey-coinbasePublicKey = signaturePubKey . NonEmpty.head . coinbaseTransactionOut . coinbaseTransaction--spec :: Spec-spec = describe "Data.Blockchain.Core.Builder.Transaction" $-    describe "createSimpleTransaction" $ do-        propNumTests 5 "should create a valid transaction" $-            \(Small value) (Small fee) targetPublicKey -> value + fee < 100 ==> ioProperty $ do-                (blockchain, keyPair) <- blockchainItems--                (Transaction txIn txOut) <- throwLeft <$>-                    createSimpleTransaction keyPair targetPublicKey value fee blockchain--                return $-                    length txIn == 1 &&-                    txOut == NonEmpty.fromList-                        [ TransactionOut (100 - value - fee) (publicKey keyPair)-                        , TransactionOut value targetPublicKey-                        ]--        propNumTests 5 "should not issue a refund if entire balance is spent" $-            \(Small value) targetPublicKey -> value < 100 ==> ioProperty $ do-                (blockchain, keyPair) <- blockchainItems--                let fee = 100 - value--                (Transaction txIn txOut) <- throwLeft <$>-                    createSimpleTransaction keyPair targetPublicKey value fee blockchain--                return $-                    length txIn == 1 &&-                    txOut       == NonEmpty.fromList [ TransactionOut value targetPublicKey ]--        propNumTests 5 "should reject transactions attempting to spend from empty address" $-            \(Small value) (Small fee) publicKey targetPublicKey -> value + fee < 100 ==> ioProperty $ do-                (blockchain, KeyPair _ privKey) <- blockchainItems--                let keyPair = KeyPair publicKey privKey--                res <- createSimpleTransaction keyPair targetPublicKey value fee blockchain-                return $ res === Left SourceAddressEmpty--        propNumTests 5 "should reject transactions attempting to spend more than is available in the address" $-            \(MediumWord value) (MediumWord fee) targetPublicKey -> value + fee > 100 ==> ioProperty $ do-                  (blockchain, keyPair) <- blockchainItems--                  res <- createSimpleTransaction keyPair targetPublicKey value fee blockchain-                  return $ res === Left SourceAddressInsufficientFunds--        propNumTests 5 "should reject transactions with invalid private key" $-            \(Small value) (Small fee) privateKey targetPublicKey -> value + fee < 100 ==> ioProperty $ do-                  (blockchain, KeyPair pubKey _) <- blockchainItems--                  let keyPair = KeyPair pubKey privateKey--                  res <- createSimpleTransaction keyPair targetPublicKey value fee blockchain-                  return $ res === Left InvalidPrivateKey

@@ -1,22 +0,0 @@-module Data.Blockchain.Core.Crypto.ECDSASpec (spec) where--import           TestUtil--import           Data.Blockchain.Core.Crypto--spec :: Spec-spec =-    describe "Data.Blockchain.Core.Crypto.ECDSA" $ do-        safeJSONDeserializeSpec (Proxy :: Proxy PublicKey)-        safeJSONDeserializeSpec (Proxy :: Proxy PrivateKey)-        safeJSONDeserializeSpec (Proxy :: Proxy Signature)--        roundTripJSONSpec (Proxy :: Proxy PublicKey)-        roundTripJSONSpec (Proxy :: Proxy PrivateKey)-        roundTripJSONSpec (Proxy :: Proxy Signature)--        propNumTests 5 "should sign and verify correctly" $-            \bs -> ioProperty $ do-                (KeyPair publicKey privateKey) <- generate-                sig <- sign privateKey bs-                return $ verify publicKey sig bs

@@ -1,23 +0,0 @@-module Data.Blockchain.Core.Crypto.HashSpec (spec) where--import           TestUtil--import qualified Data.Aeson                  as Aeson-import qualified Data.ByteString             as BS-import qualified Data.ByteString.Char8       as Char8--import           Data.Blockchain.Core.Crypto--spec :: Spec-spec =-    describe "Data.Blockchain.Core.Crypto.Hash" $ do-        prop "should hash to a hex" $-            \(bs :: BS.ByteString) -> hashToHex (hash bs) >= minBound--        prop "should round-trip json serialize" $-            \(bs :: BS.ByteString) -> let h = hash bs in-                Aeson.decode (Aeson.encode h) == Just h--        prop "should round-trip bytestring serialize" $-            \(bs :: BS.ByteString) -> let h = hash bs in-                fromByteString (Char8.pack $ show h) == Just h

@@ -1,33 +0,0 @@-module Data.Blockchain.Core.Crypto.HashTreeSpec (spec) where--import           TestUtil--import qualified Data.ByteString             as BS-import qualified Data.ByteString.Char8       as Char8-import           Data.Monoid                 ((<>))--import           Data.Blockchain.Core.Crypto--testData :: [BS.ByteString]-testData = replicate (numBytes `div` blockSize) block <> [partialBlock]-  where-    blockSize    = 64-    numBytes     = (2 ^ (22 :: Int)) + 32-    block        = Char8.replicate blockSize '\000'-    partialBlock = Char8.replicate (numBytes `mod` blockSize) '\000'--expectedRootHash :: Hash BS.ByteString-expectedRootHash = unsafeFromByteString "e9683665a90bd70aabd7705cba57c2be2a4e913a0ca1a14d765497112c178120"--spec :: Spec-spec =-    describe "Data.Blockchain.Core.Crypto.HashTree" $ do-        it "should create a hash tree for a known hash" $ once $-            unHashTreeRoot (hashTreeRoot testData) === expectedRootHash--        prop "should hash a single item correctly" $-            \(bs :: BS.ByteString) ->-                unHashTreeRoot (hashTreeRoot (pure bs)) === hash bs--        prop "should complete for any data" $-            \(bs :: [BS.ByteString]) -> let !_x = unHashTreeRoot (hashTreeRoot bs) in True

@@ -1,75 +0,0 @@-module Data.Blockchain.Core.Types.BlockchainConfigSpec (spec) where--import           TestUtil--import           Data.Monoid                ((<>))-import qualified Data.Time.Clock            as Time--import           Data.Blockchain.Core.Types--testConfig :: BlockchainConfig-testConfig = BlockchainConfig-    { initialDifficulty             = Difficulty 1000-    , difficulty1Target             = hex256LeadingZeros 2-    , targetSecondsPerBlock         = 60-    , difficultyRecalculationHeight = 10-    , initialMiningReward           = 100-    , miningRewardHalvingHeight     = 100-    }--spec :: Spec-spec = describe "Data.Blockchain.Core.Types.BlockchainConfig" $ do-    describe "targetReward" $ do-        it "should produce the correct reward" $-            and [ targetReward testConfig 0   == 100-                , targetReward testConfig 99  == 100-                , targetReward testConfig 100 == 50-                , targetReward testConfig 101 == 50-                , targetReward testConfig 300 == 12-                , targetReward testConfig 600 == 1-                , targetReward testConfig 700 == 0-                , targetReward testConfig 800 == 0-                ]--        prop "should always find a valid reward" $-            \conf height ->-                let reward = targetReward conf height-                in  reward >= 0 && reward <= initialMiningReward conf--        prop "should always use initial reward if recalc height it zero" $-            \conf height ->-                let conf' = conf { miningRewardHalvingHeight = 0 }-                in targetReward conf' height == initialMiningReward conf--    describe "targetDifficulty" $ do-        prop "should use initial config when no blocks" $-            \conf -> targetDifficulty conf mempty === initialDifficulty conf--        prop "should correctly increase difficulty" $-            \block -> targetDifficulty testConfig (blocksWithOffset 60 block) === Difficulty 10000--        prop "should correctly decrease difficulty" $-            \block -> targetDifficulty testConfig (blocksWithOffset 6000 block) === Difficulty 100--        propWithSize 20 "should produce the correct difficulty when not recalculating" $-            \(NonEmpty blocks) conf ->-                  -- Pretty complex example, can it be cleaned up?-                  difficultyRecalculationHeight conf /= 0 &&-                  targetSecondsPerBlock conf /= 0 &&-                  length blocks `mod` fromIntegral (difficultyRecalculationHeight conf) /= 0-                  ==> targetDifficulty conf blocks === difficulty (blockHeader $ last blocks)--        prop "should always find a valid difficulty" $-            \conf blocks -> targetDifficulty conf blocks >= minBound--blocksWithOffset :: Time.NominalDiffTime -> Block -> [Block]-blocksWithOffset diffTime (Block header coinbase txs) =-    replicate 9 block <> pure lastBlock-  where-    block      = Block (header { difficulty = initialDifficulty testConfig }) coinbase txs-    endTime    = Time.addUTCTime diffTime $ time header-    lastBlock  = setTime endTime block---setTime :: Time.UTCTime -> Block -> Block-setTime t (Block header tx txs) = Block (header {time = t}) tx txs

@@ -1,16 +0,0 @@-module Data.Blockchain.Core.Types.DifficultySpec (spec) where--import           TestUtil--import qualified Data.Aeson                 as Aeson--import           Data.Blockchain.Core.Types--spec :: Spec-spec =-    describe "Data.Blockchain.Core.Types.Difficulty" $ do-        safeJSONDeserializeSpec (Proxy :: Proxy Difficulty)-        roundTripJSONSpec (Proxy :: Proxy Difficulty)--        it "should handle invalid natural values when deserializing" $ once $-            Aeson.decode "[-1]" === (Nothing :: Maybe [Difficulty])

@@ -1,11 +0,0 @@-module Data.Blockchain.Core.Types.HexSpec (spec) where--import           TestUtil--import           Data.Blockchain.Core.Types--spec :: Spec-spec =-    describe "Data.Blockchain.Core.Util.Hex" $ do-        safeJSONDeserializeSpec (Proxy :: Proxy Hex256)-        roundTripJSONSpec (Proxy :: Proxy Hex256)

@@ -1,18 +0,0 @@-module Data.Blockchain.Core.Types.TransactionSpec (spec) where--import           TestUtil--import           Data.Blockchain.Core.Crypto-import           Data.Blockchain.Core.Types--spec :: Spec-spec =-    describe "Data.Blockchain.Core.Types.Transaction" $-        propNumTests 5 "should sign round-trip" $-            \val -> ioProperty $ do-                (KeyPair pub priv) <- generate--                let txOut = TransactionOut val pub-                sig <- signTransaction priv txOut--                return (verifyTransactionSignature sig txOut)

@@ -0,0 +1,22 @@+module Data.Blockchain.Crypto.ECDSASpec (spec) where++import TestUtil++import Data.Blockchain.Crypto++spec :: Spec+spec =+    describe "Data.Blockchain.Crypto.ECDSA" $ do+        safeJSONDeserializeSpec (Proxy :: Proxy PublicKey)+        safeJSONDeserializeSpec (Proxy :: Proxy PrivateKey)+        safeJSONDeserializeSpec (Proxy :: Proxy Signature)++        roundTripJSONSpec (Proxy :: Proxy PublicKey)+        roundTripJSONSpec (Proxy :: Proxy PrivateKey)+        roundTripJSONSpec (Proxy :: Proxy Signature)++        propNumTests 5 "should sign and verify correctly" $+            \bs -> ioProperty $ do+                (KeyPair publicKey privateKey) <- generate+                sig <- sign privateKey bs+                return $ verify publicKey sig bs

@@ -0,0 +1,23 @@+module Data.Blockchain.Crypto.HashSpec (spec) where++import           TestUtil++import qualified Data.Aeson             as Aeson+import qualified Data.ByteString        as BS+import qualified Data.ByteString.Char8  as Char8++import           Data.Blockchain.Crypto++spec :: Spec+spec =+    describe "Data.Blockchain.Crypto.Hash" $ do+        prop "should hash to a hex" $+            \(bs :: BS.ByteString) -> hashToHex (hash bs) >= minBound++        prop "should round-trip json serialize" $+            \(bs :: BS.ByteString) -> let h = hash bs in+                Aeson.decode (Aeson.encode h) == Just h++        prop "should round-trip bytestring serialize" $+            \(bs :: BS.ByteString) -> let h = hash bs in+                fromByteString (Char8.pack $ show h) == Just h

@@ -0,0 +1,33 @@+module Data.Blockchain.Crypto.HashTreeSpec (spec) where++import           TestUtil++import qualified Data.ByteString        as BS+import qualified Data.ByteString.Char8  as Char8+import           Data.Monoid            ((<>))++import           Data.Blockchain.Crypto++testData :: [BS.ByteString]+testData = replicate (numBytes `div` blockSize) block <> [partialBlock]+  where+    blockSize    = 64+    numBytes     = (2 ^ (22 :: Int)) + 32+    block        = Char8.replicate blockSize '\000'+    partialBlock = Char8.replicate (numBytes `mod` blockSize) '\000'++expectedRootHash :: Hash BS.ByteString+expectedRootHash = unsafeFromByteString "e9683665a90bd70aabd7705cba57c2be2a4e913a0ca1a14d765497112c178120"++spec :: Spec+spec =+    describe "Data.Blockchain.Crypto.HashTree" $ do+        it "should create a hash tree for a known hash" $ once $+            unHashTreeRoot (hashTreeRoot testData) === expectedRootHash++        prop "should hash a single item correctly" $+            \(bs :: BS.ByteString) ->+                unHashTreeRoot (hashTreeRoot (pure bs)) === hash bs++        prop "should complete for any data" $+            \(bs :: [BS.ByteString]) -> let !_x = unHashTreeRoot (hashTreeRoot bs) in True

@@ -1,10 +1,9 @@ module Data.Blockchain.Mining.BlockSpec (spec) where -import           TestUtil+import TestUtil -import           Data.Blockchain.Core.Blockchain-import           Data.Blockchain.Core.Types-import           Data.Blockchain.Mining+import Data.Blockchain+import Data.Blockchain.Mining  spec :: Spec spec = describe "Data.Blockchain.Mining.Block" $ do

@@ -0,0 +1,75 @@+module Data.Blockchain.Types.BlockchainConfigSpec (spec) where++import           TestUtil++import           Data.Monoid           ((<>))+import qualified Data.Time.Clock       as Time++import           Data.Blockchain.Types++testConfig :: BlockchainConfig+testConfig = BlockchainConfig+    { initialDifficulty             = Difficulty 1000+    , difficulty1Target             = hex256LeadingZeros 2+    , targetSecondsPerBlock         = 60+    , difficultyRecalculationHeight = 10+    , initialMiningReward           = 100+    , miningRewardHalvingHeight     = 100+    }++spec :: Spec+spec = describe "Data.Blockchain.Types.BlockchainConfig" $ do+    describe "targetReward" $ do+        it "should produce the correct reward" $+            and [ targetReward testConfig 0   == 100+                , targetReward testConfig 99  == 100+                , targetReward testConfig 100 == 50+                , targetReward testConfig 101 == 50+                , targetReward testConfig 300 == 12+                , targetReward testConfig 600 == 1+                , targetReward testConfig 700 == 0+                , targetReward testConfig 800 == 0+                ]++        prop "should always find a valid reward" $+            \conf height ->+                let reward = targetReward conf height+                in  reward >= 0 && reward <= initialMiningReward conf++        prop "should always use initial reward if recalc height it zero" $+            \conf height ->+                let conf' = conf { miningRewardHalvingHeight = 0 }+                in targetReward conf' height == initialMiningReward conf++    describe "targetDifficulty" $ do+        prop "should use initial config when no blocks" $+            \conf -> targetDifficulty conf mempty === initialDifficulty conf++        prop "should correctly increase difficulty" $+            \block -> targetDifficulty testConfig (blocksWithOffset 60 block) === Difficulty 10000++        prop "should correctly decrease difficulty" $+            \block -> targetDifficulty testConfig (blocksWithOffset 6000 block) === Difficulty 100++        propWithSize 20 "should produce the correct difficulty when not recalculating" $+            \(NonEmpty blocks) conf ->+                  -- Pretty complex example, can it be cleaned up?+                  difficultyRecalculationHeight conf /= 0 &&+                  targetSecondsPerBlock conf /= 0 &&+                  length blocks `mod` fromIntegral (difficultyRecalculationHeight conf) /= 0+                  ==> targetDifficulty conf blocks === difficulty (blockHeader $ last blocks)++        prop "should always find a valid difficulty" $+            \conf blocks -> targetDifficulty conf blocks >= minBound++blocksWithOffset :: Time.NominalDiffTime -> Block -> [Block]+blocksWithOffset diffTime (Block header coinbase txs) =+    replicate 9 block <> pure lastBlock+  where+    block      = Block (header { difficulty = initialDifficulty testConfig }) coinbase txs+    endTime    = Time.addUTCTime diffTime $ time header+    lastBlock  = setTime endTime block+++setTime :: Time.UTCTime -> Block -> Block+setTime t (Block header tx txs) = Block (header {time = t}) tx txs

@@ -0,0 +1,203 @@+module Data.Blockchain.Types.BlockchainSpec (spec) where++import           TestUtil++import qualified Control.Arrow       as Arrow+import qualified Data.Aeson          as Aeson+import qualified Data.HashMap.Strict as H+import qualified Data.List.NonEmpty  as NonEmpty++import           Data.Blockchain++spec :: Spec+spec = describe "Data.Blockchain.Blockchain" $ do+    it "should serialize and validate round-trip" $ ioProperty $ do+        chain <- blockchain3Block++        let unverifiedBlockchain = throwLeft $ Aeson.eitherDecode (Aeson.encode chain)++        return $ validate unverifiedBlockchain === Right chain++    describe "validate" $ do+        it "should reject a chain with invalid difficulty reference in genesis block" $ ioProperty $ do+            chain <- singletonBlockchainUnvalidated+            let config = (blockchainConfig chain) { initialDifficulty = minBound }+                chain' = construct config (blockchainNode chain)++            return $ validate chain' === Left (BlockValidationException InvalidDifficultyReference)++        it "should reject a chain with invalid genesis block difficulty" $ ioProperty $ do+            chain <- singletonBlockchainUnvalidated++            let (BlockchainNode block nodes) = blockchainNode chain+                blockHeader' = (blockHeader block) { nonce = 1 }+                block'       = block { blockHeader = blockHeader' }+                chain'       = construct (blockchainConfig chain) (BlockchainNode block' nodes)++            return $ validate chain' === Left (BlockValidationException InvalidDifficulty)++        prop "should reject a chain with transactions in genesis block" $ once $+            \tx -> ioProperty $ do+                chain <- singletonBlockchainUnvalidated++                let (BlockchainNode block nodes) = blockchainNode chain+                    block' = block { transactions = pure tx }+                    chain' = construct (blockchainConfig chain) (BlockchainNode block' nodes)++                return $ validate chain' === Left GenesisBlockHasTransactions++        prop "should reject a chain with invalid coinbase reward in genesis block" $ once $+            \txOut -> ioProperty $ do+                chain <- singletonBlockchainUnvalidated++                let (BlockchainNode block nodes) = blockchainNode chain+                    coinbase = CoinbaseTransaction $ pure $ txOut { value = 999 }+                    block'   = block { coinbaseTransaction = coinbase }+                    chain'   = construct (blockchainConfig chain) (BlockchainNode block' nodes)++                return $ validate chain' === Left (BlockValidationException InvalidCoinbaseTransactionValue)++        prop "should reject a chain with invalid coinbase hash in genesis block header" $ once $+            \txOut -> ioProperty $ do+                chain <- singletonBlockchainUnvalidated++                let (BlockchainNode block nodes) = blockchainNode chain+                    coinbase = CoinbaseTransaction $ pure $ txOut { value = 100 }+                    block'   = block { coinbaseTransaction = coinbase }+                    chain'   = construct (blockchainConfig chain) (BlockchainNode block' nodes)++                return $ validate chain' === Left (BlockValidationException InvalidCoinbaseTransactionHash)++        -- TODO: test if possible, hard to do with empty transaction rule & expected header hash+        -- prop "should reject a chain with invalid transaction hash in genesis block header" $++    describe "addBlock" $ do+        -- Note: adding valid blocks is already tested by generating by loading test data+        -- prop "should add a valid block" ...++        it "should reject a duplicate block" $ ioProperty $ do+            blockchain <- blockchain1Block+            block      <- block1A++            return $ addBlock block blockchain === Left BlockAlreadyExists++        it "should reject a block without a parent" $ ioProperty $ do+            blockchain <- singletonBlockchain+            block      <- block2A++            return $ addBlock block blockchain === Left NoParentFound++        it "should reject a block with invalid genesis block difficulty" $ ioProperty $ do+            blockchain                  <- blockchain1Block+            (Block header coinbase txs) <- block2A++            let header' = header { nonce = 1 }+                block   = Block header' coinbase txs++            return $ addBlock block blockchain === Left InvalidDifficulty++        prop "should reject a block with invalid coinbase reward in block" $ once $+            \txOut -> ioProperty $ do+                blockchain                   <- blockchain1Block+                (Block header _coinbase txs) <- block2A++                let coinbase = CoinbaseTransaction $ pure $ txOut { value = 999 }+                    block    = Block header coinbase txs++                return $ addBlock block blockchain === Left InvalidCoinbaseTransactionValue++        prop "should reject a block with invalid coinbase hash in block header" $ once $+            \txOut -> ioProperty $ do+                blockchain                   <- blockchain1Block+                (Block header _coinbase txs) <- block2A++                let coinbase = CoinbaseTransaction $ pure $ txOut { value = 100 }+                    block    = Block header coinbase txs++                return $ addBlock block blockchain === Left InvalidCoinbaseTransactionHash++        -- prop "should reject a block with invalid transaction hash in block header" $+        --     \tx -> ioProperty $ do+        --         (blockchain, block) <- loadVerifiedTestBlockchainWithValidBlock+        --         let block' = block { transactions = pure tx }+        --+        --         return $ addBlock block' blockchain === Left InvalidTransactionHashTreeRoot++        prop "should reject a block with an invalid transaction out ref" $ once $+            \txOutRef -> ioProperty $ do+                blockchain                  <- blockchain1Block+                (Block header coinbase txs) <- block2A++                let (Transaction txIn txOut) = head txs+                    txIn'                    = pure $ (NonEmpty.head txIn) { transactionOutRef = txOutRef }+                    block                    = Block header coinbase $ pure $ Transaction txIn' txOut++                return $ addBlock block blockchain === Left TransactionOutRefNotFound++        prop "should reject a block with an invalid transaction signature" $ once $+            \sig -> ioProperty $ do+                blockchain                  <- blockchain1Block+                (Block header coinbase txs) <- block2A++                putStrLn "testing"++                let (Transaction txIn txOut) = head txs+                    txIn'                    = pure $ (NonEmpty.head txIn) { signature = sig }+                    block                    = Block header coinbase $ pure $ Transaction txIn' txOut++                return $ addBlock block blockchain === Left InvalidTransactionSignature++        it "should reject a block with an invalid transaction value" $ ioProperty $ do+            blockchain                  <- blockchain1Block+            (Block header coinbase txs) <- block2A++            let (Transaction txIn txOut) = head txs+                txOut'                   = pure $ (NonEmpty.head txOut) { value = 999 }+                block                    = Block header coinbase $ pure $ Transaction txIn txOut'++            return $ addBlock block blockchain === Left InvalidTransactionValues++        -- TODO: test+        -- prop "should reject a block with a duplicate transaction" $ ioProperty $ do++    describe "addressValues" $+        it "should calculate unspent transaction outputs" $ ioProperty $ do+            blockchain <- blockchain3Block++            return $ showKeys (addressValues blockchain) === H.fromList+                -- genesis coinbase, value can never be spent+                [ ("8330da21047df515590bc752ac27210d3eb11bc1ec1b4dcb8f6c6b0b018fb5d44feb11798ca599b0c1549146508933833c4553d420504bef2c5f96dd42e143df", 100)+                -- mined 1st and 2nd block, spent 90 of 1st block coinbase+                , ("74bbe6d5f70f7d7e433b9b6d5d77a391492cc93161d9f108cef18d64959930cf1d55ef0844c0607f5568d1cd9233995154b5758915eb595e1dee472d13a18517", 110)+                -- received 90 of 1st block coinbase+                , ("c21609f09388037802a7c58e8135e264e8f4bac3354ee300ee73b887a7976a94614e77bcec828579562b9b3c0ac6f0de7323f3f5bcfdb3dfb190cfca1692d735", 90)+                ]++    describe "flatten" $+        it "should flatten the blockchain" $ ioProperty $ do+            blockchain <- blockchain3Block+            b0         <- genesisBlock+            b1a        <- block1A+            b1b        <- block1B+            b2a        <- block2A++            return $ flatten blockchain === NonEmpty.fromList+                    [ NonEmpty.fromList [b0, b1b]+                    , NonEmpty.fromList [b0, b1a, b2a]+                    ]++    describe "longestChain" $+        it "should find the longest chain" $ ioProperty $ do+            blockchain   <- blockchain1Block+            blockchain'  <- blockchain2BlockFork+            blockchain'' <- blockchain3Block+            b0           <- genesisBlock+            b1a          <- block1A+            b2a          <- block2A++            return $ (longestChain blockchain   == NonEmpty.fromList [b0, b1a]) &&+                     (longestChain blockchain'  == NonEmpty.fromList [b0, b1a]) &&+                     (longestChain blockchain'' == NonEmpty.fromList [b0, b1a, b2a])++showKeys :: Show k => H.HashMap k v -> H.HashMap String v+showKeys = H.fromList . fmap (Arrow.first show) . H.toList

@@ -0,0 +1,16 @@+module Data.Blockchain.Types.DifficultySpec (spec) where++import           TestUtil++import qualified Data.Aeson            as Aeson++import           Data.Blockchain.Types++spec :: Spec+spec =+    describe "Data.Blockchain.Types.Difficulty" $ do+        safeJSONDeserializeSpec (Proxy :: Proxy Difficulty)+        roundTripJSONSpec (Proxy :: Proxy Difficulty)++        it "should handle invalid natural values when deserializing" $ once $+            Aeson.decode "[-1]" === (Nothing :: Maybe [Difficulty])

@@ -0,0 +1,11 @@+module Data.Blockchain.Types.HexSpec (spec) where++import TestUtil++import Data.Blockchain.Types++spec :: Spec+spec =+    describe "Data.Blockchain.Util.Hex" $ do+        safeJSONDeserializeSpec (Proxy :: Proxy Hex256)+        roundTripJSONSpec (Proxy :: Proxy Hex256)

@@ -0,0 +1,18 @@+module Data.Blockchain.Types.TransactionSpec (spec) where++import TestUtil++import Data.Blockchain.Crypto+import Data.Blockchain.Types++spec :: Spec+spec =+    describe "Data.Blockchain.Types.Transaction" $+        propNumTests 5 "should sign round-trip" $+            \val -> ioProperty $ do+                (KeyPair pub priv) <- generate++                let txOut = TransactionOut val pub+                sig <- signTransaction priv txOut++                return (verifyTransactionSignature sig txOut)

@@ -2,23 +2,21 @@     ( mineTestChain     ) where -import qualified Control.Concurrent.Async        as Async-import qualified Control.Concurrent.MVar         as MVar-import           Control.Monad                   (forM, void)-import qualified Data.Aeson                      as Aeson-import qualified Data.ByteString.Lazy            as Lazy-import qualified Data.List.NonEmpty              as NonEmpty-import           Data.Monoid                     ((<>))-import qualified Data.Time.Clock                 as Time+import qualified Control.Concurrent.Async as Async+import qualified Control.Concurrent.MVar  as MVar+import           Control.Monad            (forM, void)+import qualified Data.Aeson               as Aeson+import qualified Data.ByteString.Lazy     as Lazy+import qualified Data.List.NonEmpty       as NonEmpty+import           Data.Monoid              ((<>))+import qualified Data.Time.Clock          as Time -import qualified Data.Blockchain.Core.Blockchain as B-import qualified Data.Blockchain.Core.Crypto     as Crypto-import qualified Data.Blockchain.Core.Types      as B-import qualified Data.Blockchain.Mining          as Mining+import qualified Data.Blockchain          as B+import qualified Data.Blockchain.Mining   as Mining  data MinerSpec = MinerSpec     { mid               :: Int-    , pubKey            :: Crypto.PublicKey+    , pubKey            :: B.PublicKey     , receiveBlock      :: IO B.Block     , sendBlock         :: B.Block -> IO ()     , persistBlockchain :: B.Blockchain B.Validated -> IO ()@@ -28,7 +26,7 @@ mineTestChain :: Int -> IO () mineTestChain miners = runTestMultiMiner miners config persist   where-    persist i = writeJSON $ "data/test_blockchain_" <> show i <> ".json"+    persist i = writeJSON $ "../data/test_blockchain_" <> show i <> ".json"     config = B.defaultConfig         { B.initialMiningReward           = 500         , B.difficultyRecalculationHeight = 10@@ -53,7 +51,7 @@      miners <- forM specs $ \(sendBlock, receiveBlock, mid) -> do         let persistBlockchain = persist mid-        (Crypto.KeyPair pubKey _privKey) <- Crypto.generate+        (B.KeyPair pubKey _privKey) <- B.generate         return MinerSpec{..}      asyncs <- mapM (Async.async . runMinerFakeNetwork blockchain) miners@@ -104,7 +102,7 @@     block <- throwLeft <$> Mining.mineEmptyBlock pubKey chain     end   <- Time.getCurrentTime -    let h = Crypto.hash (B.blockHeader block)+    let h = B.hash (B.blockHeader block)      log' "Found next block"     log' $ "  Hash: " <> show h

@@ -4,17 +4,16 @@  -- TODO: this module might be useful elsewhere outside of "Test" group -import qualified Data.HashMap.Strict             as H-import qualified Data.List                       as List-import qualified Data.List.NonEmpty              as NonEmpty-import           Data.Monoid                     ((<>))-import           Data.Ratio                      (Ratio)-import qualified Data.Time.Clock                 as Time-import           Data.Word                       (Word)-import           Numeric.Natural                 (Natural)+import qualified Data.HashMap.Strict as H+import qualified Data.List           as List+import qualified Data.List.NonEmpty  as NonEmpty+import           Data.Monoid         ((<>))+import           Data.Ratio          (Ratio)+import qualified Data.Time.Clock     as Time+import           Data.Word           (Word)+import           Numeric.Natural     (Natural) -import qualified Data.Blockchain.Core.Blockchain as B-import qualified Data.Blockchain.Core.Types      as B+import qualified Data.Blockchain     as B  data BlockchainStats = BlockchainStats     { numBlocks             :: Word

@@ -1,19 +1,19 @@-module Main where+module Main (main) where  import qualified Test.Hspec  import qualified System.Environment -import qualified Data.Blockchain.Core.BlockchainSpec-import qualified Data.Blockchain.Core.Builder.TransactionSpec-import qualified Data.Blockchain.Core.Crypto.ECDSASpec-import qualified Data.Blockchain.Core.Crypto.HashSpec-import qualified Data.Blockchain.Core.Crypto.HashTreeSpec-import qualified Data.Blockchain.Core.Types.BlockchainConfigSpec-import qualified Data.Blockchain.Core.Types.DifficultySpec-import qualified Data.Blockchain.Core.Types.HexSpec-import qualified Data.Blockchain.Core.Types.TransactionSpec+import qualified Data.Blockchain.Builder.TransactionSpec+import qualified Data.Blockchain.Crypto.ECDSASpec+import qualified Data.Blockchain.Crypto.HashSpec+import qualified Data.Blockchain.Crypto.HashTreeSpec import qualified Data.Blockchain.Mining.BlockSpec+import qualified Data.Blockchain.Types.BlockchainConfigSpec+import qualified Data.Blockchain.Types.BlockchainSpec+import qualified Data.Blockchain.Types.DifficultySpec+import qualified Data.Blockchain.Types.HexSpec+import qualified Data.Blockchain.Types.TransactionSpec import qualified Integration.Mining import qualified Integration.Stats import qualified TestUtil@@ -28,14 +28,14 @@     readBlockchain = fmap TestUtil.validate' . TestUtil.readJSON  specs :: [Test.Hspec.Spec]-specs = [ Data.Blockchain.Core.BlockchainSpec.spec-        , Data.Blockchain.Core.Builder.TransactionSpec.spec-        , Data.Blockchain.Core.Crypto.ECDSASpec.spec-        , Data.Blockchain.Core.Crypto.HashSpec.spec-        , Data.Blockchain.Core.Crypto.HashTreeSpec.spec-        , Data.Blockchain.Core.Types.BlockchainConfigSpec.spec-        , Data.Blockchain.Core.Types.DifficultySpec.spec-        , Data.Blockchain.Core.Types.HexSpec.spec-        , Data.Blockchain.Core.Types.TransactionSpec.spec+specs = [ Data.Blockchain.Builder.TransactionSpec.spec+        , Data.Blockchain.Crypto.ECDSASpec.spec+        , Data.Blockchain.Crypto.HashSpec.spec+        , Data.Blockchain.Crypto.HashTreeSpec.spec+        , Data.Blockchain.Types.BlockchainSpec.spec+        , Data.Blockchain.Types.BlockchainConfigSpec.spec+        , Data.Blockchain.Types.DifficultySpec.spec+        , Data.Blockchain.Types.HexSpec.spec+        , Data.Blockchain.Types.TransactionSpec.spec         , Data.Blockchain.Mining.BlockSpec.spec         ]

@@ -20,17 +20,15 @@     , throwLeft     ) where -import qualified Data.Aeson                      as Aeson-import qualified Data.ByteString.Lazy            as Lazy+import qualified Data.Aeson           as Aeson+import qualified Data.ByteString.Lazy as Lazy -import           Data.Blockchain.Core.Blockchain-import           Data.Blockchain.Core.Crypto-import           Data.Blockchain.Core.Types+import           Data.Blockchain  -- Test Data -------------------------------------------------------------------------------------------------  singletonBlockchainUnvalidated :: IO (Blockchain Unvalidated)-singletonBlockchainUnvalidated = readJSON "data/singleton_blockchain.json"+singletonBlockchainUnvalidated = readJSON "../data/singleton_blockchain.json"  singletonBlockchain :: IO (Blockchain Validated) singletonBlockchain = validate' <$> singletonBlockchainUnvalidated@@ -44,14 +42,14 @@ genesisBlock = nodeBlock . blockchainNode <$> singletonBlockchain  block1A, block1B, block2A :: IO Block-block1A = readJSON "data/block_1a.json"-block1B = readJSON "data/block_1b.json"-block2A = readJSON "data/block_2a.json"+block1A = readJSON "../data/block_1a.json"+block1B = readJSON "../data/block_1b.json"+block2A = readJSON "../data/block_2a.json"  block1ACoinbasePrivateKey, block1BCoinbasePrivateKey, block2ACoinbasePrivateKey :: IO PrivateKey-block1ACoinbasePrivateKey = readJSON "data/block_1a_coinbase_private_key.json"-block1BCoinbasePrivateKey = readJSON "data/block_1b_coinbase_private_key.json"-block2ACoinbasePrivateKey = readJSON "data/block_2a_coinbase_private_key.json"+block1ACoinbasePrivateKey = readJSON "../data/block_1a_coinbase_private_key.json"+block1BCoinbasePrivateKey = readJSON "../data/block_1b_coinbase_private_key.json"+block2ACoinbasePrivateKey = readJSON "../data/block_2a_coinbase_private_key.json"  -- Utils -----------------------------------------------------------------------------------------------------