Last active
July 1, 2022 10:18
-
-
Save yoshihiro503/99540c6fcdb26b45eab0ee7f0e8e4c3b to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open SCaml | |
| let empty_bytes = Bytes "0x" | |
| let is_empty_bytes b = (Bytes.length b = Nat 0) | |
| let bytes_concat sep ss = | |
| match ss with | |
| | [] -> empty_bytes | |
| | s0 :: ss -> | |
| List.fold_left' (fun (acc, s) -> Bytes.concat (Bytes.concat acc sep) s) s0 ss | |
| type encoded_segment = bytes | |
| let encode_segment (seg : encoded_segment) : bytes = seg | |
| module Hash = struct | |
| type prefix = bytes | |
| let prefix_to_bytes p : bytes = p | |
| type t = (prefix * bytes) | |
| let of_prefix p : t = (p, empty_bytes) | |
| let zero : t = of_prefix (Bytes "0x00000000000000000000000000000000") | |
| let of_bytes b : prefix = Crypto.blake2b b | |
| let of_list ss : prefix = of_bytes (bytes_concat empty_bytes ss) | |
| let to_bytes_list : t -> bytes list = function | |
| | (p, b) when is_empty_bytes b -> [prefix_to_bytes p] | |
| | (p, b) -> [prefix_to_bytes p; b] | |
| let combine_flags (p: prefix) (flags:nat) : prefix = | |
| p | |
| let to_prefix : t -> prefix = fst | |
| let make prefix b : t = (prefix, b) | |
| (* let to_string ((prefix, b): t) =*) | |
| (* Bytes.to_string prefix ^ "-" ^ Bytes.to_string b*) | |
| end | |
| type hash = Hash.t | |
| let hash_of_bud : hash option -> hash = function | |
| | None -> Hash.zero | |
| | Some h -> | |
| let p = Hash.of_list (Hash.to_bytes_list h) in | |
| let p = Hash.combine_flags p (Nat 0b11) in | |
| Hash.of_prefix p | |
| let hash_of_leaf (v: bytes) : hash = | |
| Hash.of_prefix (Hash.of_bytes v) | |
| let hash_of_internal (h1: hash) (h2 : hash) = | |
| let p = Hash.of_list [Hash.to_prefix h1; Hash.to_prefix h2] in | |
| Hash.of_prefix p | |
| let hash_of_extender (seg: encoded_segment) (h : hash) = | |
| Hash.make (Hash.to_prefix h) (encode_segment seg) | |
| type node_key = nat | |
| type node_ref = | |
| | Hash of hash | |
| | Bud of node_key option | |
| | Leaf of bytes | |
| | Internal of node_key * node_key | |
| | Extender of encoded_segment * node_key | |
| type node = {root_key : node_key; elems: (node_key * node_ref) list} | |
| type hash_cache = (node_key, hash) Map.t | |
| let compute_hash node = | |
| let hashes = List.fold_left' | |
| (fun (cache, (node_key, node_ref)) -> | |
| let h = | |
| match node_ref with | |
| | Hash h -> Some h | |
| | Bud None -> | |
| Some (hash_of_bud None) | |
| | Bud (Some n) -> | |
| begin match Map.get n cache with | |
| | None -> None | |
| | Some h -> Some (hash_of_bud (Some h)) | |
| end | |
| | Leaf v -> Some (hash_of_leaf v) | |
| | Internal (l, r) -> | |
| begin match Map.get l cache, Map.get r cache with | |
| | Some h1, Some h2 -> | |
| Some (hash_of_internal h1 h2) | |
| | _, _ -> None | |
| end | |
| | Extender (seg, n) -> | |
| begin match Map.get n cache with | |
| | None -> None | |
| | Some h -> | |
| Some (hash_of_extender seg h) | |
| end | |
| in | |
| match h with | |
| | None -> | |
| failwith "compute_hash" | |
| | Some h -> | |
| Map.update node_key (Some h) cache) | |
| Map.empty | |
| node.elems | |
| in | |
| Map.get node.root_key hashes | |
| type proof = node | |
| type storage = NoStorage | |
| type segment_elem = L | R | Seg of encoded_segment | |
| type segment = segment_elem list | |
| type path = segment list | |
| let find_child node_map segment node_key = | |
| let f = function | |
| | (None, _) -> None | |
| | (Some (Internal (l, _)), L) -> | |
| Map.get l node_map | |
| | (Some (Internal (_, r)), R) -> | |
| Map.get r node_map | |
| | (Some (Extender (eseg, n)), Seg s) when (eseg = s) -> | |
| Map.get n node_map | |
| | (Some _, _) -> None | |
| in | |
| let top = Map.get node_key node_map in | |
| List.fold_left' f top segment | |
| let map_of_assoc (list : (node_key * node_ref) list) = | |
| List.fold_left' (fun (map, (key,value)) -> Map.update key (Some value) map) Map.empty list | |
| let find path proof = | |
| let node_map = map_of_assoc proof.elems in | |
| let root = Map.get proof.root_key node_map in | |
| let leaf_opt = | |
| List.fold_left' (function | |
| | (None, _) -> None | |
| | (Some (Bud (Some n)), segment) -> | |
| find_child node_map segment n | |
| | (Some _, _) -> None) | |
| root | |
| path | |
| in | |
| match leaf_opt with | |
| | None -> None | |
| | Some (Leaf v) -> Some v | |
| | Some _ -> None | |
| type param = { | |
| proof: proof; | |
| expected_root_hash : hash; | |
| data: (path * bytes) list; | |
| } | |
| let is_proof_valid expected_root_hash proof = | |
| match compute_hash proof with | |
| | Some h -> | |
| (expected_root_hash = h) | |
| | None -> | |
| false | |
| let check_data proof data = | |
| let check proof (path, v_expected) = | |
| match find path proof with | |
| | None -> false | |
| | Some v -> v_expected = v | |
| in | |
| List.fold_left' (fun (acc, path) -> acc && check proof path) true data | |
| let [@entry] verify param NoStorage = | |
| if is_proof_valid param.expected_root_hash param.proof = false then | |
| failwith "is_proof_valid" | |
| else if check_data param.proof param.data = false then | |
| failwith "check data" | |
| else | |
| ([], NoStorage) |
↑上記のコンパイルエラーはStdlibのresult型を使っていたからのようだ。
ScamlではStdlibは使わず、SCaml.mliのAPIだけを使うようにすべしということで修正した。
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
scamlc verify_plebeia_merkle_proof.ml