Commit 5aa336cd authored by Michael's avatar Michael

Merge branch 'dune-lib' into 'next'

Tools: create a js library using the functions of node.ml

See merge request !53
parents beaf7578 d8ad9717
......@@ -13,6 +13,7 @@ all: _obuild libs/ez-api/autoconf/config.ocp2gen libs/ocplib-jsutils/autoconf/co
@cp _obuild/metal-reset/metal-reset.js static
@cp _obuild/metal-test/metal-test.js static
@cp _obuild/metal-pres/metal-pres.js static
@cp _obuild/jsdune/jsdune.js libs/jsdune
@$(MAKE) static/css/main.css
static/css/main.css: static/scss/main.scss
......
js_program("jsdune", "jsdune.ml", ["metal-node"; "ocplib-promise-lwt"]);
\ No newline at end of file
open Js_types
open Metal_types
class type manager_info = object
method source : js_string t prop
method fee : js_string t optdef prop
method counter : js_string t optdef prop
method gasLimit : js_string t optdef prop
method storageLimit : js_string t optdef prop
end
class type parameter_js = object
method entrypoint : js_string t optdef prop
method value : js_string t optdef prop
end
class type transaction_details_js = object
method destination : js_string t prop
method amount : js_string t prop
method parameters : parameter_js t optdef prop
end
class type script_js = object
method code : js_string t optdef prop
method storage : js_string t prop
method codeHash : js_string t optdef prop
end
class type origination_details_js = object
method balance : js_string t prop
method script : script_js t optdef prop
end
class type reveal_details_js = object
method pubkey : js_string t prop
end
class type delegation_details_js = object
method delegate : js_string t optdef prop
end
class type operation_js = object
inherit manager_info
inherit transaction_details_js
inherit origination_details_js
inherit reveal_details_js
inherit delegation_details_js
method kind : js_string t prop
end
class type config_js = object
method network : js_string t optdef prop
method node : js_string t optdef prop
end
class type inputs_js = object
method config : config_js t optdef prop
method operations : operation_js t js_array t optdef prop
method branch : js_string t optdef prop
method bytes : js_string t optdef prop
method pk : js_string t optdef prop
method sk : js_string t optdef prop
method cb : js_string t callback optdef prop
end
type metal_ops =
(notif_manager_info,
(Dune_types_min.account_hash *
(Bigstring.t -> (Bigstring.t, string Async.metal_error) result Lwt.t))
option manager_details)
manager_operation
type inputs = {
base : Js_of_ocaml.Url.url option;
operations : (metal_ops list * string) option;
branch : string option;
bytes : Bigstring.t option;
pk : (unit -> (string, string Async.metal_error) result Lwt.t);
sk : Bigstring.t option;
cb : string -> js_string t optdef
}
let to_metal_op (op : operation_js t) =
let mo_info = {
not_mi_fee = to_optdef (fun x -> Int64.of_string @@ to_string x) op##.fee;
not_mi_gas_limit = to_optdef (fun x -> Z.of_string @@ to_string x) op##.gasLimit;
not_mi_storage_limit = to_optdef (fun x -> Z.of_string @@ to_string x) op##.storageLimit;
not_mi_msg = None
} in
let mo_det = match to_string op##.kind with
| "transaction" ->
Some (TraDetails {
trd_dst = to_string op##.destination;
trd_amount = Int64.of_string (to_string op##.amount);
trd_parameters = to_optdef (fun p ->
to_optdef to_string p##.entrypoint,
to_optdef to_string p##.value) op##.parameters
})
| "origination" ->
Some (OriDetails {
ord_balance = Int64.of_string (to_string op##.balance);
ord_script = to_optdef (fun sc ->
to_optdef to_string sc##.code, to_string sc##.storage,
to_optdef to_string sc##.codeHash) op##.script;
ord_delegate = None;
ord_kt1 = None
})
| "reveal" -> Some (RvlDetails (to_string op##.pubkey))
| "delegation" -> Some (DelDetails (to_optdef to_string op##.delegate))
| _ -> None in
match mo_det with
| None -> Error (Async.Str_err "Operation not handled")
| Some mo_det -> Ok {mo_info; mo_det}
This diff is collapsed.
open Js_types
open Metal_types
open Async
class type error_js = object
method code : int Js.readonly_prop
method content : js_string t Js.readonly_prop
end
let log_error e =
let code, content = Async.error_content e in
Js_utils.log "Error %d: %s" code content
let js_error e =
let code, content = Async.error_content e in
object%js
val code = code
val content = string content
end
let (>|?) v f = match v with
| Error e -> log_error e; undefined
| Ok x -> def (f x)
let (>>|?) v f = v >>= function
| Error e -> return (Error (js_error e))
| Ok x -> return (Ok (f x))
class type manager_info = object
method source : js_string t prop
method fee : js_string t optdef prop
method counter : js_string t optdef prop
method gasLimit : js_string t optdef prop
method storageLimit : js_string t optdef prop
end
class type parameter_js = object
method entrypoint : js_string t optdef prop
method value : js_string t optdef prop
end
class type transaction_details_js = object
method destination : js_string t prop
method amount : js_string t prop
method parameters : parameter_js t optdef prop
end
class type script_js = object
method code : js_string t optdef prop
method storage : js_string t prop
method codeHash : js_string t optdef prop
end
class type origination_details_js = object
method balance : js_string t prop
method script : script_js t optdef prop
end
class type reveal_details_js = object
method pubkey : js_string t prop
end
class type delegation_details_js = object
method delegate : js_string t optdef prop
end
class type operation_js = object
inherit manager_info
inherit transaction_details_js
inherit origination_details_js
inherit reveal_details_js
inherit delegation_details_js
method kind : js_string t prop
end
class type config_js = object
method network : js_string t optdef prop
method node : js_string t optdef prop
end
class type inputs_js = object
method config : config_js t optdef prop
method operations : operation_js t js_array t optdef prop
method branch : js_string t optdef prop
method bytes : js_string t optdef prop
method pk : js_string t optdef prop
method sk : js_string t optdef prop
end
type metal_ops =
(notif_manager_info,
(Dune_types_min.account_hash *
(Bigstring.t -> (Bigstring.t, string Async.metal_error) result Lwt.t))
option manager_details)
manager_operation
type inputs = {
base : Js_of_ocaml.Url.url option;
operations : (metal_ops list * string) option;
branch : string option;
bytes : Bigstring.t option;
pk : (unit -> (string, string Async.metal_error) result Lwt.t);
sk : Bigstring.t option;
}
let to_metal (op : operation_js t) =
let mo_info = {
not_mi_fee = to_optdef (fun x -> Int64.of_string @@ to_string x) op##.fee;
not_mi_gas_limit = to_optdef (fun x -> Z.of_string @@ to_string x) op##.gasLimit;
not_mi_storage_limit = to_optdef (fun x -> Z.of_string @@ to_string x) op##.storageLimit;
not_mi_msg = None
} in
let mo_det = match to_string op##.kind with
| "transaction" ->
Some (TraDetails {
trd_dst = to_string op##.destination;
trd_amount = Int64.of_string (to_string op##.amount);
trd_parameters = to_optdef (fun p ->
to_optdef to_string p##.entrypoint,
to_optdef to_string p##.value) op##.parameters
})
| "origination" ->
Some (OriDetails {
ord_balance = Int64.of_string (to_string op##.balance);
ord_script = to_optdef (fun sc ->
to_optdef to_string sc##.code, to_string sc##.storage,
to_optdef to_string sc##.codeHash) op##.script;
ord_delegate = None;
ord_kt1 = None
})
| "reveal" -> Some (RvlDetails (to_string op##.pubkey))
| "delegation" -> Some (DelDetails (to_optdef to_string op##.delegate))
| _ -> None in
match mo_det with
| None -> Error (Async.Str_err "Operation not handled")
| Some mo_det -> Ok {mo_info; mo_det}
let get_node_url (config : config_js t) =
match to_optdef to_string config##.node with
| Some node -> Js_of_ocaml.Url.url_of_string node
| None ->
match to_optdef to_string config##.network with
| Some "mainnet" -> Some (Xhr_lwt.base "mainnet-node.dunscan.io")
| Some "testnet" -> Some (Xhr_lwt.base "testnet-node.dunscan.io")
| _ -> None
let result_optdef res f = match res with
| Ok x -> def (f x)
| Error e -> log_error e; undefined
let opt_exn field = function
| None ->
Js_utils.log "%S field required and not given" field;
assert false
| Some x -> x
let get_inputs (inputs : inputs_js t) =
let base = get_node_url (opt_exn "config" (to_def_option inputs##.config)) in
let operations = to_optdef (fun ops ->
match array_to_list ops with
| [] -> Js_utils.log "Error: No operations given"; [], ""
| (h :: _) as ops ->
let src = to_string h##.source in
match map_res to_metal ops with
| Error e -> log_error e; [], src
| Ok ops -> ops, src) inputs##.operations in
let branch = to_optdef to_string inputs##.branch in
let bytes = to_optdef (fun s -> Forge.of_hex (to_string s)) inputs##.bytes in
let pk = match to_def_option inputs##.pk with
| Some pk -> fun () -> return @@ Ok (to_string pk)
| None -> fun () -> return @@ Error (Str_err "No pubkey given for reveal") in
let sk = to_optdef (fun s -> Crypto.Sk.b58dec @@ to_string s) inputs##.sk in
{ base; operations; branch; bytes; pk; sk }
let sign inputs =
let inputs = get_inputs inputs in
let sk = opt_exn "sk" inputs.sk in
let bytes = opt_exn "bytes" inputs.bytes in
match Forge.sign ~sk bytes with
| None -> undefined
| Some bsig -> def @@ Forge.to_hex bsig
let forge_operation_base inputs =
let inputs = get_inputs inputs in
let ops, src = opt_exn "operations" inputs.operations in
let ops = List.map (To_dune.dune_op_base ~src) ops in
match ops with
| [ op ] ->
result_optdef
(Forge.forge_operation op)
Forge.to_hex
| _ -> Js_utils.log "Error: several operations given"; undefined
let forge_operations_base inputs =
let inputs = get_inputs inputs in
let branch = opt_exn "branch" inputs.branch in
let ops, src = opt_exn "operations" inputs.operations in
let ops = List.map (To_dune.dune_op_base ~src) ops in
result_optdef
(Forge.forge_operations branch ops)
Forge.to_hex
let send_bytes inputs =
let inputs = get_inputs inputs in
let base = opt_exn "config" inputs.base in
let bytes = opt_exn "bytes" inputs.bytes in
Promise_lwt.promise_lwt_res (
Node.inject ~base bytes >>|? fun op_bytes ->
Crypto.Operation_hash.b58enc op_bytes)
let forge_manager_operations inputs =
let inputs = get_inputs inputs in
let base = opt_exn "config" inputs.base in
let get_pk = inputs.pk in
let ops, src = opt_exn "operations" inputs.operations in
Promise_lwt.promise_lwt_res (
Node.forge_manager_operations ~base ~get_pk ~src ops >>|? fun (bytes, _) ->
Forge.to_hex bytes)
let send_manager_operations inputs =
let inputs = get_inputs inputs in
let base = opt_exn "config" inputs.base in
let get_pk = inputs.pk in
let ops, src = opt_exn "operations" inputs.operations in
let sk = opt_exn "sk" inputs.sk in
Promise_lwt.promise_lwt (
(Node.forge_manager_operations ~base ~get_pk ~src ops >>=? fun (bytes, _) ->
match Forge.sign ~sk bytes with
| None -> return (Error (Str_err "Error: signature failed"))
| Some bsig ->
let bytes = Bigstring.concat "" [bytes; bsig] in
Node.inject ~base bytes) >>|? fun op_bytes ->
Crypto.Operation_hash.b58enc op_bytes)
let () =
Js.export "jsdune" @@
object%js
method sign inputs = sign inputs
method forgeOperation0 inputs = forge_operation_base inputs
method forgeOperations0 inputs = forge_operations_base inputs
method forgeOperations inputs = forge_manager_operations inputs
method sendBytes inputs = send_bytes inputs
method sendOperations inputs = send_manager_operations inputs
end
......@@ -6,65 +6,65 @@ let script_to_json ?contract s = match Dune_script.json_of_string ?contract s wi
| Error _ -> s
| Ok s -> s
let dune_op ?sign_target ~src {mo_det; mo_info} =
let dune_op_base ~src {mo_det; mo_info} =
let fee = Misc.unopt 0L mo_info.not_mi_fee in
let gas_limit = Misc.unopt Z.zero mo_info.not_mi_gas_limit in
let storage_limit = Misc.unopt Z.zero mo_info.not_mi_storage_limit in
let counter = Z.zero in
match mo_det with
| TraDetails trd ->
return (Ok (NTransaction {
node_tr_src = src;
node_tr_fee = fee;
node_tr_counter = counter;
node_tr_gas_limit = gas_limit;
node_tr_storage_limit = storage_limit;
node_tr_amount = trd.trd_amount;
node_tr_dst = trd.trd_dst;
node_tr_collect_fee_gas = None;
node_tr_collect_pk = None;
node_tr_entrypoint = Misc.unoptf None fst trd.trd_parameters;
node_tr_parameters =
Misc.unoptf None (fun (_e, v) ->
Misc.convopt script_to_json v)
trd.trd_parameters;
node_tr_metadata = None;
}))
NTransaction {
node_tr_src = src;
node_tr_fee = fee;
node_tr_counter = counter;
node_tr_gas_limit = gas_limit;
node_tr_storage_limit = storage_limit;
node_tr_amount = trd.trd_amount;
node_tr_dst = trd.trd_dst;
node_tr_collect_fee_gas = None;
node_tr_collect_pk = None;
node_tr_entrypoint = Misc.unoptf None fst trd.trd_parameters;
node_tr_parameters =
Misc.unoptf None (fun (_e, v) ->
Misc.convopt script_to_json v)
trd.trd_parameters;
node_tr_metadata = None;
}
| OriDetails ord ->
return (Ok (NOrigination {
node_or_src = src;
node_or_fee = fee;
node_or_counter = counter;
node_or_gas_limit = gas_limit;
node_or_storage_limit = storage_limit;
node_or_balance = ord.ord_balance;
node_or_script = Misc.convopt (fun (sc_code, sc_storage, sc_code_hash) ->
let sc_code = Misc.convopt (script_to_json ~contract:true) sc_code in
let sc_storage = script_to_json sc_storage in
{sc_code; sc_storage; sc_code_hash}) ord.ord_script;
node_or_metadata = None ;
}))
NOrigination {
node_or_src = src;
node_or_fee = fee;
node_or_counter = counter;
node_or_gas_limit = gas_limit;
node_or_storage_limit = storage_limit;
node_or_balance = ord.ord_balance;
node_or_script = Misc.convopt (fun (sc_code, sc_storage, sc_code_hash) ->
let sc_code = Misc.convopt (script_to_json ~contract:true) sc_code in
let sc_storage = script_to_json sc_storage in
{sc_code; sc_storage; sc_code_hash}) ord.ord_script;
node_or_metadata = None ;
}
| DelDetails del ->
return (Ok (NDelegation {
node_del_src = src;
node_del_fee = fee;
node_del_counter = counter;
node_del_gas_limit = gas_limit;
node_del_storage_limit = storage_limit;
node_del_delegate = del;
node_del_metadata = None;
}))
NDelegation {
node_del_src = src;
node_del_fee = fee;
node_del_counter = counter;
node_del_gas_limit = gas_limit;
node_del_storage_limit = storage_limit;
node_del_delegate = del;
node_del_metadata = None;
}
| RvlDetails pk ->
return (Ok (NReveal {
node_rvl_src = src;
node_rvl_fee = fee;
node_rvl_counter = counter;
node_rvl_gas_limit = gas_limit;
node_rvl_storage_limit = storage_limit;
node_rvl_pubkey = pk;
node_rvl_metadata = None;
}))
| ManDetails (target, options) ->
NReveal {
node_rvl_src = src;
node_rvl_fee = fee;
node_rvl_counter = counter;
node_rvl_gas_limit = gas_limit;
node_rvl_storage_limit = storage_limit;
node_rvl_pubkey = pk;
node_rvl_metadata = None;
}
| ManDetails (_target, options) ->
let node_mac_options = match options with
| MadJSON json -> MaoJSON json
| MadDecoded mao -> MaoDecoded {
......@@ -75,19 +75,25 @@ let dune_op ?sign_target ~src {mo_det; mo_info} =
node_mao_recovery = mao.mao_recovery;
node_mao_actions = mao.mao_actions;
} in
NManage_account {
node_mac_src = src;
node_mac_fee = fee;
node_mac_counter = counter;
node_mac_gas_limit = gas_limit;
node_mac_storage_limit = storage_limit;
node_mac_target = None;
node_mac_metadata = None;
node_mac_options;
}
let dune_op ?sign_target ~src {mo_det; mo_info} =
match dune_op_base ~src {mo_det; mo_info}, mo_det with
| NManage_account mac, ManDetails (target, _options) ->
(match sign_target with
| Some sign -> sign node_mac_options target
| _ -> return (Ok None)) >>|? (fun node_mac_target ->
NManage_account {
node_mac_src = src;
node_mac_fee = fee;
node_mac_counter = counter;
node_mac_gas_limit = gas_limit;
node_mac_storage_limit = storage_limit;
node_mac_target = node_mac_target;
node_mac_metadata = None;
node_mac_options;
})
| Some sign -> sign mac.node_mac_options target
| _ -> return (Ok None)) >>|? fun node_mac_target ->
NManage_account {mac with node_mac_target}
| op, _ -> return (Ok op)
let dune_ops ?sign_target ~src ops =
map_res_s (dune_op ?sign_target ~src) ops
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment