packages feed

merkle-tree (empty) → 0.1.0

raw patch · 5 files changed

+457/−0 lines, 5 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, cereal, cryptonite, memory, merkle-tree, protolude, random, tasty, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Adjoint Inc.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,89 @@+<p align="center">+  <a href="http://www.adjoint.io"><img src="https://www.adjoint.io/images/logo-small.png" width="250"/></a>+</p>++merkle-tree+===========++This library implements a merkle-tree data structure, for representing a list of+hashed data as a binary tree of pairs of hashes converging to a single hash, the+`merkle root`. `SHA3_256` is used as the hashing algorithm.++# Description++A Merkle tree is a tamper-resistant data structure that allows a large amount of+data to be compressed into a single hash and can be queried for the presence+of specific elements in the data with a proof constructed in logarithmic space.++## Construction++A Merkle tree is a binary tree of hashes, in which all the leaf nodes are the+individual data elements in the block. To construct a merkle tree, the initial+data elements are first hashed using the merkle tree hash function to generate +the leaf nodes of the tree. The resulting hashed data are subsequently hashed +together in pairs to create the parent nodes of the leaf nodes. This process +continues until it results in a single hash known as the merkle root.++```haskell+-- | Constructs a Merkle Tree from a list of ByteStrings+mkMerkleTree :: [ByteString] -> MerkleTree ByteString++-- | Generates the hash of a piece of data existing as a leaf node in the Tree+mkLeafRootHash :: ByteString -> MerkleRoot ByteString+```++## Merkle Inclusion Proof++Perhaps the most important reason to use a merkle tree to represent the block+data is the ability to construct a merkle proof (`O(n)`) that verifies+the inclusion of a transaction *t* in a specific block *b* (`O(log(n))`).++Merkle proofs are an important part in creating decentralized block chain+networks as nodes or client programs (aka "light-weight nodes") that do not +store blocks in memory or on disk regularly need to *verify* that a +transaction has been included on the chain or not. This can be accomplished +by the lightweight node supplying the transaction hash and a block index,+querying a full node for a merkle inclusion proof of the transaction's inclusion+in the block with the index supplied. If the full node finds the transaction in+that block and responds with the inclusion proof and the block's merkle root.+With this information, it takes `O(log(n))` for the lightweight node to validate+the inclusion proof.++```haskell+-- | Constructs a Merkle Inclusion Proof +merkleProof +  :: MerkleTree a   -- ^ Tree to which data may belong +  -> MerkleRoot a   -- ^ Leaf root hash, data to query inclusion of +  -> MerkleProof a  -- ^ A list of hashes to verify data inclusion ++-- | Validates a Merkle Inclusion Proof+validateMerkleProof + :: MerkleProof a  -- ^ Inclusion proof constructed by the prover  + -> MerkleRoot a   -- ^ Root of the merkle tree from which the proof was constructed+ -> MerkleRoot a   -- ^ Leaf root hash for which the proof was constructed + -> Bool           -- ^ Leaf root inclusion+```++# Example++```haskell+import Crypto.Hash.MerkleTree++example :: Bool+example = +    -- Does the proof prove that `mleaf` exists in `mtree`? +    validateMerkleProof proof (mtRoot mtree) mleaf +  where+    -- Build a merkle tree from a list of data+    mtree = mkMerkleTree ["tx1", "tx2", "tx3"] +    -- Construct merkle proof that a leaf exists in `merkleTree`+    mleaf = mkLeafRootHash "tx2"+    proof = merkleProof mtree mleaf+```++License+-------++Copyright 2017 Adjoint Inc++Released under Apache 2.0.
+ merkle-tree.cabal view
@@ -0,0 +1,62 @@+-- This file has been generated from package.yaml by hpack version 0.19.3.+--+-- see: https://github.com/sol/hpack++name:                merkle-tree+version:             0.1.0+synopsis:            An implementation of a Merkle Tree and merkle tree proofs+homepage:            https://github.com/adjoint-io/merkle-tree#readme+bug-reports:         https://github.com/adjoint-io/merkle-tree/issues+license:             Apache+license-file:        LICENSE+maintainer:          Adjoint Inc. (info@adjoint.io)+category:            Development+build-type:          Simple+cabal-version:       >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/adjoint-io/merkle-tree++library+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings NoImplicitPrelude FlexibleInstances+  ghc-options: -fwarn-tabs -fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-redundant-constraints -fwarn-implicit-prelude -fwarn-overflowed-literals -fwarn-orphans -fwarn-identities -fwarn-dodgy-exports -fwarn-dodgy-imports -fwarn-duplicate-exports -fwarn-overlapping-patterns -fwarn-missing-fields -fwarn-missing-methods -fwarn-missing-signatures -fwarn-noncanonical-monad-instances -fwarn-unused-pattern-binds -fwarn-unused-type-patterns -fwarn-unrecognised-pragmas -fwarn-wrong-do-bind -fwarn-hi-shadowing -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-unused-do-bind+  exposed-modules:+      Crypto.Hash.MerkleTree+  other-modules:+      Paths_merkle_tree+  build-depends:+      base >=4.7 && <5+    , bytestring+    , cereal+    , cryptonite >=0.21+    , memory+    , protolude >=0.2+    , random+  default-language: Haskell2010++test-suite merkle-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , bytestring+    , cereal+    , cryptonite >=0.21+    , memory+    , merkle-tree+    , protolude >=0.2+    , random+    , tasty+    , tasty-quickcheck+  other-modules:+      Paths_merkle_tree+  default-language: Haskell2010
+ src/Crypto/Hash/MerkleTree.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE StrictData #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Crypto.Hash.MerkleTree (+  MerkleTree(..),+  MerkleRoot(..),+  MerkleNode(..),++  -- ** Constructors+  mkMerkleTree,+  mkRootHash,+  mkLeafRootHash,+  emptyHash,++  -- ** Merkle Proof+  MerkleProof(..),+  merkleProof,+  validateMerkleProof,++  -- ** Size+  mtRoot,+  mtSize,+  mtHash,+  mtHeight,++  -- ** Testing+  testMerkleProofN,+) where++import Protolude hiding (hash)++import Crypto.Hash (Digest, SHA3_256(..), hash)++import qualified Data.List as List+import qualified Data.Serialize as S+import qualified Data.ByteArray as B+import qualified Data.ByteArray.Encoding as B+import qualified Data.ByteString as BS++import System.Random (randomRIO)++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++-- | A merkle tree root.+newtype MerkleRoot a = MerkleRoot+  { getMerkleRoot :: ByteString+  } deriving (Show, Eq, Ord,  Generic, S.Serialize)++instance B.ByteArrayAccess (MerkleRoot a) where+  length (MerkleRoot bs) = B.length bs+  withByteArray (MerkleRoot bs) f = B.withByteArray bs f++-- | A merkle tree.+data MerkleTree a+  = MerkleEmpty+  | MerkleTree Word32 (MerkleNode a)+  deriving (Show, Eq, Generic, S.Serialize)++data MerkleNode a+  = MerkleBranch {+      mRoot  :: MerkleRoot a+    , mLeft  :: MerkleNode a+    , mRight :: MerkleNode a+  }+  | MerkleLeaf {+      mRoot :: MerkleRoot a+    , mVal  :: a+  }+  deriving (Eq, Show, Generic, S.Serialize)++instance Foldable MerkleTree where+  foldMap _ MerkleEmpty      = mempty+  foldMap f (MerkleTree _ n) = foldMap f n++  null MerkleEmpty = True+  null _           = False++  length MerkleEmpty      = 0+  length (MerkleTree s _) = fromIntegral s++instance Foldable MerkleNode where+  foldMap f x = case x of+    MerkleLeaf{mVal}            -> f mVal+    MerkleBranch{mLeft, mRight} ->+      foldMap f mLeft `mappend` foldMap f mRight++-- | Returns root of merkle tree.+mtRoot :: MerkleTree a -> MerkleRoot a+mtRoot MerkleEmpty      = emptyHash+mtRoot (MerkleTree _ x) = mRoot x++-- | Returns root of merkle tree root hashed.+mtHash :: MerkleTree a -> ByteString+mtHash MerkleEmpty      = merkleHash ""+mtHash (MerkleTree _ x) = B.convert (mRoot x)++mtSize :: MerkleTree a -> Word32+mtSize MerkleEmpty      = 0+mtSize (MerkleTree s _) = s++emptyHash :: MerkleRoot a+emptyHash = MerkleRoot (merkleHash mempty)++-- | Merkle tree height+mtHeight :: Int -> Int+mtHeight ntx+  | ntx < 2 = 0+  | even ntx  = 1 + mtHeight (ntx `div` 2)+  | otherwise = mtHeight $ ntx + 1++-- | Merkle tree width+mtWidth+  :: Int -- ^ Number of transactions (leaf nodes).+  -> Int -- ^ Height at which we want to compute the width.+  -> Int -- ^ Width of the merkle tree.+mtWidth ntx h = (ntx + (1 `shiftL` h) - 1) `shiftR` h++-- | Return the largest power of two such that it's smaller than n.+powerOfTwo :: (Bits a, Num a) => a -> a+powerOfTwo n+   | n .&. (n - 1) == 0 = n `shiftR` 1+   | otherwise = go n+ where+    go w = if w .&. (w - 1) == 0 then w else go (w .&. (w - 1))++-------------------------------------------------------------------------------+-- Constructors+-------------------------------------------------------------------------------++mkLeaf :: ByteString -> MerkleNode ByteString+mkLeaf a =+  MerkleLeaf+  { mVal  = a+  , mRoot = mkLeafRootHash a+  }++mkLeafRootHash :: B.ByteArrayAccess a => a -> MerkleRoot a+mkLeafRootHash a = MerkleRoot $ merkleHash (BS.singleton 0 <> B.convert a)++mkBranch :: MerkleNode a -> MerkleNode a -> MerkleNode a+mkBranch a b =+  MerkleBranch+  { mLeft  = a+  , mRight = b+  , mRoot  = mkRootHash (mRoot a) (mRoot b)+  }++mkRootHash :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a+mkRootHash (MerkleRoot l) (MerkleRoot r) = MerkleRoot $ merkleHash $ mconcat+  [ BS.singleton 1, B.convert l, B.convert r ]++-- | Smart constructor for 'MerkleTree'.+mkMerkleTree :: [ByteString] -> MerkleTree ByteString+mkMerkleTree [] = MerkleEmpty+mkMerkleTree ls = MerkleTree (fromIntegral lsLen) (go lsLen ls)+  where+    lsLen = length ls+    go _  [x] = mkLeaf x+    go len xs = mkBranch (go i l) (go (len - i) r)+      where+        i = powerOfTwo len+        (l, r) = splitAt i xs++-------------------------------------------------------------------------------+-- Merkle Proofs+-------------------------------------------------------------------------------++newtype MerkleProof a = MerkleProof { getMerkleProof :: [ProofElem a] }+  deriving (Show, Eq, Ord, Generic, S.Serialize)++data ProofElem a = ProofElem+  { nodeRoot    :: MerkleRoot a+  , siblingRoot :: MerkleRoot a+  , nodeSide    :: Side+  } deriving (Show, Eq, Ord, Generic, S.Serialize)++data Side = L | R+  deriving (Show, Eq, Ord, Generic, S.Serialize)++-- | Construct a merkle tree proof of inclusion+-- Walks the entire tree recursively, building a list of "proof elements"+-- that are comprised of the current node's root and it's sibling's root,+-- and whether it is the left or right sibling (this is necessary to determine+-- the order in which to hash each proof element root and it's sibling root).+-- The list is ordered such that the for each element, the next element in+-- the list is the proof element corresponding to the node's parent node.+merkleProof :: forall a. MerkleTree a -> MerkleRoot a -> MerkleProof a+merkleProof MerkleEmpty _ = MerkleProof []+merkleProof (MerkleTree _ rootNode) leafRoot = MerkleProof $ constructPath [] rootNode+  where+    constructPath :: [ProofElem a] -> MerkleNode a -> [ProofElem a]+    constructPath pElems (MerkleLeaf leafRoot' _)+      | leafRoot == leafRoot' = pElems+      | otherwise             = []+    constructPath pElems (MerkleBranch bRoot ln rn) = lPath ++ rPath+      where+        lProofElem = ProofElem (mRoot ln) (mRoot rn) L+        rProofElem = ProofElem (mRoot rn) (mRoot ln) R++        lPath = constructPath (lProofElem:pElems) ln+        rPath = constructPath (rProofElem:pElems) rn++-- | Validate a merkle tree proof of inclusion+validateMerkleProof :: forall a. MerkleProof a ->  MerkleRoot a -> MerkleRoot a -> Bool+validateMerkleProof (MerkleProof proofElems) treeRoot leafRoot =+    validate proofElems leafRoot+  where+    validate :: [ProofElem a] -> MerkleRoot a -> Bool+    validate [] proofRoot = proofRoot == treeRoot+    validate (pElem:pElems) proofRoot+      | proofRoot /= nodeRoot pElem = False+      | otherwise = validate pElems $ hashProofElem pElem++    hashProofElem :: ProofElem a -> MerkleRoot a+    hashProofElem (ProofElem pRoot sibRoot side) =+      case side of+        L -> mkRootHash pRoot sibRoot+        R -> mkRootHash sibRoot pRoot++-------------------------------------------------------------------------------+-- Hashing+-------------------------------------------------------------------------------++-- | Compute SHA-256 hash of a bytestring.+-- Maximum input size is (2^{64}-1)/8 bytes.+--+-- > Output size         : 256+-- > Internal state size : 1600+-- > Block size          : 1088+-- > Length size         : n/a+-- > Word size           : 64+-- > Rounds              : 24+sha256 :: ByteString -> ByteString+sha256 x = B.convertToBase B.Base16 (hash x :: Digest SHA3_256)++-- | Hash function to use for merkle tree+merkleHash :: ByteString -> ByteString+merkleHash = sha256++-------------------------------------------------------------------------------+-- Testing+-------------------------------------------------------------------------------++-- | Constructs a merkle tree and random leaf root to test inclusion of+testMerkleProofN :: Int -> IO Bool+testMerkleProofN n+  | n < 2 = panic "Cannot construct a merkle tree with < 2 nodes"+  | otherwise = do+      randN <- randomRIO (1,n) :: IO Int+      let mtree = mkMerkleTree $ map show [1..n]+          randLeaf = mkLeafRootHash $ show randN+          proof = merkleProof mtree randLeaf+      return $ validateMerkleProof proof (mtRoot mtree) randLeaf
+ test/Main.hs view
@@ -0,0 +1,26 @@+module Main where++import Protolude++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck.Monadic++import qualified Data.ByteString as BS++import Crypto.Hash.MerkleTree++newtype MerkleTest = MerkleTest Int+  deriving (Show)++instance Arbitrary MerkleTest where+  arbitrary = MerkleTest <$> choose (100,10000)++main :: IO ()+main = defaultMain merkleTests++merkleTests :: TestTree+merkleTests = testGroup "Merkle Tree & Proof tests"+  [ testProperty "Random Tree/Proof construction and validation:" $ \(MerkleTest n) ->+      monadicIO $ assert =<< liftIO (testMerkleProofN n)+  ]