...
 
Commits (26)
......@@ -10,7 +10,6 @@ PKG js_of_ocaml-lwt
PKG zarith
PKG ocplib-compat
PKG bigstring
PKG ocplib-json-typed
PKG nocrypto
PKG ocplib-json-typed-bson
PKG digestif
PKG ocplib-endian.bigstring
\ No newline at end of file
beta4 - 05 / 02 / 20
New / Improved Features:
- Babylon+ support (KT1 that becomes manager contract can send / delegate tokens)
- allow unsetting of delegates
- manage account operation (max_roll, whitelist, etc)
- support of entrypoint in contract call
Misc:
- first version for firefox
- update manifest for store listing process
beta3 - 17 / 12 / 19
New / Improved Features :
......
......@@ -21,12 +21,33 @@ Do not forget to follow our related social media accounts:
## Building
You need OCaml 4.07.1.
First install the dependencies:
# System dependencies
```
$ sudo apt-get install git make curl m4 gcc libgeoip-dev libgmp-dev pkg-config libcurl4-gnutls-dev npm
```
# OPAM install and setup
```
$ sh <(curl -sL https://raw.githubusercontent.com/ocaml/opam/master/shell/install.sh)
$ opam init -y --bare
```
# Sass install
```
$ sudo npm install -g sass
```
# OCaml dependencies
Install ocaml dependencies using opam from metal directory
```
$ make build-deps
$ eval $(opam env)
```
Then initialize the submodule:
......
......@@ -24,6 +24,7 @@ function js_program(name, file, libs){
"+nat.js";
"../../js-external-deps/zarith.js";
"../../js-external-deps/hacl.js";
"../../js-external-deps/cstruct.js";
"%{" + name + "_FULL_DST_DIR}%/" + name + ".byte";
])]}]
});
......
//Provides: caml_fill_bigstring
//Requires: caml_ba_set_1
function caml_fill_bigstring(buf, buf_off, buf_len, v) {
var i;
for (i = 0; i < buf_len; i++) {
caml_ba_set_1(buf, buf_off + i, v);
}
return 0;
}
......@@ -25,6 +25,11 @@ function ml_z_div(z1, z2) {
return z1 / z2;
}
//Provides: ml_z_rem const
function ml_z_rem(z1, z2) {
return z1 % z2;
}
//Provides: ml_z_div_rem const
//Requires: caml_obj_block, caml_array_set
function ml_z_div_rem(z1, z2) {
......@@ -194,3 +199,16 @@ function ml_z_logand(z1, z2) {
function ml_z_logor(z1, z2) {
return z1 | z2;
}
//Provides: ml_z_sign const
function ml_z_sign(z) {
var zero = joo_global_object.BigInt(0);
if (z < zero) return -1;
else if (z = zero) return 0;
else return 1;
}
//Provides: ml_z_extract const
function ml_z_extract(z, off, len) {
return (z >> joo_global_object.BigInt(off)) & (joo_global_object.BigInt(1) << joo_global_object.BigInt(len)) - joo_global_object.BigInt(1);
}
open Js_of_ocaml
open Metal_js
let installed = has_metal
let metal : metal Js.t ref = ref metal
let is_installed = ref false
let ready ?not_installed ?timeout f =
ready ?not_installed ?timeout (fun m -> metal := m; is_installed := true; f ())
let installed () = !is_installed
let is_enabled f =
metal##isEnabled(fun js_b -> f (Js.to_bool js_b))
!metal##isEnabled(fun js_b -> f (Js.to_bool js_b))
let is_unlocked f =
metal##isUnlocked(fun js_b -> f (Js.to_bool js_b))
!metal##isUnlocked(fun js_b -> f (Js.to_bool js_b))
let is_approved f =
metal##isApproved(fun js_b -> f (Js.to_bool js_b))
!metal##isApproved(fun js_b -> f (Js.to_bool js_b))
let get_account f =
metal##getAccount(fun js_str -> f (Js.to_string js_str))
!metal##getAccount(fun js_str -> f (Js.to_string js_str))
let get_network f =
metal##getNetwork(fun res ->
!metal##getNetwork(fun res ->
f (Js.to_string res##.name, Js.to_string res##.url))
let on_state_changed f =
metal##onStateChanged(fun () -> f ())
!metal##onStateChanged f
type 'a result =
| Ok of 'a
......@@ -36,11 +42,12 @@ let map_opt f = function
| Some o -> Js.Optdef.return (f o)
let send ~destination ~amount
?fee ?parameter ?gas_limit ?storage_limit callback =
?fee ?parameter ?entrypoint ?gas_limit ?storage_limit callback =
let destination = Js.string destination in
let amount = Js.string amount in
let fee = map_opt Js.string fee in
let parameter = map_opt Js.string parameter in
let entrypoint = map_opt Js.string entrypoint in
let gas_limit = map_opt (fun x -> Js.string (string_of_int x)) gas_limit in
let storage_limit =
map_opt (fun x -> Js.string (string_of_int x)) storage_limit in
......@@ -51,28 +58,24 @@ let send ~destination ~amount
callback
(Ok (Js.to_string (Js.Optdef.get (res##.msg) (fun () -> assert false))))
in
metal##send(object%js
!metal##send(object%js
val mutable dst = destination
val mutable amount = amount
val mutable fee = fee
val mutable parameter = parameter
val mutable entrypoint = entrypoint
val mutable gas_limit_ = gas_limit
val mutable storage_limit_ = storage_limit
method cb res = callback res
end)
let originate ~balance ?manager ?(code=Nocode)
?delegate ?delegatable ?spendable
let originate ~balance ?(code=Nocode)
?fee ?gas_limit ?storage_limit callback =
let manager = map_opt Js.string manager in
let balance = Js.string balance in
let fee = map_opt Js.string fee in
let gas_limit = map_opt (fun x -> Js.string (string_of_int x)) gas_limit in
let storage_limit =
map_opt (fun x -> Js.string (string_of_int x)) storage_limit in
let delegate = map_opt Js.string delegate in
let delegatable = map_opt Js.bool delegatable in
let spendable = map_opt Js.bool spendable in
let sc_storage, sc_code, sc_code_hash = match code with
| Nocode -> Js.Optdef.empty, Js.Optdef.empty, Js.Optdef.empty
| Code (code, storage) ->
......@@ -93,17 +96,35 @@ let originate ~balance ?manager ?(code=Nocode)
let contract = Js.to_string msg##.contract in
callback (Ok (op_hash, contract))
in
metal##originate(object%js
!metal##originate(object%js
val mutable balance = balance
val mutable manager = manager
val mutable fee = fee
val mutable gas_limit_ = gas_limit
val mutable storage_limit_ = storage_limit
val mutable delegate = delegate
val mutable delegatable = delegatable
val mutable spendable = spendable
val mutable sc_storage_ = sc_storage
val mutable sc_code_ = sc_code
val mutable sc_code_hash_ = sc_code_hash
method cb res = callback res
end)
let delegate
?fee ?gas_limit ?storage_limit delegate callback =
let delegate = match delegate with None -> Js.undefined | Some d -> Js.def (Js.string d) in
let fee = map_opt Js.string fee in
let gas_limit = map_opt (fun x -> Js.string (string_of_int x)) gas_limit in
let storage_limit =
map_opt (fun x -> Js.string (string_of_int x)) storage_limit in
let callback = fun res ->
match Js.to_bool res##.ok with
| false -> callback Canceled
| true ->
callback
(Ok (Js.to_string (Js.Optdef.get (res##.msg) (fun () -> assert false))))
in
!metal##delegate(object%js
val mutable delegate = delegate
val mutable fee = fee
val mutable gas_limit_ = gas_limit
val mutable storage_limit_ = storage_limit
method cb res = callback res
end)
......@@ -25,6 +25,7 @@ class type send_param = object
method amount : Js.js_string Js.t Js.prop (* in mudun *)
method fee : Js.js_string Js.t Js.Optdef.t Js.prop (* in mudun *)
method parameter : Js.js_string Js.t Js.Optdef.t Js.prop (* in json *)
method entrypoint : Js.js_string Js.t Js.Optdef.t Js.prop (* in json *)
method gas_limit_ : Js.js_string Js.t Js.Optdef.t Js.prop
method storage_limit_ : Js.js_string Js.t Js.Optdef.t Js.prop
method cb : send_result Js.t -> unit Js.meth
......@@ -35,16 +36,20 @@ class type originate_param = object
method fee : Js.js_string Js.t Js.Optdef.t Js.prop (* in mudun *)
method gas_limit_ : Js.js_string Js.t Js.Optdef.t Js.prop
method storage_limit_ : Js.js_string Js.t Js.Optdef.t Js.prop
method spendable : bool Js.t Js.Optdef.t Js.prop
method delegatable : bool Js.t Js.Optdef.t Js.prop
method delegate : Js.js_string Js.t Js.Optdef.t Js.prop
method manager : Js.js_string Js.t Js.Optdef.t Js.prop
method sc_code_hash_ : Js.js_string Js.t Js.Optdef.t Js.prop (* in json *)
method sc_storage_ : Js.js_string Js.t Js.Optdef.t Js.prop (* in json *)
method sc_code_ : Js.js_string Js.t Js.Optdef.t Js.prop (* in json *)
method cb : originate_result Js.t -> unit Js.meth
end
class type delegate_param = object
method delegate : Js.js_string Js.t Js.Optdef.t Js.prop
method fee : Js.js_string Js.t Js.Optdef.t Js.prop (* in mudun *)
method gas_limit_ : Js.js_string Js.t Js.Optdef.t Js.prop
method storage_limit_ : Js.js_string Js.t Js.Optdef.t Js.prop
method cb : send_result Js.t -> unit Js.meth
end
class type metal = object
method isEnabled : (bool Js.t -> unit) -> unit Js.meth
method isUnlocked : (bool Js.t -> unit) -> unit Js.meth
......@@ -56,8 +61,16 @@ class type metal = object
method send : send_param Js.t -> unit Js.meth
method originate : originate_param Js.t -> unit Js.meth
method delegate : delegate_param Js.t -> unit Js.meth
end
let has_metal = Js.Optdef.test (Js.Unsafe.global##.metal)
let ready ?(not_installed=fun () -> ()) ?(timeout=500.) f =
Js.Optdef.case Js.Unsafe.global##.metal
(fun () ->
let cb () =
Js.Optdef.case Js.Unsafe.global##.metal
not_installed f in
ignore @@ Dom_html.window##setTimeout (Js.wrap_callback cb) timeout)
f
let metal : metal Js.t = Js.Unsafe.global##.metal
......@@ -12,11 +12,15 @@ let send ~destination
?fee ?parameter ?gas_limit ?storage_limit (Lwt.wakeup resolver);
promise
let originate ?manager ?code
?delegate ?delegatable ?spendable
let originate ?code
?fee ?gas_limit ?storage_limit ~balance =
let (promise, resolver) = Lwt.task () in
originate ~balance ?manager ?code
?delegate ?delegatable ?spendable
originate ~balance ?code
?fee ?gas_limit ?storage_limit (Lwt.wakeup resolver);
promise
let delegate ?fee ?gas_limit ?storage_limit delegate =
let (promise, resolver) = Lwt.task () in
Metal.delegate
?fee ?gas_limit ?storage_limit delegate (Lwt.wakeup resolver);
promise
......@@ -17,16 +17,18 @@ depends: [
"hex"
"ocurl"
"zarith"
"lwt"
"lwt" { = "4.5.0" }
"menhir"
"ezjsonm"
"num"
"omd"
"ocplib-json-typed"
"js_of_ocaml" { = "3.5.1" }
"js_of_ocaml-lwt" { = "3.5.1" }
"js_of_ocaml-tyxml" { = "3.5.1" }
"js_of_ocaml-ppx" { = "3.5.1" }
"js_of_ocaml-compiler" { = "3.4.0" }
"ocplib-json-typed-bson"
"js_of_ocaml" { = "3.5.2" }
"js_of_ocaml-lwt" { = "3.5.2" }
"js_of_ocaml-tyxml" { = "3.5.2" }
"js_of_ocaml-ppx" { = "3.5.2" }
"js_of_ocaml-compiler" { = "3.5.2" }
"ppx_deriving"
"base64" { >= "3.2.0" }
"cohttp-lwt" {>= "0.99.0" }
......
OCaml.library("metal-message-lib", ocaml+ {
requires = [ "ocplib-chrome"; "ocplib-js-min" ];
requires = [ "ocplib-browser"; "ocplib-js-min" ];
files = [ "metal_message_types.ml"; "metal_message.ml", pp_js ]
});
......
......@@ -26,7 +26,7 @@
(*****************************************************************************)
open Js_min
open Chrome
open Browser
open Metal_message_types
let inject_api () =
......
......@@ -28,7 +28,7 @@
open Js_types
open Metal_message_types
open Metal_types
open Chrome
open Browser
let pending_approved : (string * siteMetadata t) list ref = ref []
let pending_send : (string * transactionData t) list ref = ref []
......@@ -86,7 +86,7 @@ let update_badge () =
(List.find (fun {notif_acc ; _} ->
notif_acc = account.pkh) ns).notifs
with Not_found -> [] in
Chrome.Browser_action.set_badge
Browser.Browser_action.set_badge
~text:(if n_notif = 0 then "" else string_of_int n_notif) ()))
let callback_handler ?callback ?refresh data = function
......@@ -263,15 +263,15 @@ let check_tr (data : transactionData t) =
| None -> true
| Some f -> try ignore @@ Int64.of_string f ; true with _ -> false
with _ -> false in
let b_parameter =
try
match to_optdef to_string data##.parameter with
| None -> true
| Some p ->
try
ignore @@ Api_encoding_min.Base.Micheline.decode p ; true
with _ -> false
with _ -> false in
(* let b_parameter =
* try
* match to_optdef to_string data##.parameter with
* | None -> true
* | Some p ->
* try
* ignore @@ Api_encoding_min.Base.Micheline.decode p ; true
* with _ -> false
* with _ -> false in *)
let b_gas_limit =
try
match to_optdef to_string data##.gasLimit with
......@@ -284,43 +284,23 @@ let check_tr (data : transactionData t) =
| None -> true
| Some sl -> try ignore @@ Z.of_string sl ; true with _ -> false
with _ -> false in
b_dst && b_amount && b_fee && b_parameter && b_gas_limit && b_storage_limit,
b_dst && b_amount && b_fee (* && b_parameter *) && b_gas_limit && b_storage_limit,
List.fold_left (fun acc (b, str) -> if not b then acc @ [ str ] else acc)
[]
[ b_dst, "dst is not a public key hash" ;
b_amount, "amount is not a number" ;
b_fee, "fee is not a number" ;
b_parameter, "wrong parameter format (should be michelson)" ;
(* b_parameter, "wrong parameter format (should be michelson)" ; *)
b_gas_limit, "gas_limit is not a number" ;
b_storage_limit, "storage_limit is not a number" ]
let check_ori_unit (data : originationData t) =
let b_manager =
try
match to_optdef to_string data##.manager with
| None -> true
| Some m -> check_pkh m
with _ -> false in
let b_delegate =
try
match to_optdef to_string data##.delegate with
| None -> true
| Some d -> check_pkh d
with _ -> false in
let b_balance =
try ignore @@ Int64.of_string @@ to_string data##.balance ; true with _ -> false in
let b_fee =
match to_optdef to_string data##.fee with
| None -> true
| Some f -> try ignore @@ Int64.of_string f ; true with _ -> false in
let b_delegatable =
try
ignore @@ to_optdef to_bool data##.delegatable ; true
with _ -> false in
let b_spendable =
try
ignore @@ to_optdef to_bool data##.spendable ; true
with _ -> false in
let b_sc_code =
try
match to_optdef to_string data##.scCode with
......@@ -360,17 +340,12 @@ let check_ori_unit (data : originationData t) =
| None -> true
| Some sl -> try ignore @@ Z.of_string sl ; true with _ -> false
with _ -> false in
b_manager && b_delegate && b_balance && b_fee && b_delegatable &&
b_spendable && b_sc_code && b_sc_code_hash && b_sc_storage && b_gas_limit &&
b_storage_limit,
b_balance && b_fee && b_sc_code && b_sc_code_hash &&
b_sc_storage && b_gas_limit && b_storage_limit,
List.fold_left (fun acc (b, str) -> if not b then acc @ [ str ] else acc)
[]
[ b_manager, "manager is not a public key hash";
b_delegate, "delegate is not a public key hash";
b_balance, "balance is not a number";
[ b_balance, "balance is not a number";
b_fee, "fee is not a number" ;
b_delegatable, "delegatable is not a bool";
b_spendable, "spendable is not a bool";
b_sc_code, "wrong sc_code format (should be michelson)";
b_sc_code_hash, "wrong sc_code_hash format (should be michelson)";
b_sc_storage, "wrong sc_storage format (should be michelson)";
......@@ -378,18 +353,6 @@ let check_ori_unit (data : originationData t) =
b_storage_limit, "storage_limit is not a number" ]
let check_ori_merge (data : originationData t) =
let has_delegate =
match to_optdef to_string data##.delegate with
| None -> false
| Some _d -> true in
let is_delegatable =
match to_optdef to_bool data##.delegatable with
| None -> true
| Some b -> b in
let is_spendable =
match to_optdef to_bool data##.spendable with
| None -> true
| Some b -> b in
let has_sc_code =
match to_optdef to_string data##.scCode with
| None -> false
......@@ -402,23 +365,18 @@ let check_ori_merge (data : originationData t) =
match to_optdef to_string data##.scStorage with
| None -> false
| Some _s -> true in
not ((has_delegate && not is_delegatable) ||
(has_sc_code && has_sc_code_hash) ||
not ((has_sc_code && has_sc_code_hash) ||
(has_sc_storage && (not has_sc_code && not has_sc_code_hash)) ||
(not has_sc_storage && (has_sc_code || has_sc_code_hash)) ||
(has_sc_storage && is_spendable)),
(not has_sc_storage && (has_sc_code || has_sc_code_hash))),
List.fold_left (fun acc (b, str) -> if b then acc @ [ str ] else acc)
[]
[ (has_delegate && not is_delegatable),
"delegate specified but contract will not be delegatable" ;
(has_sc_code && has_sc_code_hash),
[ (has_sc_code && has_sc_code_hash),
"code and code_hash can't be specified together" ;
(has_sc_storage && (not has_sc_code && not has_sc_code_hash)),
"storage specified but no code or code_hash provided" ;
(not has_sc_storage && (has_sc_code || has_sc_code_hash)),
"code or code_hash specified but not storage provided" ;
(has_sc_storage && is_spendable),
"contract with code cannot be spendable" ]
]
let check_ori (data : originationData t) =
let b, errs = check_ori_unit data in
......@@ -430,7 +388,9 @@ let check_dlg_unit (data : delegationData t) =
try
match to_optdef to_string data##.delegate with
| None -> true
| Some d -> check_pkh d
| Some d when d = "" -> true
| Some d when d <> "" -> check_pkh d
| _ -> false
with _ -> false in
let b_fee =
match to_optdef to_string data##.fee with
......@@ -623,7 +583,7 @@ let dispatch_popup port (msg : message t) =
pending_approved := List.remove_assoc id !pending_approved)
data
notif
| TraNot n | DlgNot n | OriNot n as notif ->
| TraNot n | DlgNot n | OriNot n | ManNot n as notif ->
if n.not_id = to_string req##.id then
callback_handler ~callback:(fun _ ->
let obj =
......@@ -659,7 +619,7 @@ let dispatch_popup port (msg : message t) =
remove_window n.not_approv_wid)
data
notif
| TraNot n | DlgNot n | OriNot n as notif ->
| TraNot n | DlgNot n | OriNot n | ManNot n as notif ->
if n.not_id = to_string req##.id then
callback_handler
~callback:(fun _ ->
......
......@@ -26,7 +26,7 @@
(*****************************************************************************)
open Js_min
open Chrome
open Browser
let print_conn_recv (port : Runtime_utils.port Js.t) =
Js.Optdef.case
......
......@@ -79,6 +79,7 @@ class type transactionData = object
method dst : js_string t prop
method amount : js_string t prop
method fee : js_string t optdef prop
method entrypoint : js_string t optdef prop
method parameter : js_string t optdef prop
method gasLimit : js_string t optdef prop
method storageLimit : js_string t optdef prop
......@@ -86,12 +87,8 @@ class type transactionData = object
end
class type originationData = object
method manager : js_string t optdef prop
method delegate : js_string t optdef prop
method balance : js_string t prop
method fee : js_string t optdef prop
method delegatable : bool t optdef prop
method spendable : bool t optdef prop
method scCode : js_string t optdef prop
method scCodeHash : js_string t optdef prop
method scStorage : js_string t optdef prop
......
......@@ -26,7 +26,7 @@
(*****************************************************************************)
open Js_types
open Chrome
open Browser
open Js_min
(* Changes need to be made in static/scss/main.scss aswell *)
......
open MBytes
exception Binary_reading_error of string
type state = {b : MBytes.t; offset: int}
let (>>=) (o, s) f = let x, s = f s in (o, x), s
let uint8 s = get_int8 s.b s.offset, {s with offset = s.offset + 1}
let char s = get_char s.b s.offset, {s with offset = s.offset + 1}
let bool s = match char s with
| '\000', s -> false, s
| '\255', s -> true, s
| c, _ -> raise (Binary_reading_error (Printf.sprintf "%c is not a boolean" c))
let opt read_value s = match char s with
| '\000', s -> None, s
| '\255', s -> let x, s = read_value s in Some x, s
| c, _ -> raise (Binary_reading_error (Printf.sprintf "%c is not an option" c))
let int32 s = Int32.to_int (get_int32 s.b s.offset), {s with offset = s.offset + 4}
let uint64 ?(limit=10) s =
let rec f acc i =
if i > limit then raise (Binary_reading_error "int64 too long")
else (
let v = get_int8 s.b (s.offset + i) in
let acc = Int64.(add (shift_left acc 7) (of_int @@ v land 0x7f)) in
if v land 0x80 = 0 then acc, {s with offset = (s.offset + i + 1)}
else f acc (i+1)) in
f 0L 0
let uzarith ?(limit=10) s =
let rec f acc i =
if i > limit then raise (Binary_reading_error "unsigned zarith too long")
else (
let v = get_int8 s.b (s.offset + i) in
let acc = Z.add (Z.shift_left acc 7) (Z.of_int @@ v land 0x7f) in
if v land 0x80 = 0 then acc, {s with offset = s.offset + i + 1}
else f acc (i+1)) in
f Z.zero 0
let zarith ?(limit=10) s =
let rec f acc i =
if i > limit then raise (Binary_reading_error "signed zarith too long")
else (
let v = get_int8 s.b (s.offset + i) in
let acc =
if i = 0 then
let aux = Z.add (Z.shift_left acc 6) (Z.of_int @@ v land 0x3f) in
if v land 0x40 = 0 then Z.neg aux else aux
else
Z.add (Z.shift_left acc 7) (Z.of_int @@ v land 0x7f) in
if v land 0x80 = 0 then acc, {s with offset = s.offset + i + 1}
else f acc (i+1)) in
f Z.zero 0
let elem f s =
let len, s = int32 s in
f len s
let list reader s =
let f len s =
let rec aux s l = function
| 0 -> List.rev l, s
| i when i > 0 -> let offset = s.offset in
let x, s = reader s in
aux s (x :: l) (i - (s.offset - offset))
| _ -> raise (Binary_reading_error "list longer than expected") in
aux s [] len in
elem f s
let sub len s = MBytes.sub s.b s.offset len, {s with offset = s.offset + len}
let pkh s =
let tag, s = uint8 s in
let prefix = match tag with
| 0 -> Crypto.Prefix.ed25519_public_key_hash
| 1 -> Crypto.Prefix.secp256k1_public_key_hash
| 2 -> Crypto.Prefix.p256_public_key_hash
| n -> raise (Binary_reading_error (Printf.sprintf "wrong tag for pkh %d" n)) in
let b, s = sub 20 s in
Crypto.Pkh.b58enc ~prefix b, s
let contract s =
let tag, s = uint8 s in
match tag with
| 0 -> pkh s
| 1 -> let b, s = sub 20 s in
Crypto.(Base58.simple_encode Prefix.contract_public_key_hash b), s
| n -> raise (Binary_reading_error (Printf.sprintf "wrong tag for contract %d" n))
let pk s =
let tag, s = uint8 s in
let prefix, len = match tag with
| 0 -> Crypto.Prefix.ed25519_public_key, 32
| 1 -> Crypto.Prefix.secp256k1_public_key, 33
| 2 -> Crypto.Prefix.p256_public_key, 33
| n -> raise (Binary_reading_error (Printf.sprintf "wrong tag for pk %d" n)) in
let b, s = sub len s in
Crypto.Pkh.b58enc ~prefix b, s
let branch s =
let b, s = sub 32 s in
Crypto.(Base58.simple_encode Prefix.block_hash b), s
let signature s =
let b, s = sub 64 s in
Crypto.(Base58.simple_encode Prefix.generic_signature b), s
let script_expr_hash s =
let b, s = sub 32 s in
Crypto.(Base58.simple_encode Prefix.script_expr_hash b), s
let obj1 (a, _s) = a
let obj2 ((a, b), _s) = a, b
let obj3 (((a, b), c), _s) = a, b, c
let obj4 ((((a, b), c), d), _s) = a, b, c, d
let obj5 (((((a, b), c), d), e), _s) = a, b, c, d, e
let obj6 ((((((a, b), c), d), e), f), _s) = a, b, c, d, e, f
let obj7 (((((((a, b), c), d), e), f), g), _s) = a, b, c, d, e, f, g
let obj8 ((((((((a, b), c), d), e), f), g), h), _s) = a, b, c, d, e, f, g, h
let obj9 (((((((((a, b), c), d), e), f), g), h), i), _s) = a, b, c, d, e, f, g, h, i
let obj10 ((((((((((a, b), c), d), e), f), g), h), i), j), _s) = a, b, c, d, e, f, g, h, i, j
let start b = {b; offset = 0}
(*****************************************************************************)
(* *)
(* MIT License *)
(* *)
(* Copyright (c) 2019 Origin Labs - contact@origin-labs.com *)
(* *)
(* 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 char c = Bigstring.make 1 c
let uint8 i = char @@ char_of_int i
let bool b = if b then uint8 255 else uint8 0
let list l = Bigstring.concat "" l
let chars l = list (List.map char l)
let opt f = function
| None -> bool false
| Some x -> list [bool true; f x]
let int16 i = (* 2 bytes *)
let x = i lsr 8 in
list [
uint8 (x land 0xff);
uint8 (i land 0xff) ]
let int32 i = (* 4 bytes *)
let rec f i acc x =
let c = uint8 (x land 0xff) in
if i = 3 then c :: acc
else f (i+1) (c :: acc) (x lsr 8) in
list (f 0 [] i)
let int64 i = (* 8 bytes *)
let rec f i acc x =
let c = uint8 Int64.(to_int @@ logand x 0xffL) in
if i = 7 then c :: acc
else f (i+1) (c :: acc) (Int64.shift_right x 8) in
list (f 0 [] i)
let n_int64 z =
let rec f acc x =
if x < 0x80L then uint8 (Int64.to_int x) :: acc
else f (uint8 Int64.(to_int (logor (logand x 0x7fL) 0x80L)) :: acc) (Int64.shift_right x 7) in
list (List.rev @@ f [] z)
let n_zarith z =
let rec f acc x =
if x < Z.of_int 0x80 then uint8 (Z.to_int x) :: acc
else f (uint8 Z.(to_int (logor (logand x (of_int 0x7f)) (of_int 0x80))) :: acc)
(Z.shift_right x 7) in
list (List.rev @@ f [] z)
let zarith z =
let sign = z < Z.zero in
let small = z <= Z.of_int 0x40 in
let z = Z.abs z in
let first_byte = uint8 @@
Z.to_int @@ Z.logor (Z.logand z (Z.of_int 0x3f)) @@
Z.of_int @@ ((if sign then 0x40 else 0x00)
lor (if small then 0x00 else 0x80)) in
if small then first_byte
else list [first_byte; n_zarith @@ Z.shift_right z 6]
let elem e =
list [int32 @@ Bigstring.length e; e]
let pkh pkh = (* 21 bytes *)
let tag, prefix =
if String.length pkh < 3 then
raise @@ Forge_error (Printf.sprintf "wrong format for pkh: %S" pkh)
else match String.sub pkh 0 3 with
| "dn1" -> 0, Crypto.Prefix.ed25519_public_key_hash
| "dn2" -> 1, Crypto.Prefix.secp256k1_public_key_hash
| "dn3" -> 2, Crypto.Prefix.p256_public_key_hash
| _ -> raise @@ Forge_error (Printf.sprintf "wrong format for pkh: %S" pkh) in
list [ uint8 tag; Crypto.Pkh.b58dec ~prefix pkh ]
let contract h = (* 22 bytes *)
if h.[0] = 'd' then list [ uint8 0; pkh h]
else
list [
uint8 1;
Crypto.(Base58.simple_decode Prefix.contract_public_key_hash h);
uint8 0 ]
let source_manager h = pkh h
let pk pk = (* 33 or 34 bytes *)
let tag, prefix =
if String.length pk < 4 then
raise @@ Forge_error (Printf.sprintf "wrong format for pk: %S" pk)
else match String.sub pk 0 4 with
| "edpk" -> 0, Crypto.Prefix.ed25519_public_key
| "sppk" -> 1, Crypto.Prefix.secp256k1_public_key
| "p2pk" -> 2, Crypto.Prefix.p256_public_key
| _ -> raise @@ Forge_error (Printf.sprintf "wrong format for pkh: %S" pk) in
list [ uint8 tag; Crypto.Pk.b58dec ~prefix pk ]
let branch hash = (* 32 bytes *)
Crypto.(Base58.simple_decode Prefix.block_hash hash)
let signature s =
let prefix =
if String.length s < 3 then
raise @@ Forge_error (Printf.sprintf "wrong format for signature: %S" s)
else if String.sub s 0 3 = "sig" then Crypto.Prefix.generic_signature
else (
if String.length s < 5 then
raise @@ Forge_error (Printf.sprintf "wrong format for signature: %S" s)
else (match String.sub s 0 5 with
| "edsig" -> Crypto.Prefix.ed25519_signature
| "spsig" -> Crypto.Prefix.secp256k1_signature
| "p2sig" -> Crypto.Prefix.p256_signature
| _ -> raise @@ Forge_error (Printf.sprintf "wrong format for signature: %S" s))) in
Crypto.Base58.simple_decode prefix s
let script_expr_hash s =
Crypto.(Base58.simple_decode Prefix.script_expr_hash s)
ocaml.has_asm = false;
OCaml.library("metal-binary", ocaml+{
requires = [ "crypto"; "ocplib-endian" ];
files = [ "mBytes.ml"; "binary_reader.ml"; "binary_writer.ml" ]
});
\ No newline at end of file
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
include Bigstring
include EndianBigstring.BigEndian
module LE = EndianBigstring.LittleEndian
let make sz c =
let buf = create sz in
fill buf c ;
buf
let to_hex t =
Hex.of_cstruct (Cstruct.of_bigarray t)
let of_hex hex =
Cstruct.to_bigarray (Hex.to_cstruct hex)
let pp_hex ppf s =
let `Hex hex = to_hex s in
Format.pp_print_string ppf hex
let cut ?(copy=false) sz bytes =
let length = length bytes in
if length <= sz then
[bytes] (* if the result fits in the given sz *)
else
let may_copy = if copy then Bigstring.copy else fun t -> t in
let nb_full = length / sz in (* nb of blocks of size sz *)
let sz_full = nb_full * sz in (* size of the full part *)
let acc = (* eventually init acc with a non-full block *)
if sz_full = length then []
else [may_copy (sub bytes sz_full (length - sz_full))]
in
let rec split_full_blocks curr_upper_limit acc =
let start = curr_upper_limit - sz in
assert (start >= 0);
(* copy the block [ start, curr_upper_limit [ of size sz *)
let acc = (may_copy (sub bytes start sz)) :: acc in
if start = 0 then acc else split_full_blocks start acc
in
split_full_blocks sz_full acc
(* include Compare.Make(struct
* type nonrec t = Bigstring.t
* let compare = Bigstring.compare
* end) *)
......@@ -9,7 +9,6 @@ OCaml.library("metal-common", ocaml+ {
"bigstring";
"dunscan-encoding-min";
"ocplib-chrome";
"micheline";
];
files = [
"metal_types.ml";
......
......@@ -104,10 +104,20 @@ let filter_revelation ?(failed=false) ops =
| _ -> acc2) acc mops
| _ -> acc) [] ops
let filter_manage_account ?(failed=false) ops =
List.rev @@
List.fold_left (fun acc op -> match op.op_type with
| Sourced ( Dune_manager (_, mops) ) ->
List.fold_left (fun acc2 op2 -> match op2 with
| Manage_account mac when (failed || not mac.mac_failed) -> (op.op_hash, mac) :: acc2
| _ -> acc2) acc mops
| _ -> acc) [] ops
let notif_kind_to_string = function
| TraNot _ -> "transaction"
| DlgNot _ -> "delegation"
| OriNot _ -> "origination"
| ManNot _ -> "manage_account"
| ApprovNot _ -> "approval"
let notif_op_of_kind k not_op = match k with
......@@ -117,35 +127,31 @@ let notif_op_of_kind k not_op = match k with
| _ -> assert false
let notif_id_of_not = function
| TraNot n | DlgNot n | OriNot n -> n.not_id
| TraNot n | DlgNot n | OriNot n | ManNot n -> n.not_id
| ApprovNot n -> n.not_approv_id
let notif_tsp_of_not = function
| TraNot n | DlgNot n | OriNot n -> n.not_tsp
| TraNot n | DlgNot n | OriNot n | ManNot n -> n.not_tsp
| ApprovNot n -> n.not_approv_tsp
let maybe_parse_michelson_code = function
let parse_script = function
| None -> None
| Some x -> match Micheline_json.contract_to_json x with
| Error _ -> Some x (* already json probably *)
| Ok json -> Some json
| Some s -> match Dune_script.json_of_string s with
| Error _ -> None
| Ok p -> Some p
let maybe_parse_michelson_const = function
| None -> None
| Some x -> match Micheline_json.const_to_json x with
| Error _ -> Some x (* already json probably *)
| Ok json -> Some json
let make_notif_tr ?amount ?fee ?gas_limit ?storage_limit ?params ?msg ~id ~wid ~tsp ~origin dst =
let params = maybe_parse_michelson_const params in
let make_notif_tr ?amount ?fee ?gas_limit ?storage_limit ?entry ?params ?msg ~id ~wid ~tsp ~origin dst =
let params = parse_script params in
TraNot {
not_origin = origin; not_msg = msg; not_dst = Some dst; not_tsp = tsp;
not_id = id; not_wid = wid ; not_amount = amount;
not_fee = fee; not_gas_limit = gas_limit; not_storage_limit = storage_limit;
not_entry = entry;
not_params = params; not_sc_code = None; not_sc_code_hash = None ;
not_sc_storage = None ; not_spendable = None;
not_delegatable = None; not_manager = None ;
not_delegate = None }
not_sc_storage = None ; not_delegate = None;
not_maxrolls = None; not_admin = None; not_white_list = None;
not_delegation = None
}
let make_notif_del ?fee ?gas_limit ?storage_limit ?msg ~id ~wid ~tsp ~origin delegate =
DlgNot {
......@@ -153,24 +159,41 @@ let make_notif_del ?fee ?gas_limit ?storage_limit ?msg ~id ~wid ~tsp ~origin del
not_id = id; not_wid = wid ; not_amount = None;
not_fee = fee; not_gas_limit = gas_limit;
not_storage_limit = storage_limit;
not_entry = None;
not_params = None ; not_sc_code = None; not_sc_code_hash = None ;
not_sc_storage = None ;
not_spendable = None; not_delegatable = None; not_manager = None ;
not_delegate = delegate }
not_sc_storage = None ; not_delegate = delegate;
not_maxrolls = None; not_admin = None; not_white_list = None;
not_delegation = None
}
let make_notif_ori ?amount ?fee ?gas_limit ?storage_limit ?sc_code
?sc_code_hash ?sc_storage ?spendable ?delegatable ?manager ?delegate ?msg
?sc_code_hash ?sc_storage ?msg
~id ~wid ~tsp ~origin () =
let sc_storage = maybe_parse_michelson_const sc_storage in
let sc_code = maybe_parse_michelson_code sc_code in
let sc_storage = parse_script sc_storage in
let sc_code = parse_script sc_code in
OriNot {
not_origin = origin; not_msg = msg; not_dst = None; not_tsp = tsp;
not_id = id; not_wid = wid ; not_amount = amount;
not_fee = fee; not_gas_limit = gas_limit; not_storage_limit = storage_limit;
not_entry = None;
not_params = None; not_sc_code = sc_code; not_sc_code_hash = sc_code_hash ;
not_sc_storage = sc_storage ;
not_spendable = spendable; not_delegatable = delegatable;
not_manager = manager ; not_delegate = delegate }
not_sc_storage = sc_storage ; not_delegate = None;
not_maxrolls = None; not_admin = None; not_white_list = None;
not_delegation = None
}
let make_notif_mac ?fee ?gas_limit ?storage_limit ?maxrolls ?admin ?white_list
?delegation ?msg ~id ~wid ~tsp ~origin () =
ManNot {
not_origin = origin; not_msg = msg; not_dst = None; not_tsp = tsp;
not_id = id; not_wid = wid ; not_amount = None;
not_fee = fee; not_gas_limit = gas_limit; not_storage_limit = storage_limit;
not_entry = None;
not_params = None; not_sc_code = None; not_sc_code_hash = None ;
not_sc_storage = None ; not_delegate = None;
not_maxrolls = maxrolls; not_admin = admin; not_white_list = white_list;
not_delegation = delegation
}
let make_notif_approv ~id ~wid ~tsp ~icon ~name ~url =
ApprovNot {
......
......@@ -42,6 +42,7 @@ type transaction_sh = {
trs_fee : int64;
trs_gas_limit : Z.t ;
trs_storage_limit : Z.t ;
trs_entrypoint : string option ;
trs_parameters : string option ;
trs_internal : bool option ;
trs_burn : int64 option ;
......@@ -62,14 +63,16 @@ type notif_op = {
not_fee : int64 option;
not_gas_limit : Z.t option;
not_storage_limit : Z.t option;
not_entry : string option;
not_params : string option;
not_sc_code : string option;
not_sc_code_hash : string option;
not_sc_storage : string option;
not_spendable : bool option;
not_delegatable : bool option;
not_manager : account_hash option;
not_delegate : account_hash option;
not_maxrolls : int option option;
not_admin : account_hash option option;
not_white_list : account_hash list option;
not_delegation : bool option
}
type notif_app = {
......@@ -83,6 +86,7 @@ type notif_app = {
type notif_kind =
| TraNot of notif_op | DlgNot of notif_op | OriNot of notif_op
| ManNot of notif_op
| ApprovNot of notif_app
type vault =
......@@ -96,6 +100,8 @@ type account = {
name : string;
revealed : (network * operation_hash) list;
pending : transaction_sh list;
manager_kt : bool option;
admin : (network * account_hash) list;
}
type local_notif = {
......@@ -143,3 +149,40 @@ type se_state = {
se_acc : account option;
se_accs : account list
}
type entry_ty =
| EAUnit
| EABytes
| EAString
| EANat
| EAInt
| EABool
| EATimestamp
| EAMutez
| EAAddress
| EAOperation
| EAKey
| EAKey_hash
| EASignature
| EAChain_id
| EAContract
| EAList of entry_arg
| EAPair of entry_arg * entry_arg
| EAOption of entry_arg
| EAOr of entry_arg * entry_arg
| EASet of entry_arg
| EAMap of entry_arg * entry_arg
| EABigmap of entry_arg
and entry_arg = {
ea_name : string option ;
ea_type : string option ;
ea_arg : entry_ty ;
}
type entry_point = {
ep_name : string option;
ep_type : string option ;
ep_args : entry_arg ;
ep_mic : string list ;
}
OCaml.library("crypto", ocaml+{
requires = [
"bigstring";
"hacl";
"digestif.ocaml";
"hex" ];
files = [
"pbkdf.ml";
"english.ml";
"bip39.ml";
"crypto.ml" ]
});
......@@ -268,6 +268,15 @@ module Blake2b_32 = struct
(Blake2b.init ()) l
end
let prefix_dn hash =
if String.length hash < 3 then None
else match String.sub hash 0 3 with
| "dn1" -> Some Prefix.ed25519_public_key_hash
| "dn2" -> Some Prefix.secp256k1_public_key_hash
| "dn3" -> Some Prefix.p256_public_key_hash
| "KT1" -> Some Prefix.contract_public_key_hash
| _ -> None
module Pkh = struct
let b58enc ?alphabet ?(prefix=Prefix.ed25519_public_key_hash) b =
Base58.simple_encode ?alphabet prefix b
......@@ -340,16 +349,6 @@ let tz_to_dn tz = match prefix_dn_tz tz with
Pkh.(b58enc ~prefix:dn_enc (b58dec ~prefix:tz_enc tz))
| _ -> tz
let prefix_dn hash =
if String.length hash < 3 then None
else match String.sub hash 0 3 with
| "dn1" -> Some Prefix.ed25519_public_key_hash
| "dn2" -> Some Prefix.secp256k1_public_key_hash
| "dn3" -> Some Prefix.p256_public_key_hash
| "KT1" -> Some Prefix.contract_public_key_hash
| _ -> None
let check_pkh str = match prefix_dn str with
| Some dn_prefix ->
let bytes = Pkh.b58dec ~prefix:dn_prefix str in
......
open EndianString
open BigEndian
exception Binary_reading_error of string
type state = {b : string; offset: int}
let (>>=) (o, s) f = let x, s = f s in (o, x), s
let uint8 s = get_int8 s.b s.offset, {s with offset = s.offset + 1}
let char s = get_char s.b s.offset, {s with offset = s.offset + 1}
let bool s = match char s with
| '\000', s -> false, s
| '\255', s -> true, s
| c, _ -> raise (Binary_reading_error (Printf.sprintf "%c is not a boolean" c))
let opt read_value s = match char s with
| '\000', s -> None, s
| '\255', s -> let x, s = read_value s in Some x, s
| c, _ -> raise (Binary_reading_error (Printf.sprintf "%c is not an option" c))
let int32 s = Int32.to_int (get_int32 s.b s.offset), {s with offset = s.offset + 4}
let uint64 ?(limit=10) s =
let rec f acc i =
if i > limit then raise (Binary_reading_error "int64 too long")
else (
let v = get_int8 s.b (s.offset + i) in
let acc = Int64.(add (shift_left acc 7) (of_int @@ v land 0x7f)) in
if v land 0x80 = 0 then acc, {s with offset = (s.offset + i + 1)}
else f acc (i+1)) in
f 0L 0
let uzarith ?(limit=10) s =
let rec f acc i =
if i > limit then raise (Binary_reading_error "unsigned zarith too long")
else (
let v = get_int8 s.b (s.offset + i) in
let acc = Z.add (Z.shift_left acc 7) (Z.of_int @@ v land 0x7f) in
if v land 0x80 = 0 then acc, {s with offset = s.offset + i + 1}
else f acc (i+1)) in
f Z.zero 0
let zarith ?(limit=10) s =
let rec f acc i =
if i > limit then raise (Binary_reading_error "signed zarith too long")
else (
let v = get_int8 s.b (s.offset + i) in
let acc =
if i = 0 then
let aux = Z.add (Z.shift_left acc 6) (Z.of_int @@ v land 0x3f) in
if v land 0x40 = 0 then Z.neg aux else aux
else
Z.add (Z.shift_left acc 7) (Z.of_int @@ v land 0x7f) in
if v land 0x80 = 0 then acc, {s with offset = s.offset + i + 1}
else f acc (i+1)) in
f Z.zero 0
let elem f s =
let len, s = int32 s in
f len s
let list reader s =
let f len s =
let rec aux s l = function
| 0 -> List.rev l, s
| i when i > 0 -> let offset = s.offset in
let x, s = reader s in
aux s (x :: l) (i - (s.offset - offset))
| _ -> raise (Binary_reading_error "list longer than expected") in
aux s [] len in
elem f s
let sub len s = String.sub s.b s.offset len, {s with offset = s.offset + len}
let pkh s =
let tag, s = uint8 s in
let prefix = match tag with
| 0