Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Implementation of a Bitcoin Merkle Tree
type 'a tree =
| Leaf
| Node of 'a * 'a tree * 'a tree
let node_of_tx tx = if String.length tx > 0 then Node (tx, Leaf, Leaf) else Leaf
let tree_of_txs txs =
let nodes = List.map node_of_tx txs in
match nodes with
| [] -> Leaf
| [x] -> x
| x::xs ->
let empty = Leaf
and levels =
match nodes with
| [] -> 0
| [x] -> 1
| x::xs -> (
if List.length nodes mod 2 = 0 then List.length nodes
else List.length nodes + 1 ) / 2 in
(** The meat of the function *)
let rec aux ?(tries=levels) ?(next=[]) tree' nodes' =
match nodes' with
(** This case should never be reached. *)
| [] -> Leaf
(** Either a Merkle Root or just another level about to end. *)
| [x] ->
(** Merkle root is reached. *)
if levels = 0 then x else
(** Widow node reached. *)
let Node (x_data, _, _) = x in
let parent_data = x_data ^ x_data in
let parent = Node (parent_data, x, x) in
aux ~tries:(levels-1) tree' (next @ [parent])
(** start of a level *)
| a :: b :: rest -> (
match a, b with
| Leaf, Leaf -> empty
| Node (a_data, _, _), Leaf ->
let parent_data = a_data ^ a_data in
let parent = Node (parent_data, a, a) in
if List.length rest = 0
then aux ~tries:(levels-1) tree' (next @ [parent])
else aux ~next:(next @ [parent]) tree' rest
| Leaf, Node (b_data, _, _) ->
let parent_data = b_data ^ b_data in
let parent = Node (parent_data, b, b) in
if List.length rest = 0
then aux ~tries:(levels-1) tree' (next @ [parent])
else aux ~next:(next @ [parent]) tree' rest
| Node (a_data, _, _), Node (b_data, _, _) ->
let parent_data = a_data ^ b_data in
let parent = Node (parent_data, a, b) in
if List.length rest = 0
then aux ~tries:(levels-1) tree' (next @ [parent])
else aux ~next:(next @ [parent]) tree' rest
)
in aux Leaf nodes
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.