{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Tahoe.CHK.Merkle (
MerkleTree (MerkleNode, MerkleLeaf),
Direction (..),
leaf,
leafNumberToNodeNumber,
breadthFirstList,
merklePathLengthForSize,
makeTree,
makeTreePartial,
merkleProof,
neededHashes,
firstLeafNum,
rootHash,
pairHash,
emptyLeafHash,
size,
height,
mapTree,
merklePath,
leafHashes,
treeFromRows,
buildTreeOutOfAllTheNodes,
) where
import Data.Binary (Binary (get, put))
import Data.Binary.Get (getRemainingLazyByteString)
import Data.Binary.Put (putByteString)
import Data.TreeDiff.Class (ToExpr)
import GHC.Generics (Generic)
import Data.List.HT (
padLeft,
)
import Data.Tuple.HT (
mapFst,
)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LBS
import Data.Text (
pack,
)
import qualified Data.Text as T
import Data.Text.Encoding (
encodeUtf8,
)
import Data.ByteString.Base32 (
encodeBase32Unpadded,
)
import Tahoe.CHK.Crypto (
taggedHash,
taggedPairHash,
)
import Crypto.Hash (HashAlgorithm (hashDigestSize))
import Crypto.Hash.Algorithms (SHA256 (SHA256))
import Tahoe.Util (
chunkedBy,
nextPowerOf,
toBinary,
)
data MerkleTree
= MerkleLeaf B.ByteString
| MerkleNode B.ByteString MerkleTree MerkleTree
deriving (MerkleTree -> MerkleTree -> Bool
(MerkleTree -> MerkleTree -> Bool)
-> (MerkleTree -> MerkleTree -> Bool) -> Eq MerkleTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MerkleTree -> MerkleTree -> Bool
$c/= :: MerkleTree -> MerkleTree -> Bool
== :: MerkleTree -> MerkleTree -> Bool
$c== :: MerkleTree -> MerkleTree -> Bool
Eq, Eq MerkleTree
Eq MerkleTree
-> (MerkleTree -> MerkleTree -> Ordering)
-> (MerkleTree -> MerkleTree -> Bool)
-> (MerkleTree -> MerkleTree -> Bool)
-> (MerkleTree -> MerkleTree -> Bool)
-> (MerkleTree -> MerkleTree -> Bool)
-> (MerkleTree -> MerkleTree -> MerkleTree)
-> (MerkleTree -> MerkleTree -> MerkleTree)
-> Ord MerkleTree
MerkleTree -> MerkleTree -> Bool
MerkleTree -> MerkleTree -> Ordering
MerkleTree -> MerkleTree -> MerkleTree
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MerkleTree -> MerkleTree -> MerkleTree
$cmin :: MerkleTree -> MerkleTree -> MerkleTree
max :: MerkleTree -> MerkleTree -> MerkleTree
$cmax :: MerkleTree -> MerkleTree -> MerkleTree
>= :: MerkleTree -> MerkleTree -> Bool
$c>= :: MerkleTree -> MerkleTree -> Bool
> :: MerkleTree -> MerkleTree -> Bool
$c> :: MerkleTree -> MerkleTree -> Bool
<= :: MerkleTree -> MerkleTree -> Bool
$c<= :: MerkleTree -> MerkleTree -> Bool
< :: MerkleTree -> MerkleTree -> Bool
$c< :: MerkleTree -> MerkleTree -> Bool
compare :: MerkleTree -> MerkleTree -> Ordering
$ccompare :: MerkleTree -> MerkleTree -> Ordering
$cp1Ord :: Eq MerkleTree
Ord, (forall x. MerkleTree -> Rep MerkleTree x)
-> (forall x. Rep MerkleTree x -> MerkleTree) -> Generic MerkleTree
forall x. Rep MerkleTree x -> MerkleTree
forall x. MerkleTree -> Rep MerkleTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MerkleTree x -> MerkleTree
$cfrom :: forall x. MerkleTree -> Rep MerkleTree x
Generic, [MerkleTree] -> Expr
MerkleTree -> Expr
(MerkleTree -> Expr) -> ([MerkleTree] -> Expr) -> ToExpr MerkleTree
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
listToExpr :: [MerkleTree] -> Expr
$clistToExpr :: [MerkleTree] -> Expr
toExpr :: MerkleTree -> Expr
$ctoExpr :: MerkleTree -> Expr
ToExpr)
leaf :: B.ByteString -> MerkleTree
leaf :: ByteString -> MerkleTree
leaf ByteString
bs
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = ByteString -> MerkleTree
MerkleLeaf ByteString
bs
| Bool
otherwise = [Char] -> MerkleTree
forall a. HasCallStack => [Char] -> a
error ([Char] -> MerkleTree) -> [Char] -> MerkleTree
forall a b. (a -> b) -> a -> b
$ [Char]
"Constructed MerkleLeaf with hash of length " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs)
size :: MerkleTree -> Int
size :: MerkleTree -> Int
size = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (MerkleTree -> [Int]) -> MerkleTree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MerkleTree -> Int) -> MerkleTree -> [Int]
forall a. (MerkleTree -> a) -> MerkleTree -> [a]
mapTree (Int -> MerkleTree -> Int
forall a b. a -> b -> a
const Int
1)
height :: MerkleTree -> Int
height :: MerkleTree -> Int
height (MerkleLeaf ByteString
_) = Int
1
height (MerkleNode ByteString
_ MerkleTree
left MerkleTree
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MerkleTree -> Int
height MerkleTree
left
mapTree :: (MerkleTree -> a) -> MerkleTree -> [a]
mapTree :: (MerkleTree -> a) -> MerkleTree -> [a]
mapTree MerkleTree -> a
f l :: MerkleTree
l@(MerkleLeaf ByteString
_) = [MerkleTree -> a
f MerkleTree
l]
mapTree MerkleTree -> a
f n :: MerkleTree
n@(MerkleNode ByteString
_ MerkleTree
left MerkleTree
right) = MerkleTree -> a
f MerkleTree
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (MerkleTree -> a) -> MerkleTree -> [a]
forall a. (MerkleTree -> a) -> MerkleTree -> [a]
mapTree MerkleTree -> a
f MerkleTree
left [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (MerkleTree -> a) -> MerkleTree -> [a]
forall a. (MerkleTree -> a) -> MerkleTree -> [a]
mapTree MerkleTree -> a
f MerkleTree
right
instance Show MerkleTree where
show :: MerkleTree -> [Char]
show (MerkleLeaf ByteString
value) =
Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"MerkleLeaf ", ByteString -> Text
encodeBase32Unpadded ByteString
value]
show (MerkleNode ByteString
value MerkleTree
left MerkleTree
right) =
Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat
[ Text
"MerkleNode " :: T.Text
, ByteString -> Text
encodeBase32Unpadded ByteString
value
, Text
" ("
, [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ MerkleTree -> [Char]
forall a. Show a => a -> [Char]
show MerkleTree
left
, Text
")"
, Text
" ("
, [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ MerkleTree -> [Char]
forall a. Show a => a -> [Char]
show MerkleTree
right
, Text
")"
]
emptyLeafHash :: Int -> B.ByteString
emptyLeafHash :: Int -> ByteString
emptyLeafHash = Int -> ByteString -> ByteString -> ByteString
taggedHash (SHA256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA256
SHA256) ByteString
"Merkle tree empty leaf" (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Int -> Text) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show
pairHash :: B.ByteString -> B.ByteString -> B.ByteString
pairHash :: ByteString -> ByteString -> ByteString
pairHash = Int -> ByteString -> ByteString -> ByteString -> ByteString
taggedPairHash (SHA256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA256
SHA256) ByteString
"Merkle tree internal node"
rootHash :: MerkleTree -> B.ByteString
rootHash :: MerkleTree -> ByteString
rootHash (MerkleLeaf ByteString
value) = ByteString
value
rootHash (MerkleNode ByteString
value MerkleTree
_ MerkleTree
_) = ByteString
value
makeTreePartial :: [B.ByteString] -> MerkleTree
makeTreePartial :: [ByteString] -> MerkleTree
makeTreePartial = Maybe MerkleTree -> MerkleTree
forall p. Maybe p -> p
unJust (Maybe MerkleTree -> MerkleTree)
-> ([ByteString] -> Maybe MerkleTree) -> [ByteString] -> MerkleTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Maybe MerkleTree
makeTree
where
unJust :: Maybe p -> p
unJust Maybe p
Nothing = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"Merkle.makeTreePartial failed to make a tree"
unJust (Just p
t) = p
t
makeTree :: [B.ByteString] -> Maybe MerkleTree
makeTree :: [ByteString] -> Maybe MerkleTree
makeTree [] = Maybe MerkleTree
forall a. Maybe a
Nothing
makeTree [ByteString]
leaves =
MerkleTree -> Maybe MerkleTree
forall a. a -> Maybe a
Just (MerkleTree -> Maybe MerkleTree) -> MerkleTree -> Maybe MerkleTree
forall a b. (a -> b) -> a -> b
$ [ByteString] -> MerkleTree
makeTree' ([ByteString] -> [ByteString]
pad [ByteString]
leaves)
where
pad :: [B.ByteString] -> [B.ByteString]
pad :: [ByteString] -> [ByteString]
pad [ByteString]
leaves' = [ByteString]
leaves' [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ Int -> [ByteString]
padding ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
leaves')
padding :: Int -> [B.ByteString]
padding :: Int -> [ByteString]
padding Int
numLeaves = Int -> ByteString
emptyLeafHash (Int -> ByteString) -> [Int] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
numLeaves .. Int -> Int -> Int
forall p. (Ord p, Num p) => p -> p -> p
nextPowerOf Int
2 Int
numLeaves Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
makeTree' :: [B.ByteString] -> MerkleTree
makeTree' :: [ByteString] -> MerkleTree
makeTree' [ByteString
x] = ByteString -> MerkleTree
leaf ByteString
x
makeTree' [ByteString]
xs =
MerkleTree -> MerkleTree -> MerkleTree
makeNode ([ByteString] -> MerkleTree
makeTree' [ByteString]
left) ([ByteString] -> MerkleTree
makeTree' [ByteString]
right)
where
([ByteString]
left, [ByteString]
right) = Int -> [ByteString] -> ([ByteString], [ByteString])
forall a. Int -> [a] -> ([a], [a])
splitAt ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [ByteString]
xs
makeNode :: MerkleTree -> MerkleTree -> MerkleTree
makeNode :: MerkleTree -> MerkleTree -> MerkleTree
makeNode MerkleTree
left MerkleTree
right =
ByteString -> MerkleTree -> MerkleTree -> MerkleTree
MerkleNode (ByteString -> ByteString -> ByteString
pairHash (MerkleTree -> ByteString
rootHash MerkleTree
left) (MerkleTree -> ByteString
rootHash MerkleTree
right)) MerkleTree
left MerkleTree
right
data Direction = TurnLeft | TurnRight deriving (Int -> Direction -> [Char] -> [Char]
[Direction] -> [Char] -> [Char]
Direction -> [Char]
(Int -> Direction -> [Char] -> [Char])
-> (Direction -> [Char])
-> ([Direction] -> [Char] -> [Char])
-> Show Direction
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Direction] -> [Char] -> [Char]
$cshowList :: [Direction] -> [Char] -> [Char]
show :: Direction -> [Char]
$cshow :: Direction -> [Char]
showsPrec :: Int -> Direction -> [Char] -> [Char]
$cshowsPrec :: Int -> Direction -> [Char] -> [Char]
Show, Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq)
merkleProof :: MerkleTree -> Int -> Maybe [(Int, B.ByteString)]
merkleProof :: MerkleTree -> Int -> Maybe [(Int, ByteString)]
merkleProof MerkleTree
tree Int
targetLeaf = Int -> MerkleTree -> [Direction] -> Maybe [(Int, ByteString)]
merkleProof' Int
1 MerkleTree
tree ([Direction] -> Maybe [(Int, ByteString)])
-> [Direction] -> Maybe [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Direction]
merklePath (MerkleTree -> Int
height MerkleTree
tree) Int
targetLeaf
merklePath :: Int -> Int -> [Direction]
merklePath :: Int -> Int -> [Direction]
merklePath Int
height' Int
leafNum = Direction -> Int -> [Direction] -> [Direction]
forall a. a -> Int -> [a] -> [a]
padLeft Direction
TurnLeft (Int
height' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Direction -> Direction -> Int -> [Direction]
forall a. a -> a -> Int -> [a]
toBinary Direction
TurnLeft Direction
TurnRight Int
leafNum)
merklePathLengthForSize :: Int -> Int
merklePathLengthForSize :: Int -> Int
merklePathLengthForSize Int
size' = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
2 :: Double) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall p. (Ord p, Num p) => p -> p -> p
nextPowerOf Int
2 Int
size'
breadthFirstList :: MerkleTree -> [B.ByteString]
breadthFirstList :: MerkleTree -> [ByteString]
breadthFirstList MerkleTree
tree = [MerkleTree] -> [ByteString]
traverse' [MerkleTree
tree]
where
traverse' :: [MerkleTree] -> [B.ByteString]
traverse' :: [MerkleTree] -> [ByteString]
traverse' [] = []
traverse' [MerkleTree]
trees =
[MerkleTree -> ByteString
rootHash MerkleTree
tree' | MerkleTree
tree' <- [MerkleTree]
trees] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [MerkleTree] -> [ByteString]
traverse' ([[MerkleTree]] -> [MerkleTree]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [MerkleTree -> [MerkleTree]
children MerkleTree
tree'' | MerkleTree
tree'' <- [MerkleTree]
trees])
children :: MerkleTree -> [MerkleTree]
children (MerkleLeaf ByteString
_) = []
children (MerkleNode ByteString
_ MerkleTree
left MerkleTree
right) = [MerkleTree
left, MerkleTree
right]
merkleProof' :: Int -> MerkleTree -> [Direction] -> Maybe [(Int, B.ByteString)]
merkleProof' :: Int -> MerkleTree -> [Direction] -> Maybe [(Int, ByteString)]
merkleProof' Int
_ MerkleTree
_ [] = [(Int, ByteString)] -> Maybe [(Int, ByteString)]
forall a. a -> Maybe a
Just []
merkleProof' Int
thisNodeNum (MerkleNode ByteString
_ MerkleTree
left MerkleTree
right) (Direction
d : [Direction]
ds) =
case Direction
d of
Direction
TurnLeft ->
((Int
rightChildNum, MerkleTree -> ByteString
rootHash MerkleTree
right) (Int, ByteString) -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. a -> [a] -> [a]
:) ([(Int, ByteString)] -> [(Int, ByteString)])
-> Maybe [(Int, ByteString)] -> Maybe [(Int, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MerkleTree -> [Direction] -> Maybe [(Int, ByteString)]
merkleProof' Int
leftChildNum MerkleTree
left [Direction]
ds
Direction
TurnRight ->
((Int
leftChildNum, MerkleTree -> ByteString
rootHash MerkleTree
left) (Int, ByteString) -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. a -> [a] -> [a]
:) ([(Int, ByteString)] -> [(Int, ByteString)])
-> Maybe [(Int, ByteString)] -> Maybe [(Int, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MerkleTree -> [Direction] -> Maybe [(Int, ByteString)]
merkleProof' Int
rightChildNum MerkleTree
right [Direction]
ds
where
leftChildNum :: Int
leftChildNum = Int
thisNodeNum Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
rightChildNum :: Int
rightChildNum = Int
thisNodeNum Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
merkleProof' Int
_ (MerkleLeaf ByteString
_) [Direction]
ds = [Char] -> Maybe [(Int, ByteString)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe [(Int, ByteString)])
-> [Char] -> Maybe [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ [Direction] -> [Char]
forall a. Show a => a -> [Char]
show [Direction]
ds
leafNumberToNodeNumber :: MerkleTree -> Int -> Int
leafNumberToNodeNumber :: MerkleTree -> Int -> Int
leafNumberToNodeNumber MerkleTree
tree Int
leafNum = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leafNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MerkleTree -> Int
firstLeafNum MerkleTree
tree
neededHashes :: MerkleTree -> Int -> Maybe [(Int, B.ByteString)]
neededHashes :: MerkleTree -> Int -> Maybe [(Int, ByteString)]
neededHashes MerkleTree
tree = ([(Int, ByteString)] -> [(Int, ByteString)])
-> Maybe [(Int, ByteString)] -> Maybe [(Int, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, ByteString) -> (Int, ByteString))
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, ByteString) -> (Int, ByteString))
-> [(Int, ByteString)] -> [(Int, ByteString)])
-> ((Int, ByteString) -> (Int, ByteString))
-> [(Int, ByteString)]
-> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> (Int, ByteString) -> (Int, ByteString)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)) (Maybe [(Int, ByteString)] -> Maybe [(Int, ByteString)])
-> (Int -> Maybe [(Int, ByteString)])
-> Int
-> Maybe [(Int, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MerkleTree -> Int -> Maybe [(Int, ByteString)]
merkleProof MerkleTree
tree
firstLeafNum :: MerkleTree -> Int
firstLeafNum :: MerkleTree -> Int
firstLeafNum MerkleTree
tree = MerkleTree -> Int
size MerkleTree
tree Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
instance Binary MerkleTree where
put :: MerkleTree -> Put
put = ByteString -> Put
putByteString (ByteString -> Put)
-> (MerkleTree -> ByteString) -> MerkleTree -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (MerkleTree -> [ByteString]) -> MerkleTree -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MerkleTree -> [ByteString]
breadthFirstList
get :: Get MerkleTree
get =
Get ByteString
getRemainingLazyByteString
Get ByteString -> (ByteString -> Get MerkleTree) -> Get MerkleTree
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get MerkleTree
-> (MerkleTree -> Get MerkleTree)
-> Maybe MerkleTree
-> Get MerkleTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Get MerkleTree
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"could not construct MerkleTree") MerkleTree -> Get MerkleTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe MerkleTree -> Get MerkleTree)
-> (ByteString -> Maybe MerkleTree) -> ByteString -> Get MerkleTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Maybe MerkleTree
buildTreeOutOfAllTheNodes
([ByteString] -> Maybe MerkleTree)
-> (ByteString -> [ByteString]) -> ByteString -> Maybe MerkleTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> [ByteString]
chunkedBy (SHA256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA256
SHA256)
(ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict
leafHashes :: MerkleTree -> [B.ByteString]
leafHashes :: MerkleTree -> [ByteString]
leafHashes (MerkleLeaf ByteString
h) = [ByteString
h]
leafHashes (MerkleNode ByteString
_ MerkleTree
l MerkleTree
r) = MerkleTree -> [ByteString]
leafHashes MerkleTree
l [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> MerkleTree -> [ByteString]
leafHashes MerkleTree
r
buildTreeOutOfAllTheNodes :: [B.ByteString] -> Maybe MerkleTree
buildTreeOutOfAllTheNodes :: [ByteString] -> Maybe MerkleTree
buildTreeOutOfAllTheNodes [ByteString]
nodes
| [ByteString] -> Bool
forall a. [a] -> Bool
validMerkleSize [ByteString]
nodes = MerkleTree -> Maybe MerkleTree
forall a. a -> Maybe a
Just ([MerkleTree] -> MerkleTree
forall a. [a] -> a
head ([MerkleTree] -> [[ByteString]] -> [MerkleTree]
treeFromRows [] ([Int] -> [ByteString] -> [[ByteString]]
clumpRows [Int]
powersOfTwo [ByteString]
nodes)))
| Bool
otherwise = Maybe MerkleTree
forall a. Maybe a
Nothing
powersOfTwo :: [Int]
powersOfTwo :: [Int]
powersOfTwo = (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 :: Int .. Int
62]
validMerkleSize :: [a] -> Bool
validMerkleSize :: [a] -> Bool
validMerkleSize [a]
nodes =
[Int] -> Int
forall a. [a] -> a
head ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size') ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
powersOfTwo)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size'
where
size' :: Int
size' = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
nodes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
clumpRows ::
[Int] ->
[B.ByteString] ->
[[B.ByteString]]
clumpRows :: [Int] -> [ByteString] -> [[ByteString]]
clumpRows [Int]
_ [] = []
clumpRows [] [ByteString]
_ = [Char] -> [[ByteString]]
forall a. HasCallStack => [Char] -> a
error [Char]
"Ran out of clump lengths (too many nodes!)"
clumpRows (Int
p : [Int]
ps) [ByteString]
rows = [Int] -> [ByteString] -> [[ByteString]]
clumpRows [Int]
ps (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
p [ByteString]
rows) [[ByteString]] -> [[ByteString]] -> [[ByteString]]
forall a. [a] -> [a] -> [a]
++ [Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
p [ByteString]
rows]
treeFromRows ::
[MerkleTree] ->
[[B.ByteString]] ->
[MerkleTree]
treeFromRows :: [MerkleTree] -> [[ByteString]] -> [MerkleTree]
treeFromRows [] ([ByteString]
children : [[ByteString]]
rest) = [MerkleTree] -> [[ByteString]] -> [MerkleTree]
treeFromRows (ByteString -> MerkleTree
MerkleLeaf (ByteString -> MerkleTree) -> [ByteString] -> [MerkleTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
children) [[ByteString]]
rest
treeFromRows [MerkleTree]
children [] = [MerkleTree]
children
treeFromRows [MerkleTree
left, MerkleTree
right] [[ByteString
root]] = [ByteString -> MerkleTree -> MerkleTree -> MerkleTree
MerkleNode ByteString
root MerkleTree
left MerkleTree
right]
treeFromRows (MerkleTree
left : MerkleTree
right : [MerkleTree]
children) ([ByteString]
row : [[ByteString]]
rest) = [MerkleTree] -> [[ByteString]] -> [MerkleTree]
treeFromRows ([MerkleTree] -> [ByteString] -> [MerkleTree]
mTree (MerkleTree
left MerkleTree -> [MerkleTree] -> [MerkleTree]
forall a. a -> [a] -> [a]
: MerkleTree
right MerkleTree -> [MerkleTree] -> [MerkleTree]
forall a. a -> [a] -> [a]
: [MerkleTree]
children) [ByteString]
row) [[ByteString]]
rest
treeFromRows [MerkleTree]
x [[ByteString]]
y = [Char] -> [MerkleTree]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [MerkleTree]) -> [Char] -> [MerkleTree]
forall a b. (a -> b) -> a -> b
$ [Char]
"treeFromRows not sure what to do with " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [MerkleTree] -> [Char]
forall a. Show a => a -> [Char]
show [MerkleTree]
x [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[ByteString]] -> [Char]
forall a. Show a => a -> [Char]
show [[ByteString]]
y
mTree :: [MerkleTree] -> [B.ByteString] -> [MerkleTree]
mTree :: [MerkleTree] -> [ByteString] -> [MerkleTree]
mTree [MerkleTree
left, MerkleTree
right] [ByteString
head'] = [ByteString -> MerkleTree -> MerkleTree -> MerkleTree
MerkleNode ByteString
head' MerkleTree
left MerkleTree
right]
mTree (MerkleTree
left : MerkleTree
right : [MerkleTree]
more) [ByteString]
row = ByteString -> MerkleTree -> MerkleTree -> MerkleTree
MerkleNode ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
row) MerkleTree
left MerkleTree
right MerkleTree -> [MerkleTree] -> [MerkleTree]
forall a. a -> [a] -> [a]
: [MerkleTree] -> [ByteString] -> [MerkleTree]
mTree [MerkleTree]
more ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
row)
mTree [MerkleTree]
x [ByteString]
y = [Char] -> [MerkleTree]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [MerkleTree]) -> [Char] -> [MerkleTree]
forall a b. (a -> b) -> a -> b
$ [Char]
"mTree not sure what to do with " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [MerkleTree] -> [Char]
forall a. Show a => a -> [Char]
show [MerkleTree]
x [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> [Char]
forall a. Show a => a -> [Char]
show [ByteString]
y