F# - Basic Merkle Tree

Utils Code Snippet

// You can disable this warning by using '--mlcompatibility' or '--nowarn:62 #nowarn "62" module Util = open System let iso8601 : int -> int -> int -> string = fun y m d -> (new DateTime(y,m,d)).ToString("o") + "Z" let byteToHex : byte -> string = fun b -> b.ToString("x2") let bytesToHex : byte array -> string = fun bytes -> bytes |> Array.fold (fun a x -> a + (byteToHex x)) "" let utf8ToBytes : string -> byte array = fun utf8 -> System.Text.Encoding.UTF8.GetBytes utf8 let sha256' : byte array -> byte array = fun bytes -> use sha256 = System.Security.Cryptography.SHA256.Create() sha256.ComputeHash(buffer = bytes) (* mon@razerRamon:~$ echo -n 'foo' | sha256sum 2c26b46b68ffc68ff99b453c1d30413413422d706483bfa0f98a5e886266e7ae - *) let sha256 : string -> string = fun utf8 -> utf8 |> (utf8ToBytes >> sha256' >> bytesToHex) let ceilPow : uint64 -> uint64 = fun n -> let rec loop : (uint64 * int) -> uint64 = function | 0UL, acc -> 1 <<< acc |> uint64 | m , acc -> let m' = m &&& 1UL (m-m' >>> 1, acc+1) |> loop (n-1UL,0) |> loop

Utils Code output:

> module Util = begin val iso8601 : y:int -> m:int -> d:int -> string val byteToHex : b:byte -> string val bytesToHex : bytes:byte array -> string val utf8ToBytes : utf8:string -> byte array val sha256' : bytes:byte array -> byte array val sha256 : utf8:string -> string val ceilPow : n:uint64 -> uint64 end

JSON Code Snippet module Json = (* http://json.org/ *) type value = | String of string | Number of float | Object of (string * value) list | Array of value list | Boolean of bool | Null with override json.ToString() = let rec print : value -> string = function | String s -> sprintf "\"%s\"" s | Number n -> sprintf "%f" n | Object xs -> xs |> objectHelper | Array xs -> xs |> arrayHelper | Boolean b -> sprintf "%b" b | Null -> "null" and objectHelper : (string * value) list -> string = function | [] -> "{ }" | xs -> sprintf "{ %s }" (xs |> List.map (fun (name,value) -> sprintf "%s: %s" (String name |> print) (value |> print)) |> List.reduce (fun x y -> sprintf "%s, %s" x y)) and arrayHelper : value list -> string = function | [] -> "[ ]" | xs -> sprintf "[ %s ]" (xs |> List.map print |> List.reduce (fun x y -> sprintf "%s, %s" x y)) json |> print JSON Code output:

> module Json = begin type value = | String of string | Number of float | Object of (string * value) list | Array of value list | Boolean of bool | Null with override ToString : unit -> string end end

Merkle Code Snippet

module Merkle = open Util type hash = string type json = string type count = uint64 type tree = private | Leaf of json option | Branch of (hash * count) * tree * tree with override tree.ToString() = let rec print : (int * tree) -> string = function | i, Leaf None -> sprintf "\n%s NIL" (String.replicate i "\t") | i, Leaf (Some json) -> sprintf "\n%s json: %s" (String.replicate i "\t") json | i, Branch ((h,n),left,right) -> sprintf "\n%s * hash: %s" (String.replicate i "\t") h + sprintf "\n%s * count: %i" (String.replicate i "\t") n + sprintf "\n%s - left: %s" (String.replicate i "\t") ((i+2,left) |> print) + sprintf "\n%s - right: %s" (String.replicate i "\t") ((i+2,right) |> print) (0,tree) |> print module Tree = let nil : tree = Leaf None let init : json -> tree = fun msg -> let h = msg |> Util.sha256 Branch((h, 1UL), msg |> Some |> Leaf, nil) let insert : json -> tree -> tree = fun msg tree -> let helper : tree -> hash option = function | Leaf None -> None | Leaf (Some msg) -> msg |> Util.sha256 |> Some | Branch((h,n),_,_) -> h |> Some let rec loop : tree -> tree = function | Leaf None -> msg |> Some |> Leaf | Leaf (Some x) as l -> let h1 = x |> Util.sha256 let h2 = msg |> Util.sha256 let h = h1 + h2 |> Util.sha256 Branch((h,2UL), l, msg |> Some |> Leaf) | Branch((h,n),l,r) as b -> match n > 1UL && n = (n |> ceilPow) with | true -> let h' = h + (msg |> Util.sha256) |> Util.sha256 Branch((h',n+1UL), b, msg |> Some |> Leaf) | false -> let rt = r |> loop let lh = l |> helper let rh = rt |> helper let h' = (lh,rh) |> function | None , None -> h | Some v , None | None , Some v -> v | Some h1, Some h2 -> h1 + h2 |> Util.sha256 Branch((h',n+1UL), l, rt) tree |> loop

Merkle Code output:

> module Merkle = begin type hash = string type json = string type count = uint64 type tree = private | Leaf of json option | Branch of (hash * count) * tree * tree with override ToString : unit -> string end module Tree = begin val nil : tree = NIL val init : msg:json -> tree val insert : msg:json -> tree:tree -> tree end end

Example, see References:

+------------- 6 -------------+ | | +-------- 4 --------+ +-------- 2 --------+ | | | | +--- 2 ---+ +--- 2 ---+ 'e' 'f' | | | | 'a' 'b' 'c' 'd'

let a,b,c,d,e = Json.Object[ "name", Json.String "Bridge Cafe" "rating", Json.Number 4. "date", Util.iso8601 2014 02 20 |> Json.String ] , Json.Object[ "name", Json.String "Prima Doner" "rating", Json.Number 2. "date", Util.iso8601 2014 04 15 |> Json.String ] , Json.Object[ "name", Json.String "The Bull" "rating", Json.Number 3. "date", Util.iso8601 2014 06 05 |> Json.String ] , Json.Object[ "name", Json.String "The Tall Ship" "rating", Json.Number 5. "date", Util.iso8601 2014 10 30 |> Json.String ] , Json.Object[ "name", Json.String "Roy's Rolls" "rating", Json.Number 3. "date", Util.iso8601 2015 01 10 |> Json.String ] let f = Json.Object[ "name", Json.String "Prima Doner" "rating", Json.Number 4. "date", Util.iso8601 2015 02 12 |> Json.String ] let mtree = ( Merkle.Tree.init (a |> string), [b;c;d;e] ) ||> List.fold (fun a x -> a |> Merkle.Tree.insert (x |> string)) let mtree' = mtree |> Merkle.Tree.insert (f |> string) > val e : Json.value = Object [("name", String "Roy's Rolls"); ("rating", Number 3.0); ("date", String "2015-01-10T00:00:00.0000000Z")] val d : Json.value = Object [("name", String "The Tall Ship"); ("rating", Number 5.0); ("date", String "2014-10-30T00:00:00.0000000Z")] val c : Json.value = Object [("name", String "The Bull"); ("rating", Number 3.0); ("date", String "2014-06-05T00:00:00.0000000Z")] val b : Json.value = Object [("name", String "Prima Doner"); ("rating", Number 2.0); ("date", String "2014-04-15T00:00:00.0000000Z")] val a : Json.value = Object [("name", String "Bridge Cafe"); ("rating", Number 4.0); ("date", String "2014-02-20T00:00:00.0000000Z")] > val f : Json.value = Object [("name", String "Prima Doner"); ("rating", Number 4.0); ("date", String "2015-02-12T00:00:00.0000000Z")] > val mtree : Merkle.tree = * hash: dc999d3a9b252bebd171775e24668293e0ec1691f8d60331e85eed24ec6ca392 * count: 5 - left: * hash: 1ae6f3cb6407d42c9be994971b46de89b6b5facb53e7d1a01c04a92f74264483 * count: 4 - left: * hash: 28ee16e42affeecfc1b997487e4294f5067ced3bef2ca7c6324dcf86b7961954 * count: 2 - left: json: { "name": "Bridge Cafe", "rating": 4.000000, "date": "2014-02-20T00:00:00.0000000Z" } - right: json: { "name": "Prima Doner", "rating": 2.000000, "date": "2014-04-15T00:00:00.0000000Z" } - right: * hash: 255a0ad108003e34e449159a63306a292357fd0d40f6449f148467ec2532ed0c * count: 2 - left: json: { "name": "The Bull", "rating": 3.000000, "date": "2014-06-05T00:00:00.0000000Z" } - right: json: { "name": "The Tall Ship", "rating": 5.000000, "date": "2014-10-30T00:00:00.0000000Z" } - right: json: { "name": "Roy's Rolls", "rating": 3.000000, "date": "2015-01-10T00:00:00.0000000Z" } > val mtree' : Merkle.tree = * hash: fb8b96a10235da8cc444a0ddf41bdcfef035f743e84d69b15b146c1af48c6848 * count: 6 - left: * hash: 1ae6f3cb6407d42c9be994971b46de89b6b5facb53e7d1a01c04a92f74264483 * count: 4 - left: * hash: 28ee16e42affeecfc1b997487e4294f5067ced3bef2ca7c6324dcf86b7961954 * count: 2 - left: json: { "name": "Bridge Cafe", "rating": 4.000000, "date": "2014-02-20T00:00:00.0000000Z" } - right: json: { "name": "Prima Doner", "rating": 2.000000, "date": "2014-04-15T00:00:00.0000000Z" } - right: * hash: 255a0ad108003e34e449159a63306a292357fd0d40f6449f148467ec2532ed0c * count: 2 - left: json: { "name": "The Bull", "rating": 3.000000, "date": "2014-06-05T00:00:00.0000000Z" } - right: json: { "name": "The Tall Ship", "rating": 5.000000, "date": "2014-10-30T00:00:00.0000000Z" } - right: * hash: dae71b4d5d4f57af9abd8cbf2a621e6d1eb110bef0ed34d0a0356e5dc766eff7 * count: 2 - left: json: { "name": "Roy's Rolls", "rating": 3.000000, "date": "2015-01-10T00:00:00.0000000Z" } - right: json: { "name": "Prima Doner", "rating": 4.000000, "date": "2015-02-12T00:00:00.0000000Z" } UnitTest for SHA256

mon@razerRamon:~$ echo -n '{ "name": "Bridge Cafe", "rating": 4.000000, "date": "2014-02-20T00:00:00.0000000Z" }' | sha256sum b07cd889093179c2923fa8bfc480bfa153fe74c0b7009c46b33045d1e2d5632b - mon@razerRamon:~$ echo -n '{ "name": "Prima Doner", "rating": 2.000000, "date": "2014-04-15T00:00:00.0000000Z" }' | sha256sum 32128e3d309816c07db4ff4c995aa692c3390b48d23f6ac7429538b57dc2c372 - mon@razerRamon:~$ echo -n 'b07cd889093179c2923fa8bfc480bfa153fe74c0b7009c46b33045d1e2d5632b 32128e3d309816c07db4ff4c995aa692c3390b48d23f6ac7429538b57dc2c372' | sha256sum 28ee16e42affeecfc1b997487e4294f5067ced3bef2ca7c6324dcf86b7961954 -

let unitTest = let a' = a |> string |> Util.sha256 let b' = b |> string |> Util.sha256 "28ee16e42affeecfc1b997487e4294f5067ced3bef2ca7c6324dcf86b7961954" = ((a' + b') |> Util.sha256)

> val unitTest : bool = true

References: Technology at GDS’s Blog: Guaranteeing the integrity of a register