Commit 4b9d4a87 authored by Max's avatar Max

Merge branch 'prepare-batch' into 'next'

Prepare batch

See merge request !42
parents 1e3e8124 531f6c6d
......@@ -9,7 +9,7 @@ PKG js_of_ocaml-ppx
PKG js_of_ocaml-lwt
PKG zarith
PKG ocplib-compat
PKG ocplib-json-typed-bson
PKG bigstring
PKG digestif
PKG ocplib-endian.bigstring
PKG ocplib-json-typed-bson
\ No newline at end of file
PKG digestif.ocaml
PKG ocplib-endian.bigstring
\ No newline at end of file
......@@ -346,7 +346,7 @@ let dispatch (port : Runtime_utils.port t) (msg : message t) =
| None -> ()
(* Error gestion ?, this should not happen because
the extension can't be enabled without an account *)
| Some acc -> send port req @@ (Storage_utils.of_account acc)##.pkh) in
| Some acc -> send port req @@ string acc.pkh) in
wrap_handler port req f
| "get_network" ->
let f () =
......@@ -366,7 +366,7 @@ let dispatch (port : Runtime_utils.port t) (msg : message t) =
| Some _ -> send port req @@ string "ID already used"
| None ->
let f () =
match check_manager_operation ~kind:meth data with
match check_manager_operation data with
| Ok () ->
pending_op := (id, data) :: !pending_op;
Notification.show_popup_action ~id port (fun () -> ()) meth
......
(*****************************************************************************)
(* *)
(* MIT License *)
(* *)
(* Copyright (c) 2019 Origin Labs - [email protected] *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining *)
(* a copy of this software and associated documentation files (the *)
(* "Software"), to deal in the Software without restriction, including *)
(* without limitation the rights to use, copy, modify, merge, publish, *)
(* distribute, sublicense, and/or sell copies of the Software, and to *)
(* permit persons to whom the Software is furnished to do so, subject to *)
(* the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be *)
(* included in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *)
(* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *)
(* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *)
(* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE *)
(* LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION *)
(* OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION *)
(* WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
exception Forge_error of string
let int16 _ = 2
let int32 _ = 4
let int64 _ = 8
let char _ = 1
let bool _ = 1
let list l = List.fold_left (+) 0 l
let chars l = List.length l
let opt f x = 1 + f x
let n_zarith z =
let bits = Z.numbits z in
if bits = 0 then 1 else (bits + 6) / 7
let n_int64 i = n_zarith (Z.of_int64 i)
let zarith z = (Z.numbits z + 1 + 6) / 7
let elem x = 4 + x
let pkh _ = 21
let contract _ = 22
let source_manager _ = 21
let pk s =
if String.length s < 4 then
raise @@ Forge_error (Printf.sprintf "wrong format for pk: %S" s)
else match String.sub s 0 4 with
| "edpk" -> 33
| _ -> 34
let branch _ = 32
let signature _ = 64
let script_expr_hash _ = 32
......@@ -2,5 +2,5 @@ ocaml.has_asm = false;
OCaml.library("metal-binary", ocaml+{
requires = [ "crypto"; "ocplib-endian" ];
files = [ "mBytes.ml"; "binary_reader.ml"; "binary_writer.ml" ]
files = [ "mBytes.ml"; "binary_reader.ml"; "binary_writer.ml"; "binary_size.ml" ]
});
\ No newline at end of file
......@@ -35,6 +35,7 @@ type 'a metal_error =
| Exn_err of exn list
let (>>=) = Lwt.(>>=)
let (>|=) = Lwt.(>|=)
let return = Lwt.return
let return_unit = Lwt.return_unit
let async = Lwt.async
......@@ -54,19 +55,22 @@ let wrap_err_end f = function
| Error e -> return (Error e)
| Ok x -> return (Ok (f x))
(* ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c * 'b) result *)
let (>>?) v f =
match v with
| Error _ as err -> err
| Ok v -> f v
(* ('a, 'b) result lwt -> ('a -> ('c, 'b) result lwt) -> ('c * 'b) result lwt *)
let (>>=?) v f =
v >>= function
| Error _ as err -> Lwt.return err
| Ok v -> f v
(* ('a, 'b) result lwt -> ('a -> 'c) -> ('c * 'b) result lwt *)
let (>>|?) v f = v >>=? fun v -> Lwt.return (Ok (f v))
let (>|=) = Lwt.(>|=)
(* ('a, 'b) result -> ('a -> 'c) -> ('c * 'b) result *)
let (>|?) v f = v >>? fun v -> Ok (f v)
......@@ -97,3 +101,53 @@ let async0 p update =
let async0_opt ?callback p =
async0 p (match callback with None -> (fun _ -> ()) | Some callback -> callback)
let map_res f l =
match List.fold_left (fun acc x -> match acc with
| Error e -> Error e
| Ok acc -> match f x with
| Error e -> Error e
| Ok x -> Ok (x :: acc)) (Ok []) l with
| Error e -> Error e
| Ok l -> Ok (List.rev l)
let mapi_res f l =
match List.fold_left (fun (i, acc) x -> match acc with
| Error e -> i+1, Error e
| Ok acc -> match f i x with
| Error e -> i+1, Error e
| Ok x -> i+1, Ok (x :: acc)) (0, Ok []) l with
| _, Error e -> Error e
| _, Ok l -> Ok (List.rev l)
let map2_res f l1 l2 =
match List.fold_left2 (fun acc x1 x2 -> match acc with
| Error e -> Error e
| Ok acc -> match f x1 x2 with
| Error e -> Error e
| Ok x -> Ok (x :: acc)) (Ok []) l1 l2 with
| Error e -> Error e
| Ok l -> Ok (List.rev l)
let map2i_res f l1 l2 =
match List.fold_left2 (fun (i, acc) x1 x2 -> match acc with
| Error e -> i+1, Error e
| Ok acc -> match f i x1 x2 with
| Error e -> i+1, Error e
| Ok x -> i+1, Ok (x :: acc)) (0, Ok []) l1 l2 with
| _, Error e -> Error e
| _, Ok l -> Ok (List.rev l)
let map_res_s f l =
Lwt_list.fold_left_s (fun acc x -> match acc with
| Error e -> return (Error e)
| Ok acc -> f x >>|? fun r -> r :: acc) (Ok []) l >>|? fun l ->
List.rev l
let mapi_res_s f l =
Lwt_list.fold_left_s (fun (i, acc) x -> match acc with
| Error e -> return (i+1, Error e)
| Ok acc -> f i x >>= function
| Error e -> return (i+1, Error e)
| Ok r -> return (i+1, Ok (r :: acc))) (0, Ok []) l >|= snd >>|?
List.rev
......@@ -4,14 +4,19 @@ ppx_js = [
pp_js = { pp = ppx_js };
OCaml.library("metal-misc", ocaml+ {
requires = [];
files = ["misc.ml"]
});
OCaml.library("metal-common", ocaml+ {
requires = [
"metal-misc";
"bigstring";
"dunscan-encoding-min";
"ocplib-chrome";
];
files = [
"misc.ml";
"metal_types.ml";
"metal_encoding.ml";
"mhelpers.ml";
......
......@@ -2,10 +2,6 @@ module Dune = Dune_types_min
module Metal = Metal_types
open Dune
let convopt f = function
| None -> None
| Some x -> Some (f x)
let dune_errors = function
| None -> None
| Some meta -> match meta.manager_meta_operation_result with
......@@ -58,8 +54,6 @@ let dune_burn meta =
let burn = Int64.add (get_burn meta) (get_internal_burn meta) in
if burn = 0L then None else Some burn
let dune_delegate s = if s = "" then None else Some s
let dune_op ?op_bytes = function
| NTransaction tr -> Some {
Metal.mo_info = {
......@@ -118,9 +112,11 @@ let dune_op ?op_bytes = function
mi_errors = dune_errors del.node_del_metadata ;
mi_failed = dune_failed del.node_del_metadata;
mi_internal = del.node_del_counter = Z.minus_one};
mo_det = Metal.DelDetails (dune_delegate del.node_del_delegate)
mo_det = Metal.DelDetails del.node_del_delegate
}
| NManage_account mac -> Some {
| NManage_account mac ->
let target = Misc.convopt fst mac.node_mac_target in
Some {
Metal.mo_info = {
Metal.mi_source = mac.node_mac_src;
mi_fee = Some mac.node_mac_fee;
......@@ -131,7 +127,8 @@ let dune_op ?op_bytes = function
mi_errors = dune_errors mac.node_mac_metadata ;
mi_failed = dune_failed mac.node_mac_metadata ;
mi_internal = mac.node_mac_counter = Z.minus_one};
mo_det = Metal.ManDetails (match mac.node_mac_options with
mo_det = Metal.ManDetails (
target, match mac.node_mac_options with
| MaoDecoded mao -> Metal.MadDecoded {
Metal.mao_maxrolls = mao.node_mao_maxrolls;
mao_admin = mao.node_mao_admin;
......@@ -140,8 +137,7 @@ let dune_op ?op_bytes = function
mao_recovery = mao.node_mao_recovery;
mao_actions = mao.node_mao_actions;
}
| MaoJSON s -> Metal.MadJSON s
)
| MaoJSON s -> Metal.MadJSON s)
}
| _ -> None
......
......@@ -84,7 +84,9 @@ let dunscan_mo = function
rvl.rvl_timestamp, rvl.rvl_op_level
let dunscan_mo_dune = function
| Manage_account mac -> Some ({
| Manage_account mac ->
let target = Misc.convopt (fun ({dn; _}, _) -> dn) mac.mac_target in
Some ({
Metal.mi_source = mac.mac_src.dn;
mi_fee = Some mac.mac_fee;
mi_counter = Some (Int32.to_int mac.mac_counter);
......@@ -94,15 +96,15 @@ let dunscan_mo_dune = function
mi_errors = dunscan_errors mac.mac_errors;
mi_failed = mac.mac_failed;
mi_internal = mac.mac_internal},
Metal.ManDetails (Metal.MadDecoded {
Metal.mao_maxrolls = mac.mac_maxrolls;
mao_admin = convopt (convopt (fun {dn; _} -> dn)) mac.mac_admin;
mao_white_list = convopt (List.map (fun {dn; _} -> dn)) mac.mac_white_list;
mao_delegation = mac.mac_delegation;
mao_recovery = convopt (convopt (fun {dn; _} -> dn)) mac.mac_recovery;
mao_actions = match mac.mac_actions with None -> [] | Some l -> l;
}),
mac.mac_timestamp, mac.mac_op_level)
Metal.ManDetails (target, Metal.MadDecoded {
Metal.mao_maxrolls = mac.mac_maxrolls;
mao_admin = convopt (convopt (fun {dn; _} -> dn)) mac.mac_admin;
mao_white_list = convopt (List.map (fun {dn; _} -> dn)) mac.mac_white_list;
mao_delegation = mac.mac_delegation;
mao_recovery = convopt (convopt (fun {dn; _} -> dn)) mac.mac_recovery;
mao_actions = match mac.mac_actions with None -> [] | Some l -> l;
}),
mac.mac_timestamp, mac.mac_op_level)
| _ -> None
let dunscan_op {op_hash; op_block_hash; op_network_hash; op_type} =
......
......@@ -56,7 +56,7 @@ type origination_details = {
ord_script : (string option * string * string option) option;
}
type manage_account_options = {
type manage_account_decoded_options = {
mao_maxrolls : int option option;
mao_admin : account_hash option option;
mao_white_list : account_hash list option;
......@@ -65,16 +65,16 @@ type manage_account_options = {
mao_actions : (string * string) list;
}
type manage_account_details =
| MadDecoded of manage_account_options
type manage_account_options =
| MadDecoded of manage_account_decoded_options
| MadJSON of string
type manager_details =
type 'a manager_details =
| TraDetails of transaction_details
| OriDetails of origination_details
| DelDetails of account_hash option
| RvlDetails of string
| ManDetails of manage_account_details
| ManDetails of ('a * manage_account_options)
type op_error = {
err_kind: string;
......@@ -126,7 +126,7 @@ type notif_op = {
not_tsp : string;
not_id : string;
not_wid : int;
not_op : (notif_manager_info, manager_details) manager_operation;
not_op : (notif_manager_info, string option manager_details) manager_operation;
}
type notif_app = {
......@@ -154,8 +154,8 @@ type account = {
vault : vault;
name : string;
revealed : operation_hash network_assoc;
pending : (manager_info, manager_details) manager_operation list block_operation list network_assoc;
history : (manager_info, manager_details) manager_operation list block_operation list network_assoc;
pending : (manager_info, string option manager_details) manager_operation list block_operation list network_assoc;
history : (manager_info, string option manager_details) manager_operation list block_operation list network_assoc;
manager_kt : bool option;
admin : account_hash network_assoc;
}
......
......@@ -66,7 +66,7 @@ let state_of_string = function
let failed_opt ?(failed=false) op =
if not failed && op.mo_info.mi_failed then None else Some op
let transaction_opt ?failed (op : ('a, manager_details) manager_operation) =
let transaction_opt ?failed op =
match failed_opt ?failed op with
| Some ({mo_det = (TraDetails mo_det); _} as op) -> Some { op with mo_det }
| _ -> None
......@@ -134,7 +134,7 @@ let make_notif_approv ~id ~wid ~tsp ~icon ~name ~url =
let notarization_contract = function
| Mainnet -> Some "KT1QbLD53PQqB67SB3GK3u8Qi6TbmwjVH2bd"
| Testnet -> Some "KT1Vqcie56z2CqgNVhULck8FjUgsnxK2MYom"
| Testnet -> Some "KT1Cyi3TgHiZuycWXuCdXX9mDJoHfbQnuWah"
| _ -> None
let opt_network_assoc network a = List.assoc_opt network a
......
......@@ -35,6 +35,10 @@ let unopt def = function
| None -> def
| Some x -> x
let unopt_exn = function
| None -> assert false
| Some x -> x
let convopt f = function
| None -> None
| Some x -> Some (f x)
......
......@@ -26,7 +26,9 @@ OCaml.library("dune-encoding-min", ocaml + {
"dune-types-min";
"ez-encoding";
"love-json";
"micheline-encoding" ]
"micheline-encoding";
"metal-misc";
"metal-async"]
});
OCaml.library("dune-min", ocaml + {
......
......@@ -295,10 +295,11 @@ module Protocol_param = struct
endorsement_security_deposit_opt; block_reward_opt;
endorsement_reward_opt; cost_per_byte_opt;
hard_storage_limit_per_operation_opt; hard_gas_limit_to_pay_fees_opt;
max_operation_ttl_opt; protocol_revision_opt;
max_operation_ttl_opt;
frozen_account_cycles_opt; allow_collect_call_opt;
quorum_min_opt; quorum_max_opt; min_proposal_quorum_opt;
initial_endorsers_opt; delay_per_missing_endorsement_opt }
initial_endorsers_opt; delay_per_missing_endorsement_opt;
protocol_revision; protocol_actions}
-> ((proof_of_work_nonce_size_opt, nonce_length_opt, max_revelations_per_block_opt,
max_operation_data_length_opt, max_proposals_per_delegate_opt,
preserved_cycles_opt, blocks_per_cycle_opt, blocks_per_commitment_opt,
......@@ -311,10 +312,11 @@ module Protocol_param = struct
endorsement_security_deposit_opt, block_reward_opt, endorsement_reward_opt,
cost_per_byte_opt),
(hard_storage_limit_per_operation_opt,
hard_gas_limit_to_pay_fees_opt, max_operation_ttl_opt, protocol_revision_opt,
hard_gas_limit_to_pay_fees_opt, max_operation_ttl_opt,
frozen_account_cycles_opt, allow_collect_call_opt,
quorum_min_opt, quorum_max_opt, min_proposal_quorum_opt,
initial_endorsers_opt, delay_per_missing_endorsement_opt)))
initial_endorsers_opt, delay_per_missing_endorsement_opt,
protocol_revision, protocol_actions)))
(fun ((proof_of_work_nonce_size_opt, nonce_length_opt, max_revelations_per_block_opt,
max_operation_data_length_opt, max_proposals_per_delegate_opt,
preserved_cycles_opt, blocks_per_cycle_opt, blocks_per_commitment_opt,
......@@ -327,10 +329,11 @@ module Protocol_param = struct
endorsement_security_deposit_opt, block_reward_opt, endorsement_reward_opt,
cost_per_byte_opt),
(hard_storage_limit_per_operation_opt,
hard_gas_limit_to_pay_fees_opt, max_operation_ttl_opt, protocol_revision_opt,
hard_gas_limit_to_pay_fees_opt, max_operation_ttl_opt,
frozen_account_cycles_opt, allow_collect_call_opt,
quorum_min_opt, quorum_max_opt, min_proposal_quorum_opt,
initial_endorsers_opt, delay_per_missing_endorsement_opt))
initial_endorsers_opt, delay_per_missing_endorsement_opt,
protocol_revision, protocol_actions))
-> { proof_of_work_nonce_size_opt; nonce_length_opt; max_revelations_per_block_opt;
max_operation_data_length_opt; max_proposals_per_delegate_opt;
preserved_cycles_opt; blocks_per_cycle_opt; blocks_per_commitment_opt;
......@@ -342,10 +345,11 @@ module Protocol_param = struct
origination_size_opt; block_security_deposit_opt;
endorsement_security_deposit_opt; block_reward_opt; endorsement_reward_opt;
cost_per_byte_opt; hard_storage_limit_per_operation_opt;
hard_gas_limit_to_pay_fees_opt; max_operation_ttl_opt; protocol_revision_opt;
hard_gas_limit_to_pay_fees_opt; max_operation_ttl_opt;
frozen_account_cycles_opt; allow_collect_call_opt;
quorum_min_opt; quorum_max_opt; min_proposal_quorum_opt;
initial_endorsers_opt; delay_per_missing_endorsement_opt })
initial_endorsers_opt; delay_per_missing_endorsement_opt;
protocol_revision; protocol_actions})
(merge_objs
(EzEncoding.obj24
(opt "proof_of_work_nonce_size" int)
......@@ -372,18 +376,19 @@ module Protocol_param = struct
(opt "block_reward" int64)
(opt "endorsement_reward" int64)
(opt "cost_per_byte" int64))
(EzEncoding.obj11
(EzEncoding.obj12
(opt "hard_storage_limit_per_operation" int64)
(opt "hard_gas_limit_to_pay_fees" int64)
(opt "max_operation_ttl" int)
(opt "protocol_revision" int)
(opt "frozen_account_cycles" int)
(opt "allow_collect_call" bool)
(opt "quorum_min" int)
(opt "quorum_max" int)
(opt "min_proposal_quorum" int)
(opt "initial_endorsers" int)
(opt "delay_per_missing_endorsement" int_of_string)))
(opt "delay_per_missing_endorsement" int_of_string)
(opt "protocol_revision" int)
(dft "protocol_actions" (list string) [])))
end
module Header = struct
......@@ -702,15 +707,12 @@ module Operation = struct
node_del_storage_limit = _ ;
node_del_delegate ;
node_del_metadata} ->
let node_del_delegate =
if node_del_delegate = "" then None else Some node_del_delegate in
let result = match node_del_metadata with
None -> None
| Some m -> m.manager_meta_operation_result
in
((), node_del_src, ~-1, node_del_delegate, result))
(fun ((), node_del_src, _nonce, node_del_delegate, result) ->
let node_del_delegate = Dune_utils.unopt node_del_delegate ~default:"" in
{ node_del_src ;
node_del_fee = Int64.minus_one ;
node_del_counter = Z.minus_one ;
......@@ -867,13 +869,10 @@ module Operation = struct
(fun { node_del_src ; node_del_fee ; node_del_counter ; node_del_gas_limit ;
node_del_storage_limit ; node_del_delegate ;
node_del_metadata } ->
let node_del_delegate =
if node_del_delegate = "" then None else Some node_del_delegate in
((node_del_src, node_del_fee, node_del_counter, node_del_gas_limit,
node_del_storage_limit), ((), node_del_delegate, node_del_metadata)))
(fun ((node_del_src, node_del_fee, node_del_counter, node_del_gas_limit,
node_del_storage_limit), ((), node_del_delegate, node_del_metadata)) ->
let node_del_delegate = Dune_utils.unopt node_del_delegate ~default:"" in
{ node_del_src ; node_del_fee ; node_del_counter ; node_del_gas_limit ;
node_del_storage_limit ; node_del_delegate ; node_del_metadata }))
(merge_objs
......
......@@ -261,7 +261,6 @@ type activate_protocol_param = {
hard_storage_limit_per_operation_opt: int64 option;
hard_gas_limit_to_pay_fees_opt: int64 option;
max_operation_ttl_opt: int option;
protocol_revision_opt: int option;
frozen_account_cycles_opt: int option;
allow_collect_call_opt: bool option;
quorum_min_opt: int option;
......@@ -269,6 +268,8 @@ type activate_protocol_param = {
min_proposal_quorum_opt: int option;
initial_endorsers_opt: int option;
delay_per_missing_endorsement_opt: int option;
protocol_revision: int option;
protocol_actions: string list;
}
type manage_account_options_decoded = {
......@@ -322,7 +323,7 @@ and node_delegation = {
node_del_counter : Z.t ;
node_del_gas_limit : Z.t ;
node_del_storage_limit : Z.t ;
node_del_delegate : account_hash ;
node_del_delegate : account_hash option;
node_del_metadata : manager_metadata option ;
}
......
......@@ -87,51 +87,121 @@ let string_of_balance_update = function
| Fees (s, i1, i2) -> Printf.sprintf "Fees %s %d %Ld" s i1 i2
| Deposits (s, i1, i2) -> Printf.sprintf "Deposits %s %d %Ld" s i1 i2
let limits_of_operation = function
| NTransaction { node_tr_fee = f;
node_tr_gas_limit = g;
node_tr_storage_limit = s; _ }
| NOrigination { node_or_fee = f;
node_or_gas_limit = g;
node_or_storage_limit = s; _ }
| NReveal { node_rvl_fee = f;
node_rvl_gas_limit = g;
node_rvl_storage_limit = s; _ }
| NDelegation { node_del_fee = f;
node_del_gas_limit = g;
node_del_storage_limit = s; _ }
| NActivate_protocol { node_acp_fee = f;
node_acp_gas_limit = g;
node_acp_storage_limit = s; _ }
| NManage_accounts { node_macs_fee = f;
node_macs_gas_limit = g;
node_macs_storage_limit = s; _ } ->
Some (f, g, s)
| NManage_account { node_mac_fee = f;
node_mac_gas_limit = g;
node_mac_storage_limit = s; _ } ->
Some (f, g, s)
| NClearDelegations { node_cld_fee = f;
node_cld_gas_limit = g;
node_cld_storage_limit = s; _ } ->
| NTransaction {node_tr_fee = f; node_tr_gas_limit = g; node_tr_storage_limit = s; _}
| NOrigination {node_or_fee = f; node_or_gas_limit = g; node_or_storage_limit = s; _}
| NReveal {node_rvl_fee = f; node_rvl_gas_limit = g; node_rvl_storage_limit = s; _}
| NDelegation {node_del_fee = f; node_del_gas_limit = g; node_del_storage_limit = s; _}
| NActivate_protocol {node_acp_fee = f; node_acp_gas_limit = g; node_acp_storage_limit = s; _}
| NManage_accounts {node_macs_fee = f; node_macs_gas_limit = g; node_macs_storage_limit = s; _}
| NManage_account {node_mac_fee = f; node_mac_gas_limit = g; node_mac_storage_limit = s; _}
| NClearDelegations {node_cld_fee = f; node_cld_gas_limit = g; node_cld_storage_limit = s; _} ->
Some (f, g, s)
| NSeed_nonce_revelation _
| NActivation _
| NDouble_endorsement_evidence _
| NDouble_baking_evidence _
| NEndorsement _
| NProposals _
| NBallot _
| NActivate
| NActivate_testnet -> None
| _ -> None
let limits_of_operation_exn op =
Misc.unopt_exn @@ limits_of_operation op
let limits_of_operations ops =
List.fold_left (fun (acc_f, acc_g, acc_s) op ->
match limits_of_operation op with
| None -> (acc_f, acc_g, acc_s)
| Some (f, g, s) ->
Int64.add f acc_f,
Z.add g acc_g,
Z.add s acc_s
) (0L, Z.zero, Z.zero) ops
let (f, g, s) = Misc.unopt (0L, Z.zero, Z.zero) (limits_of_operation op) in
Int64.add acc_f f, Z.add acc_g g, Z.add acc_s s) (0L, Z.zero, Z.zero) ops
let get_manager_metadata = function
| NTransaction { node_tr_metadata = meta; _}
| NOrigination { node_or_metadata = meta; _}
| NReveal { node_rvl_metadata = meta; _}
| NDelegation { node_del_metadata = meta; _}
| NActivate_protocol { node_acp_metadata = meta; _}
| NManage_accounts { node_macs_metadata = meta; _}
| NManage_account { node_mac_metadata = meta; _}
| NClearDelegations { node_cld_metadata = meta; _} -> meta
| _ -> None
let get_manager_counter = function
| NTransaction { node_tr_counter = counter; _}
| NOrigination { node_or_counter = counter; _}
| NReveal { node_rvl_counter = counter; _}
| NDelegation { node_del_counter = counter; _}
| NActivate_protocol { node_acp_counter = counter; _}
| NManage_accounts { node_macs_counter = counter; _}
| NManage_account { node_mac_counter = counter; _}
| NClearDelegations { node_cld_counter = counter; _} -> Some counter
| _ -> None
let update_limits ?fee ?gas_limit ?storage_limit op =
let diff_size = match limits_of_operation op with
| None -> 0
| Some (f, g, s) ->
(Misc.unoptf 0 (fun fee -> Binary_size.n_int64 fee - Binary_size.n_int64 f) fee) +
(Misc.unoptf 0 (fun gas -> Binary_size.n_zarith gas - Binary_size.n_zarith g) gas_limit) +
(Misc.unoptf 0 (fun storage -> Binary_size.n_zarith storage - Binary_size.n_zarith s) storage_limit) in
let op = match op with
| NTransaction tr ->
let node_tr_fee = Misc.unopt tr.node_tr_fee fee in
let node_tr_gas_limit = Misc.unopt tr.node_tr_gas_limit gas_limit in
let node_tr_storage_limit = Misc.unopt tr.node_tr_storage_limit storage_limit in
NTransaction {tr with node_tr_fee; node_tr_gas_limit; node_tr_storage_limit}
| NOrigination ori ->
let node_or_fee = Misc.unopt ori.node_or_fee fee in
let node_or_gas_limit = Misc.unopt ori.node_or_gas_limit gas_limit in
let node_or_storage_limit = Misc.unopt ori.node_or_storage_limit storage_limit in
NOrigination {ori with node_or_fee; node_or_gas_limit; node_or_storage_limit}
| NDelegation del ->
let node_del_fee = Misc.unopt del.node_del_fee fee in
let node_del_gas_limit = Misc.unopt del.node_del_gas_limit gas_limit in
let node_del_storage_limit = Misc.unopt del.node_del_storage_limit storage_limit in
NDelegation {del with node_del_fee; node_del_gas_limit; node_del_storage_limit}
| NReveal rvl ->
let node_rvl_fee = Misc.unopt rvl.node_rvl_fee fee in
let node_rvl_gas_limit = Misc.unopt rvl.node_rvl_gas_limit gas_limit in
let node_rvl_storage_limit = Misc.unopt rvl.node_rvl_storage_limit storage_limit in
NReveal {rvl with node_rvl_fee; node_rvl_gas_limit; node_rvl_storage_limit}
| NActivate_protocol acp ->
let node_acp_fee = Misc.unopt acp.node_acp_fee fee in
let node_acp_gas_limit = Misc.unopt acp.node_acp_gas_limit gas_limit in
let node_acp_storage_limit = Misc.unopt acp.node_acp_storage_limit storage_limit in
NActivate_protocol {acp with node_acp_fee; node_acp_gas_limit; node_acp_storage_limit}
| NManage_accounts macs ->
let node_macs_fee = Misc.unopt macs.node_macs_fee fee in
let node_macs_gas_limit = Misc.unopt macs.node_macs_gas_limit gas_limit in
let node_macs_storage_limit = Misc.unopt macs.node_macs_storage_limit storage_limit in
NManage_accounts {macs with node_macs_fee; node_macs_gas_limit; node_macs_storage_limit}
| NManage_account mac ->
let node_mac_fee = Misc.unopt mac.node_mac_fee fee in
let node_mac_gas_limit = Misc.unopt mac.node_mac_gas_limit gas_limit in
let node_mac_storage_limit = Misc.unopt mac.node_mac_storage_limit storage_limit in
NManage_account {mac with node_mac_fee; node_mac_gas_limit; node_mac_storage_limit}
| op -> op in
Printf.printf "DIFF SIZE %d\n%!" diff_size;
op, diff_size
let update_counter counter = function
| NTransaction tr -> NTransaction {tr with node_tr_counter = counter}
| NOrigination ori -> NOrigination {ori with node_or_counter = counter}
| NDelegation del -> NDelegation {del with node_del_counter = counter}
| NReveal rvl -> NReveal {rvl with node_rvl_counter = counter}
| NActivate_protocol acp -> NActivate_protocol {acp with node_acp_counter = counter}
| NManage_accounts macs -> NManage_accounts {macs with node_macs_counter = counter}
| NManage_account mac -> NManage_account {mac with node_mac_counter = counter}
| op -> op
let update_counters counter ops =
let _, l = List.fold_left (fun (counter, acc) op ->
Z.succ counter, update_counter counter op :: acc) (Z.succ counter, []) ops in
List.rev l
let node_errors_to_string status errors =
let status = Misc.unopt "none" status in
Format.kasprintf (fun s -> Error (Async.Str_err s))
"@[<v>\
Status: %[email protected],\
@[<v 2>Errors:@,%[email protected]]\
@]"
status
(Format.pp_print_list (fun ppf err ->
Format.fprintf ppf "- %s (%s) : %s"
err.node_err_kind
err.node_err_id
err.node_err_info
)) errors
......@@ -58,46 +58,27 @@ module ENode = struct
get_node_base_url network (fun base ->
async_req ?error (Node.get_entrypoints ~base pkh) f)
let forge_transaction ?(network=Mainnet) ?counter ?gas_limit ?storage_limit
?fee ?entrypoint ?parameters account dst amount =
let get_pk () = Vault.Lwt.pk_of_vault account in
get_node_base_url_lwt network >>= fun base ->
Node.forge_transaction ~base ?counter ?gas_limit
?storage_limit ?fee ?entrypoint ?parameters ~get_pk
~src:account.pkh ~dst amount
let forge_delegation ?(network=Mainnet) ?counter ?gas_limit ?storage_limit
?fee account dlg =
let get_pk () = Vault.Lwt.pk_of_vault account in
get_node_base_url_lwt network >>= fun base ->
Node.forge_delegation ~