From ab877b75ae6e106c846669d67b70db050a10688b Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Mon, 2 Jun 2025 16:55:17 +0200 Subject: [PATCH 1/8] interface proof --- interface/api/api.ml | 14 +++++++- interface/common/i.ml | 45 +++++++++++++++++++------- interface/common/serv.ml | 32 +++++++++++++++--- interface/ui/index.html | 70 ++++++++++++++++++++++++++++++++++++---- interface/ui/ui.ml | 65 +++++++++++++++++++++++++++++++++++-- 5 files changed, 199 insertions(+), 27 deletions(-) diff --git a/interface/api/api.ml b/interface/api/api.ml index 27dd5f3..8317390 100644 --- a/interface/api/api.ml +++ b/interface/api/api.ml @@ -32,7 +32,7 @@ let connect [%req] () = rok () [@@service Serv.Api.connect] -let notarize [%req] n = +let notarize [%req] (n: notarization) = let>? account, _ = auth req in let>? () = Serv.Proxy.(wrap @@ post_notarize ~input:n.hash !proxy) in let>? status = Serv.Proxy.(wrap @@ post_status ~input:n.hash !proxy) in @@ -73,6 +73,18 @@ let notarization ([%req], hash) () = | Error e -> rerr e [@@service Serv.Api.notarization] +let notarization_proof ([%req], hash) () = + let>? _ = auth req in + Serv.Proxy.(wrap @@ post_proof ~input:hash !proxy) +[@@service Serv.Api.notarization_proof] + +let verify_proof [%req] input = + let>? _ = auth req in + Serv.Proxy.(wrap @@ post_verify ~input !proxy) +[@@service Serv.Api.verify_proof] + + + let openapi () = rok (snd @@ EzOpenAPI.make ~pretty:true ~sections:Serv.sections ~title:"Pandora App API" "") [@@service Serv.Api.openapi] diff --git a/interface/common/i.ml b/interface/common/i.ml index 6b05ef5..45b71ac 100644 --- a/interface/common/i.ml +++ b/interface/common/i.ml @@ -52,6 +52,7 @@ type error += | NotFound of string [@code 404] | ServerError of server_error [@encoding server_error_enc] [@nowrap] | BadGateway of bad_gateway [@code 502] [@nowrap] + | InvalidProof of string [@code 422] [@@deriving err_case {code=500}] let error_enc = Json_encoding.union (List.map snd !_error_cases_error) @@ -98,6 +99,23 @@ type notarization = { status: status option; [@readonly] } [@@deriving encoding {def="notarization"}, jsoo] +type proof = Json_repr.ezjsonm [@@deriving encoding] +type commitment = Json_repr.ezjsonm [@@deriving encoding] +[@@@jsoo + type proof_jsoo = Ezjs_min.Unsafe.top + let proof_to_jsoo json = Js_json.js_of_json json + let proof_of_jsoo js = Js_json.json_of_js js + type commitment_jsoo = Ezjs_min.Unsafe.top + let commitment_to_jsoo json = Js_json.js_of_json json + let commitment_of_jsoo js = Js_json.json_of_js js +] + +type proof_with_hash = { + hash: string; + commitment: commitment; + proof: proof; +} [@@deriving encoding, jsoo] + module De = struct let string enc s = try Ok (EzEncoding.destruct enc s) @@ -122,18 +140,21 @@ let map_s f l = | Ok r -> (aux [@ocaml.tailcall]) (r :: acc) tl in aux [] l -let print_error = function - | BadRequest s -> Format.eprintf "bad request: %s@." s - | Unauthorized s -> Format.eprintf "unauthorized: %s@." s - | NotFound s -> Format.eprintf "not found: %s@." s - | BadGateway None -> Format.eprintf "bad gateway@." - | BadGateway Some s -> Format.eprintf "bad gateway: %s@." s - | ServerError Generic s -> Format.eprintf "server error: %s@." s - | ServerError PgError s -> Format.eprintf "pgocaml error: %s@." s - | ServerError DestructError s -> Format.eprintf "destruct error: %s@." s - | ServerError Exn exn -> Format.eprintf "exception: %s@." (Printexc.to_string exn) - | ServerError PsqlError {msg; _} -> Format.eprintf "psql error: %s" msg - | _ -> () +let pp_error fmt = function + | BadRequest s -> Format.fprintf fmt "bad request: %s" s + | Unauthorized s -> Format.fprintf fmt "unauthorized: %s" s + | NotFound s -> Format.fprintf fmt "not found: %s" s + | BadGateway None -> Format.fprintf fmt "bad gateway" + | BadGateway Some s -> Format.fprintf fmt "bad gateway: %s" s + | InvalidProof _ -> Format.fprintf fmt "invalid proof" + | ServerError Generic s -> Format.fprintf fmt "server error: %s" s + | ServerError PgError s -> Format.fprintf fmt "pgocaml error: %s" s + | ServerError DestructError s -> Format.fprintf fmt "destruct error: %s" s + | ServerError Exn exn -> Format.fprintf fmt "exception: %s" (Printexc.to_string exn) + | ServerError PsqlError {msg; _} -> Format.fprintf fmt "psql error: %s" msg + | _ -> Format.fprintf fmt "unknown error" + +let print_error e = Format.eprintf "%a@." pp_error e let decode_token s = try diff --git a/interface/common/serv.ml b/interface/common/serv.ml index ccc7ed3..4d167a6 100644 --- a/interface/common/serv.ml +++ b/interface/common/serv.ml @@ -2,12 +2,29 @@ open Json_encoding open I module Proxy = struct + let encoding = Json_encoding.( + obj2 (req "error" string) (opt "message" ( + union [ + case string Option.some Fun.id; + case any_ezjson_value (fun _ -> None) Ezjsonm_interface.to_string + ]))) + let errors = [ - EzAPI.Err.make ~name:"BadGateway" ~code:502 ~encoding:bad_gateway_enc ~select:Option.some ~deselect:Fun.id; + EzAPI.Err.make ~name:"Bad Request" ~code:400 ~encoding ~select:Option.some ~deselect:Fun.id; + EzAPI.Err.make ~name:"Not Found" ~code:404 ~encoding ~select:Option.some ~deselect:Fun.id; + EzAPI.Err.make ~name:"Unprocessable Content" ~code:422 ~encoding ~select:Option.some ~deselect:Fun.id; + EzAPI.Err.make ~name:"Bad Gateway" ~code:502 ~encoding ~select:Option.some ~deselect:Fun.id; ] - let wrap p = Lwt.map (function Error (_code, (`known s | `unknown s)) -> Error (BadGateway s) | Ok x -> Ok x) p + let wrap p = Lwt.map (function + | Error (404, `known (err, Some msg)) -> Error (NotFound (Format.sprintf "%s: %s" err msg)) + | Error (422, `known (err, Some msg)) -> Error (InvalidProof (Format.sprintf "%s: %s" err msg)) + | Error (_, `known (_, msg)) -> Error (BadGateway msg) + | Error (_, `unknown s) -> Error (BadGateway s) + | Ok x -> Ok x) p let%post notarize = { path = "/notarize/hash"; input=string; output=unit; errors } - let%post status = { path = "notarize/status"; input=string; output=(option status_enc); errors } + let%post status = { path = "/notarize/status"; input=string; output=(option status_enc); errors } + let%post proof = { path = "/notarize/proof"; input=string; output=proof_with_hash_enc; errors } + let%post verify = { path = "/notarize/verify"; input=proof_with_hash_enc; output=(obj1 (req "notarized" Cal.enc)); errors } end let%err_case bad_request : error = 400 @@ -15,8 +32,9 @@ and unauthorized : error = 401 and not_found : error = 404 and server_error : error = 500 and bad_gateway : error = 502 +and unprocessable_entity : error = 422 -let errors = [ bad_request; unauthorized; not_found; server_error; bad_gateway ] +let errors = [ bad_request; unauthorized; not_found; server_error; bad_gateway; unprocessable_entity ] let%secu basic = `Basic {EzAPI.Security.basic_name="Basic"} let%secu security : EzAPI.Security.scheme list = [ basic ] @@ -49,6 +67,12 @@ module Api = struct let%get notarizations = { path = "/notarization"; output=Json_encoding.list notarization_enc; errors; security; params=[offset; limit; account]; section=notarization_section } + let%get notarization_proof = { + path = "/notarization/{arg_hash}/proof"; output=proof_with_hash_enc; + errors; security; section=notarization_section } + let%put verify_proof = { + path = "/notarization/verify"; input=proof_with_hash_enc; output=Cal.enc; + errors; security; section=notarization_section } let%get openapi = { path = "/openapi"; output=["application/json"]; errors; section=doc_section } diff --git a/interface/ui/index.html b/interface/ui/index.html index 6a9b0c9..e58fe0d 100644 --- a/interface/ui/index.html +++ b/interface/ui/index.html @@ -12,19 +12,19 @@ - - - - -
+
+
+ + +
+
+ + check proof +
+
+
+
+ +
+ Error + + Proof verified: + + + {{ proof_verified.toLocaleString('en-GB') }} + + + +
+ +
+
+ + Error + Proof verified: + + +
+
+
+
+
{{ e }}
+
+ +
+ + + {{ proof_verified.toLocaleString('en-GB') }} + +
+
+
+ +
diff --git a/interface/ui/ui.ml b/interface/ui/ui.ml index beab782..539aa96 100644 --- a/interface/ui/ui.ml +++ b/interface/ui/ui.ml @@ -7,7 +7,7 @@ type config = { wait: float; [@dft 2.] } [@@deriving encoding, jsoo] -type section = [ `load | `signin | `home ] [@@deriving jsoo] +type section = [ `load | `signin | `home | `proof ] [@@deriving jsoo] let config = ref { api = "http://localhost:8080"; page_size = 10; wait = 2. } @@ -98,6 +98,9 @@ and files: string list = [] and notarization: notarization option = None and error: I.error option = None and section : section = `load +and proof_hash : string option = None +and proof_error : string list option = None +and proof_verified : I.Cal.t option = None let storage () = Option.get @@ Optdef.to_option Dom_html.window##.localStorage @@ -173,7 +176,9 @@ let load_config app = let load_token ?st app = let storage = match st with None -> storage () | Some st -> st in match Opt.to_option @@ storage##getItem (string "token") with - | None -> app##.section := section_to_jsoo `signin; Lwt.return false + | None -> + app##.section := section_to_jsoo `signin; + Lwt.return false | Some s -> match decode_token (to_string s) with | Error e -> log_str e; @@ -195,6 +200,7 @@ let load_token ?st app = Lwt.return true let init app = + app##.section := section_to_jsoo `load; EzLwtSys.run @@ fun () -> let> () = load_config app in let> b = load_token app in @@ -297,6 +303,59 @@ and get_notarizations app page = and init app = init app +and [@noconv] proof app (n: notarization_jsoo t) = + let open Ezjs_fetch_lwt in + EzLwtSys.run @@ fun () -> + let headers = headers app in + let hash = to_string n##.hash in + let URL url = EzAPI.forge1 (EzAPI.BASE !config.api) Serv.Api.notarization_proof hash [] in + let|> r = fetch ~headers url to_blob in + match r with + | Error e -> js_log e + | Ok r -> + let href = Dom_html.window##._URL##createObjectURL r.body in + let elt = Dom_html.document##createElement (string "a") in + elt##.style##.display := string "none"; + (Unsafe.coerce elt)##.href := href; + (Unsafe.coerce elt)##.download := string (Format.sprintf "proof_%s.json" hash); + Dom.appendChild Dom_html.document##.body elt; + elt##click + +and [@noconv] check_proof app (event: Dom_html.inputElement Dom.event t) = + EzLwtSys.run @@ fun () -> + match Opt.to_option event##.target with + | None -> Lwt.return_unit + | Some target -> + let files = Dom.list_of_nodeList target##.files in + Optdef.iter [%ref app "proof-file"] (fun elt -> (Unsafe.coerce elt)##.value := null); + match files with + | [] -> Lwt.return_unit + | f :: _ -> + let> s = read_file f in + let s = Typed_array.String.of_arrayBuffer @@ Typed_array.Bigstring.to_arrayBuffer s in + try + let input = EzEncoding.destruct proof_with_hash_enc s in + app##.proof_hash_ := def (string input.hash); + let headers = headers app in + let|> r = Serv.Api.(wrap @@ put_verify_proof ~headers ~input (EzAPI.BASE !config.api)) in + begin match r with + | Error e -> app##.proof_error_ := def (of_list [string (Format.asprintf "%a" pp_error e)]) + | Ok tsp -> app##.proof_verified_ := def (Cal.to_jsoo tsp) + end + with _ -> + app##.proof_error_ := + def (of_listf string [ + "invalid file"; + "it should be of the form:"; + {|{ "hash": "...", "commitment": { ... }, "proof": { ... } }|}; + ]); + Lwt.return_unit + +and close_proof app = + app##.proof_error_ := undefined; + app##.proof_verified_ := undefined; + app##.proof_hash_ := undefined + [%%mounted fun app -> init app] -[%%app {conv; mount; components=[Notarization; Hash; Error]; modules=[I, Ijsoo]}] +[%%app {conv; mount; components=[Notarization; Hash; Error]; modules=[I, Ijsoo]; unhide}] -- GitLab From e97105d5458d41c205d2da97c547fa9a1af12003 Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Tue, 3 Jun 2025 14:42:25 +0200 Subject: [PATCH 2/8] store proof in db --- interface/api/api.ml | 14 +++++++++++--- interface/common/i.ml | 14 ++++++++------ interface/db/db.ml | 20 +++++++++++++++++--- interface/ui/ui.ml | 4 +++- 4 files changed, 39 insertions(+), 13 deletions(-) diff --git a/interface/api/api.ml b/interface/api/api.ml index 8317390..8a500af 100644 --- a/interface/api/api.ml +++ b/interface/api/api.ml @@ -68,14 +68,22 @@ let notarization ([%req], hash) () = let>? status = Serv.Proxy.(wrap @@ post_status ~input:hash !proxy) in begin match status with | None -> rerr (NotFound s) - | Some status -> rok { hash; info=default_notarization_info; status=Some status } + | Some status -> rok { hash; info=default_notarization_info; status=Some status; proof=None; commitment=None } end | Error e -> rerr e [@@service Serv.Api.notarization] let notarization_proof ([%req], hash) () = - let>? _ = auth req in - Serv.Proxy.(wrap @@ post_proof ~input:hash !proxy) + let>? account, _ = auth req in + let> r = Db.notarization ~account hash in + match r with + | Ok {proof=Some proof; commitment=Some commitment; _} -> + rok {hash; proof; commitment} + | Ok n -> + let>? p = Serv.Proxy.(wrap @@ post_proof ~input:hash !proxy) in + let>? _ = Db.register_notarization ~account { n with proof=Some p.proof; commitment=Some p.commitment } in + rok p + | _ -> Serv.Proxy.(wrap @@ post_proof ~input:hash !proxy) [@@service Serv.Api.notarization_proof] let verify_proof [%req] input = diff --git a/interface/common/i.ml b/interface/common/i.ml index 45b71ac..1641e21 100644 --- a/interface/common/i.ml +++ b/interface/common/i.ml @@ -93,12 +93,6 @@ let default_notarization_info = { description = None; } -type notarization = { - hash: string; - info: notarization_info; [@merge] - status: status option; [@readonly] -} [@@deriving encoding {def="notarization"}, jsoo] - type proof = Json_repr.ezjsonm [@@deriving encoding] type commitment = Json_repr.ezjsonm [@@deriving encoding] [@@@jsoo @@ -110,6 +104,14 @@ type commitment = Json_repr.ezjsonm [@@deriving encoding] let commitment_of_jsoo js = Js_json.json_of_js js ] +type notarization = { + hash: string; + info: notarization_info; [@merge] + status: status option; [@readonly] + proof: proof option; + commitment: commitment option; +} [@@deriving encoding {def="notarization"}, jsoo] + type proof_with_hash = { hash: string; commitment: commitment; diff --git a/interface/db/db.ml b/interface/db/db.ml index ae58957..fd3d997 100644 --- a/interface/db/db.ml +++ b/interface/db/db.ml @@ -42,6 +42,8 @@ let one ?err ?id p = Lwt.map (function "alter table accounts add column admin boolean not null default false"; "alter table notarizations drop constraint notarizations_hash_key"; "alter table notarizations add constraint notarizations_hash_account_key unique (hash, account)"; + "alter table notarizations add column proof jsonb"; + "alter table notarizations add column commitment jsonb"; ]; downgrade=[ "drop table users"; @@ -66,7 +68,17 @@ let db_notarization ?account r = let$ info = if account = Some r#account then De.string notarization_info_enc r#info else Ok default_notarization_info in - Ok { hash = r#hash; status; info } + let$ proof = match r#proof with + | None -> Ok None + | Some p -> + let$ r = De.string Json_encoding.any_ezjson_value p in + Ok (Some r) in + let$ commitment = match r#commitment with + | None -> Ok None + | Some p -> + let$ r = De.string Json_encoding.any_ezjson_value p in + Ok (Some r) in + Ok { hash = r#hash; status; info; proof; commitment } let notarizations_count ?dbh x = let@ dbh = use dbh in @@ -97,10 +109,12 @@ let register_notarization ?dbh ?account n = match account with | Some account -> let info = EzEncoding.construct notarization_info_enc n.info in + let proof = Option.map (EzEncoding.construct Json_encoding.any_ezjson_value) n.proof in + let commitment = Option.map (EzEncoding.construct Json_encoding.any_ezjson_value) n.commitment in let err () = BadRequest (Format.sprintf "%s already notarized" n.hash) in one ~err [%pgsql dbh - "insert into notarizations(hash, account, status, info) \ - values(${n.hash}, $account, $status, $info) on conflict do nothing returning id"] + "insert into notarizations(hash, account, status, info, proof, commitment) \ + values(${n.hash}, $account, $status, $info, $?proof, $?commitment) on conflict do nothing returning id"] | None -> one ~id:n.hash [%pgsql dbh "update notarizations set status = $status \ diff --git a/interface/ui/ui.ml b/interface/ui/ui.ml index 539aa96..656cd69 100644 --- a/interface/ui/ui.ml +++ b/interface/ui/ui.ml @@ -268,7 +268,9 @@ and notarize app = let input = { hash; status=None; info = { files = Some (to_listf to_string app##.files); description = None; - name = (if name = "" then None else Some name) } } in + name = (if name = "" then None else Some name) }; + proof=None; commitment=None; + } in let|> r = Serv.Api.(wrap @@ put_notarize ~headers ~input (EzAPI.BASE !config.api)) in clean_notarization app; match r with -- GitLab From 0276b9096d6810f1e00538680d945a680c98261f Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Tue, 3 Jun 2025 14:50:41 +0200 Subject: [PATCH 3/8] section proof only when signed in --- interface/ui/index.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interface/ui/index.html b/interface/ui/index.html index e58fe0d..9a231a7 100644 --- a/interface/ui/index.html +++ b/interface/ui/index.html @@ -22,7 +22,7 @@ Pandora
    -
  • +
  • Proofs
  • -- GitLab From 25f7d69867fcef7a28a6acc965fad08b0e5cbd8f Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Tue, 3 Jun 2025 16:05:59 +0200 Subject: [PATCH 4/8] commitment info --- interface/common/i.ml | 10 ++++++---- interface/db/db.ml | 8 ++++---- interface/ui/index.html | 28 ++++++++++++++++++++++------ interface/ui/ui.ml | 32 ++++++++++++++++++++++++++++---- 4 files changed, 60 insertions(+), 18 deletions(-) diff --git a/interface/common/i.ml b/interface/common/i.ml index 1641e21..4e5bca2 100644 --- a/interface/common/i.ml +++ b/interface/common/i.ml @@ -94,16 +94,18 @@ let default_notarization_info = { } type proof = Json_repr.ezjsonm [@@deriving encoding] -type commitment = Json_repr.ezjsonm [@@deriving encoding] [@@@jsoo type proof_jsoo = Ezjs_min.Unsafe.top let proof_to_jsoo json = Js_json.js_of_json json let proof_of_jsoo js = Js_json.json_of_js js - type commitment_jsoo = Ezjs_min.Unsafe.top - let commitment_to_jsoo json = Js_json.js_of_json json - let commitment_of_jsoo js = Js_json.json_of_js js ] +type commitment = { + hash: string; + status: string; + commitment: Json_repr.ezjsonm; [@type Ezjs_min.Unsafe.any] [@conv (Js_json.js_of_json, Js_json.json_of_js)] +} [@@deriving encoding, jsoo] + type notarization = { hash: string; info: notarization_info; [@merge] diff --git a/interface/db/db.ml b/interface/db/db.ml index fd3d997..961eb08 100644 --- a/interface/db/db.ml +++ b/interface/db/db.ml @@ -71,12 +71,12 @@ let db_notarization ?account r = let$ proof = match r#proof with | None -> Ok None | Some p -> - let$ r = De.string Json_encoding.any_ezjson_value p in + let$ r = De.string proof_enc p in Ok (Some r) in let$ commitment = match r#commitment with | None -> Ok None | Some p -> - let$ r = De.string Json_encoding.any_ezjson_value p in + let$ r = De.string commitment_enc p in Ok (Some r) in Ok { hash = r#hash; status; info; proof; commitment } @@ -109,8 +109,8 @@ let register_notarization ?dbh ?account n = match account with | Some account -> let info = EzEncoding.construct notarization_info_enc n.info in - let proof = Option.map (EzEncoding.construct Json_encoding.any_ezjson_value) n.proof in - let commitment = Option.map (EzEncoding.construct Json_encoding.any_ezjson_value) n.commitment in + let proof = Option.map (EzEncoding.construct proof_enc) n.proof in + let commitment = Option.map (EzEncoding.construct commitment_enc) n.commitment in let err () = BadRequest (Format.sprintf "%s already notarized" n.hash) in one ~err [%pgsql dbh "insert into notarizations(hash, account, status, info, proof, commitment) \ diff --git a/interface/ui/index.html b/interface/ui/index.html index 9a231a7..7e0a4f0 100644 --- a/interface/ui/index.html +++ b/interface/ui/index.html @@ -163,7 +163,8 @@ {{ n.info.files.reduce((acc, x) => acc + ', ' + x) }} - + proof + @@ -212,11 +213,26 @@
    {{ e }}
    -
    - - - {{ proof_verified.toLocaleString('en-GB') }} - +
    +
    Notarization
    +
    + + + {{ proof_verified.toLocaleString('en-GB') }} + +
    +
    +
    +
    Commitment
    +
    + + + + + + + {{ commitment_status }} +
    diff --git a/interface/ui/ui.ml b/interface/ui/ui.ml index 656cd69..b7edcdd 100644 --- a/interface/ui/ui.ml +++ b/interface/ui/ui.ml @@ -5,11 +5,21 @@ type config = { api: string; [@dft "http://localhost:8080"] page_size: int; [@dft 10] wait: float; [@dft 2.] + explorer: string; [@dft "https://ghostnet.tzkt.io"] + explorer_api: string; [@dft "https://api.ghostnet.tzkt.io/v1"] + rollup: string option; } [@@deriving encoding, jsoo] type section = [ `load | `signin | `home | `proof ] [@@deriving jsoo] -let config = ref { api = "http://localhost:8080"; page_size = 10; wait = 2. } +let config = ref { + api = "http://localhost:8080"; + page_size = 10; + wait = 2.; + explorer = "https://ghostnet.tzkt.io"; + explorer_api = "https://ghostnet.tzkt.io"; + rollup = None; +} let headers app = match to_optdef to_string app##.token with @@ -101,6 +111,10 @@ and section : section = `load and proof_hash : string option = None and proof_error : string list option = None and proof_verified : I.Cal.t option = None +and commitments_page : string option = None +and commitment_json : string option = None +and commitment_status : string option = None +and commitment_hash : string option = None let storage () = Option.get @@ Optdef.to_option Dom_html.window##.localStorage @@ -171,7 +185,10 @@ let load_config app = | Ok s -> begin try Some (EzEncoding.destruct config_enc s) with _ -> aux () end | Error (404, _) -> aux () | _ -> None in - Option.iter (fun c -> config := c) c + Option.iter (fun c -> config := c) c; + Option.iter (fun rollup -> + app##.commitments_page_ := def (string (Format.sprintf "%s/%s/commitments" !config.explorer rollup)) + ) !config.rollup let load_token ?st app = let storage = match st with None -> storage () | Some st -> st in @@ -342,7 +359,11 @@ and [@noconv] check_proof app (event: Dom_html.inputElement Dom.event t) = let|> r = Serv.Api.(wrap @@ put_verify_proof ~headers ~input (EzAPI.BASE !config.api)) in begin match r with | Error e -> app##.proof_error_ := def (of_list [string (Format.asprintf "%a" pp_error e)]) - | Ok tsp -> app##.proof_verified_ := def (Cal.to_jsoo tsp) + | Ok tsp -> + app##.proof_verified_ := def (Cal.to_jsoo tsp); + app##.commitment_json_ := def (string (Format.sprintf "%s/smart_rollups/commitments?hash=%s" !config.explorer_api input.commitment.hash)); + app##.commitment_status_ := def (string input.commitment.status); + app##.commitment_hash_ := def (string input.commitment.hash) end with _ -> app##.proof_error_ := @@ -356,7 +377,10 @@ and [@noconv] check_proof app (event: Dom_html.inputElement Dom.event t) = and close_proof app = app##.proof_error_ := undefined; app##.proof_verified_ := undefined; - app##.proof_hash_ := undefined + app##.proof_hash_ := undefined; + app##.commitment_json_ := undefined; + app##.commitment_status_ := undefined; + app##.commitment_hash_ := undefined [%%mounted fun app -> init app] -- GitLab From 0b758635474b8ed1d9afd3283e11cf3dac566a90 Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Tue, 3 Jun 2025 16:29:25 +0200 Subject: [PATCH 5/8] fix notarization proof update --- interface/api/api.ml | 2 +- interface/db/db.ml | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/interface/api/api.ml b/interface/api/api.ml index 8a500af..9ff0704 100644 --- a/interface/api/api.ml +++ b/interface/api/api.ml @@ -81,7 +81,7 @@ let notarization_proof ([%req], hash) () = rok {hash; proof; commitment} | Ok n -> let>? p = Serv.Proxy.(wrap @@ post_proof ~input:hash !proxy) in - let>? _ = Db.register_notarization ~account { n with proof=Some p.proof; commitment=Some p.commitment } in + let>? _ = Db.register_notarization { n with proof=Some p.proof; commitment=Some p.commitment } in rok p | _ -> Serv.Proxy.(wrap @@ post_proof ~input:hash !proxy) [@@service Serv.Api.notarization_proof] diff --git a/interface/db/db.ml b/interface/db/db.ml index 961eb08..7bd0b8e 100644 --- a/interface/db/db.ml +++ b/interface/db/db.ml @@ -109,13 +109,13 @@ let register_notarization ?dbh ?account n = match account with | Some account -> let info = EzEncoding.construct notarization_info_enc n.info in - let proof = Option.map (EzEncoding.construct proof_enc) n.proof in - let commitment = Option.map (EzEncoding.construct commitment_enc) n.commitment in let err () = BadRequest (Format.sprintf "%s already notarized" n.hash) in one ~err [%pgsql dbh - "insert into notarizations(hash, account, status, info, proof, commitment) \ - values(${n.hash}, $account, $status, $info, $?proof, $?commitment) on conflict do nothing returning id"] + "insert into notarizations(hash, account, status, info) \ + values(${n.hash}, $account, $status, $info) on conflict do nothing returning id"] | None -> + let proof = Option.map (EzEncoding.construct proof_enc) n.proof in + let commitment = Option.map (EzEncoding.construct commitment_enc) n.commitment in one ~id:n.hash [%pgsql dbh - "update notarizations set status = $status \ + "update notarizations set status = $status, proof = $?proof, commitment = $?commitment \ where hash = ${n.hash} returning id"] -- GitLab From 4bf4212b1890c7cb539e8985cb122e278278d70e Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Tue, 3 Jun 2025 16:44:26 +0200 Subject: [PATCH 6/8] uncommitted --- interface/common/i.ml | 8 +++++--- interface/ui/index.html | 25 +++++++++++++++---------- interface/ui/ui.ml | 10 ++++++---- 3 files changed, 26 insertions(+), 17 deletions(-) diff --git a/interface/common/i.ml b/interface/common/i.ml index 4e5bca2..19bd216 100644 --- a/interface/common/i.ml +++ b/interface/common/i.ml @@ -100,10 +100,12 @@ type proof = Json_repr.ezjsonm [@@deriving encoding] let proof_of_jsoo js = Js_json.json_of_js js ] +type commitment_status = [`uncommitted | `committed | `cemented ] [@@deriving encoding, jsoo] + type commitment = { - hash: string; - status: string; - commitment: Json_repr.ezjsonm; [@type Ezjs_min.Unsafe.any] [@conv (Js_json.js_of_json, Js_json.json_of_js)] + status: commitment_status; + hash: string option; + commitment: (Json_repr.ezjsonm [@type Ezjs_min.Unsafe.any] [@conv (Js_json.js_of_json, Js_json.json_of_js)]) option; } [@@deriving encoding, jsoo] type notarization = { diff --git a/interface/ui/index.html b/interface/ui/index.html index 7e0a4f0..9d6aafc 100644 --- a/interface/ui/index.html +++ b/interface/ui/index.html @@ -223,20 +223,25 @@
    -
    Commitment
    -
    - - - - - - - {{ commitment_status }} +
    +
    Commitment
    + +
    +
    +
    Commitment
    +
    + + + + + + + {{ commitment_status }} +
    - diff --git a/interface/ui/ui.ml b/interface/ui/ui.ml index b7edcdd..026ad09 100644 --- a/interface/ui/ui.ml +++ b/interface/ui/ui.ml @@ -113,7 +113,7 @@ and proof_error : string list option = None and proof_verified : I.Cal.t option = None and commitments_page : string option = None and commitment_json : string option = None -and commitment_status : string option = None +and commitment_status : commitment_status option = None and commitment_hash : string option = None let storage () = Option.get @@ Optdef.to_option Dom_html.window##.localStorage @@ -361,9 +361,11 @@ and [@noconv] check_proof app (event: Dom_html.inputElement Dom.event t) = | Error e -> app##.proof_error_ := def (of_list [string (Format.asprintf "%a" pp_error e)]) | Ok tsp -> app##.proof_verified_ := def (Cal.to_jsoo tsp); - app##.commitment_json_ := def (string (Format.sprintf "%s/smart_rollups/commitments?hash=%s" !config.explorer_api input.commitment.hash)); - app##.commitment_status_ := def (string input.commitment.status); - app##.commitment_hash_ := def (string input.commitment.hash) + app##.commitment_status_ := def (commitment_status_to_jsoo input.commitment.status); + Option.iter (fun hash -> + app##.commitment_json_ := def (string (Format.sprintf "%s/smart_rollups/commitments?hash=%s" !config.explorer_api hash)); + app##.commitment_hash_ := def (string hash) + ) input.commitment.hash end with _ -> app##.proof_error_ := -- GitLab From d1c13ebedf09efe98a0129e0d6ff4eb28a7b3218 Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Wed, 4 Jun 2025 11:02:01 +0200 Subject: [PATCH 7/8] fix uncommitted proof --- interface/ui/index.html | 4 +-- interface/ui/ui.ml | 54 +++++++++++++++++++++++++++++------------ 2 files changed, 41 insertions(+), 17 deletions(-) diff --git a/interface/ui/index.html b/interface/ui/index.html index 9d6aafc..e37b286 100644 --- a/interface/ui/index.html +++ b/interface/ui/index.html @@ -223,9 +223,9 @@
    -
    +
    Commitment
    - + {{ commitment_status }}
    Commitment
    diff --git a/interface/ui/ui.ml b/interface/ui/ui.ml index 026ad09..19a8639 100644 --- a/interface/ui/ui.ml +++ b/interface/ui/ui.ml @@ -242,6 +242,14 @@ let clean app = clean_notarization app; clean_notarizations app +let clean_proof app = + app##.proof_error_ := undefined; + app##.proof_verified_ := undefined; + app##.proof_hash_ := undefined; + app##.commitment_json_ := undefined; + app##.commitment_status_ := undefined; + app##.commitment_hash_ := undefined + let%meth signin app = EzLwtSys.run @@ fun () -> let> b = set_token app in @@ -328,19 +336,40 @@ and [@noconv] proof app (n: notarization_jsoo t) = let headers = headers app in let hash = to_string n##.hash in let URL url = EzAPI.forge1 (EzAPI.BASE !config.api) Serv.Api.notarization_proof hash [] in - let|> r = fetch ~headers url to_blob in + let> r = Ezjs_min_lwt.Promise.to_lwt (fetch_base ~headers url) in match r with - | Error e -> js_log e + | Error e -> js_log e; Lwt.return_unit + | Ok r when to_bool r##.ok -> + let|> rbody = Ezjs_min_lwt.Promise.to_lwt r##blob in + begin match rbody with + | Error e -> js_log e + | Ok x -> + match Opt.to_option x with + | None -> log_str "no body" + | Some blob -> + let href = Dom_html.window##._URL##createObjectURL blob in + let elt = Dom_html.document##createElement (string "a") in + elt##.style##.display := string "none"; + (Unsafe.coerce elt)##.href := href; + (Unsafe.coerce elt)##.download := string (Format.sprintf "proof_%s.json" hash); + Dom.appendChild Dom_html.document##.body elt; + elt##click + end | Ok r -> - let href = Dom_html.window##._URL##createObjectURL r.body in - let elt = Dom_html.document##createElement (string "a") in - elt##.style##.display := string "none"; - (Unsafe.coerce elt)##.href := href; - (Unsafe.coerce elt)##.download := string (Format.sprintf "proof_%s.json" hash); - Dom.appendChild Dom_html.document##.body elt; - elt##click + let|> rbody = Ezjs_min_lwt.Promise.to_lwt r##text in + match rbody with + | Error e -> js_log e + | Ok x -> + match Opt.to_option x with + | None -> log_str "no body" + | Some s -> + let enc = Json_encoding.union @@ List.filter_map (fun (code, case) -> + if code = r##.status then Some case else None) !_error_cases_error in + let e = EzEncoding.destruct enc (to_string s) in + js_log e and [@noconv] check_proof app (event: Dom_html.inputElement Dom.event t) = + clean_proof app; EzLwtSys.run @@ fun () -> match Opt.to_option event##.target with | None -> Lwt.return_unit @@ -377,12 +406,7 @@ and [@noconv] check_proof app (event: Dom_html.inputElement Dom.event t) = Lwt.return_unit and close_proof app = - app##.proof_error_ := undefined; - app##.proof_verified_ := undefined; - app##.proof_hash_ := undefined; - app##.commitment_json_ := undefined; - app##.commitment_status_ := undefined; - app##.commitment_hash_ := undefined + clean_proof app [%%mounted fun app -> init app] -- GitLab From 511aa1da6eedb656c665453f7d9d979466b696db Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Wed, 4 Jun 2025 11:10:58 +0200 Subject: [PATCH 8/8] only badge for uncommitted proof --- interface/ui/index.html | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/interface/ui/index.html b/interface/ui/index.html index e37b286..d0dd0b8 100644 --- a/interface/ui/index.html +++ b/interface/ui/index.html @@ -223,9 +223,8 @@
    -
    -
    Commitment
    - {{ commitment_status }} +
    + {{ commitment_status }}
    Commitment
    -- GitLab