diff --git a/lib_embedded_client_alpha/client_proto_args.ml b/lib_embedded_client_alpha/client_proto_args.ml index 5833c8192..54e9863ff 100644 --- a/lib_embedded_client_alpha/client_proto_args.ml +++ b/lib_embedded_client_alpha/client_proto_args.ml @@ -101,7 +101,7 @@ let delegatable_switch = ~parameter:"-delegatable" ~doc:"Set the created contract to be delegatable" -let tez_format = "text format: D,DDD,DDD.DD (centiles are optional, commas are optional)" +let tez_format = "text format: D,DDD,DDD.DDD,DDD (centiles are optional, commas are optional)" let tez_parameter param = parameter diff --git a/lib_embedded_client_alpha/client_proto_programs.ml b/lib_embedded_client_alpha/client_proto_programs.ml index 44faac229..084798a38 100644 --- a/lib_embedded_client_alpha/client_proto_programs.ml +++ b/lib_embedded_client_alpha/client_proto_programs.ml @@ -64,7 +64,7 @@ let print_trace_result (cctxt : #Client_commands.logger) ~show_source ~parsed = print_errors cctxt errs ~show_source ~parsed let run - ?(amount = Tez.default_fee) + ?(amount = Tez.fifty_cents) ~(program : Michelson_v1_parser.parsed) ~(storage : Michelson_v1_parser.parsed) ~(input : Michelson_v1_parser.parsed) @@ -74,7 +74,7 @@ let run block program.expanded (storage.expanded, input.expanded, amount) let trace - ?(amount = Tez.default_fee) + ?(amount = Tez.fifty_cents) ~(program : Michelson_v1_parser.parsed) ~(storage : Michelson_v1_parser.parsed) ~(input : Michelson_v1_parser.parsed) diff --git a/lib_embedded_protocol_alpha/src/bootstrap_storage.ml b/lib_embedded_protocol_alpha/src/bootstrap_storage.ml index b719ea7e4..c61595683 100644 --- a/lib_embedded_protocol_alpha/src/bootstrap_storage.ml +++ b/lib_embedded_protocol_alpha/src/bootstrap_storage.ml @@ -12,14 +12,12 @@ type account = { public_key : Ed25519.Public_key.t ; } -let wealth = Tez_repr.of_cents_exn 4_000_000_00L - let init_account ctxt account = Storage.Public_key.init ctxt account.public_key_hash account.public_key >>=? fun ctxt -> Contract_storage.credit ctxt (Contract_repr.default_contract account.public_key_hash) - wealth >>=? fun ctxt -> + Constants_repr.bootstrap_wealth >>=? fun ctxt -> return ctxt diff --git a/lib_embedded_protocol_alpha/src/constants_repr.ml b/lib_embedded_protocol_alpha/src/constants_repr.ml index 9672aa9a8..6700475b1 100644 --- a/lib_embedded_protocol_alpha/src/constants_repr.ml +++ b/lib_embedded_protocol_alpha/src/constants_repr.ml @@ -12,22 +12,33 @@ let version_number = "\000" let proof_of_work_nonce_size = 8 let nonce_length = 32 +(* 10 tez *) let seed_nonce_revelation_tip = - Tez_repr.of_cents_exn 10_00L + Tez_repr.(mul_exn one 10) +(* 1 tez *) let origination_burn = - Tez_repr.of_cents_exn 1_00L + Tez_repr.one +(* 1 tez *) let minimal_contract_balance = - Tez_repr.of_cents_exn 1_00L + Tez_repr.one +(* 1000 tez *) let baking_bond_cost = - Tez_repr.of_cents_exn 1000_00L + Tez_repr.(mul_exn one 1000) +(* 1000 tez *) let endorsement_bond_cost = - Tez_repr.of_cents_exn 1000_00L + Tez_repr.(mul_exn one 1000) +(* 150 tez *) let baking_reward = - Tez_repr.of_cents_exn 150_00L + Tez_repr.(mul_exn one 150) +(* 150 tez *) let endorsement_reward = - Tez_repr.of_cents_exn 150_00L + Tez_repr.(mul_exn one 150) +(* 100,000 tez *) let faucet_credit = - Tez_repr.of_cents_exn 100_000_00L + Tez_repr.(mul_exn one 100_000) +(* 4,000,000 tez *) +let bootstrap_wealth = + Tez_repr.(mul_exn one 4_000_000) type constants = { cycle_length: int32 ; @@ -79,7 +90,7 @@ let default = { max_operation_data_length = 16 * 1024 ; (* 16kB *) initial_roll_value = - Tez_repr.of_cents_exn 10000_00L ; + Tez_repr.(mul_exn one 10_000) ; michelson_maximum_type_size = 1000 ; } diff --git a/lib_embedded_protocol_alpha/src/qty_repr.ml b/lib_embedded_protocol_alpha/src/qty_repr.ml index c9d6f499c..2686f66df 100644 --- a/lib_embedded_protocol_alpha/src/qty_repr.ml +++ b/lib_embedded_protocol_alpha/src/qty_repr.ml @@ -23,6 +23,7 @@ module type S = sig val id : string val zero : qty + val one_mutez : qty val one_cent : qty val fifty_cents : qty val one : qty @@ -32,18 +33,21 @@ module type S = sig val ( *? ) : qty -> int64 -> qty tzresult val ( /? ) : qty -> int64 -> qty tzresult - val to_cents : qty -> int64 + val to_mutez : qty -> int64 - (** [of_cents n] is None if n is negative *) - val of_cents : int64 -> qty option + (** [of_mutez n] (micro tez) is None if n is negative *) + val of_mutez : int64 -> qty option - (** [of_cents_exn n] fails if n is negative. + (** [of_mutez_exn n] fails if n is negative. It should only be used at toplevel for constants. *) - val of_cents_exn : int64 -> qty + val of_mutez_exn : int64 -> qty (** It should only be used at toplevel for constants. *) val add_exn : qty -> qty -> qty + (** It should only be used at toplevel for constants. *) + val mul_exn : qty -> int -> qty + val encoding : qty Data_encoding.t val to_int64 : qty -> int64 @@ -70,63 +74,70 @@ module Make (T: QTY) : S = struct include Compare.Int64 let zero = 0L - let one_cent = 1L - let fifty_cents = 50L - let one = 100L + (* all other constant are defined from the value of one micro tez *) + let one_mutez = 1L + let one_cent = Int64.mul one_mutez 10_000L + let fifty_cents = Int64.mul one_cent 50L + (* 1 tez = 100 cents = 10_000_000 mutez *) + let one = Int64.mul one_cent 100L let id = T.id - let of_cents t = - if t < 0L - then None - else Some t - let of_string s = - let len = String.length s in - let rec dec i len acc = - if Compare.Int.(i = len) then acc + let triplets = function + | hd :: tl -> + let len = String.length hd in + Compare.Int.( + len <= 3 && len > 0 && + List.for_all (fun s -> String.length s = 3) tl + ) + | [] -> false in + let integers s = triplets (String.split_on_char ',' s) in + let decimals s = + let l = String.split_on_char ',' s in + if Compare.Int.(List.length l > 2) then + false else - dec (succ i) len - (Int64.add (Int64.mul 10L acc) - (match String.get s i with - | '0' -> 0L | '1' -> 1L | '2' -> 2L | '3' -> 3L | '4' -> 4L - | '5' -> 5L | '6' -> 6L | '7' -> 7L | '8' -> 8L | '9' -> 9L - | _ -> raise Exit)) in - let rec loop acc m len = - if Compare.Int.(len >= 4) && Compare.Char.(String.get s (len - 4) = ',') then - let acc = Int64.add acc Int64.(mul (dec (len - 3) len 0L) m) in - loop acc Int64.(mul 1000L m) (len - 4) - else - Int64.add acc Int64.(mul (dec 0 len 0L) m) in - let cents, len = - if Compare.Int.(len >= 3) && Compare.Char.(String.get s (len - 3) = '.') then - dec (len - 2) len 0L, len - 3 - else - 0L, len in - let res = - if Compare.Int.(len >= 4) && Compare.Char.(String.get s (len - 4) = ',') then - loop cents 100L len - else if Compare.Int.(len = 0) && Compare.Int.(String.length s = 3) then - cents - else - try - Int64.(add (mul 100L (of_string (String.sub s 0 len))) cents) - with _ -> raise Exit in - match of_cents res with - | None -> raise Exit - | Some tez -> tez - - let of_string s = - try Some (of_string s) with Exit -> None + triplets (List.rev l) in + let parse left right = + let remove_commas s = String.concat "" (String.split_on_char ',' s) in + let pad_to_six s = + let len = String.length s in + String.init 6 (fun i -> if Compare.Int.(i < len) then String.get s i else '0') in + try + Some (Int64.of_string (remove_commas left ^ pad_to_six (remove_commas right))) + with _ -> None in + match String.split_on_char '.' s with + | [ left ; right ] when (integers left && decimals right) -> parse left right + | [ left ] when integers left -> parse left "" + | _ -> None let pp ppf amount = - let rec loop ppf amount= - let d, r = Int64.div amount 1000L, Int64.rem amount 1000L in + let mult_int = 1_000_000L in + let rec left ppf amount = + let d, r = Int64.(div amount 1000L), Int64.(rem amount 1000L) in if d > 0L then - Format.fprintf ppf "%a,%03Ld" loop d r + Format.fprintf ppf "%a,%03Ld" left d r else Format.fprintf ppf "%Ld" r in - let i, c = Int64.div amount 100L, Int64.rem amount 100L in - Format.fprintf ppf "%a.%02Ld" loop i c + let right ppf amount = + let triplet ppf v = + if Compare.Int.(v mod 10 > 0) then + Format.fprintf ppf "%03d" v + else if Compare.Int.(v mod 100 > 0) then + Format.fprintf ppf "%02d" (v / 10) + else + Format.fprintf ppf "%d" (v / 100) in + let hi, lo = amount / 1000, amount mod 1000 in + if Compare.Int.(lo = 0) then + Format.fprintf ppf "%a" triplet hi + else + Format.fprintf ppf "%03d,%a" hi triplet lo in + let ints, decs = + Int64.(div amount mult_int), + Int64.(to_int (rem amount mult_int)) in + Format.fprintf ppf "%a" left ints ; + if Compare.Int.(decs > 0) then + Format.fprintf ppf ".%a" right decs let to_string t = Format.asprintf "%a" pp t @@ -181,20 +192,28 @@ module Make (T: QTY) : S = struct then invalid_arg "add_exn" else t - let to_cents t = t + let mul_exn t m = + match t *? Int64.(of_int m) with + | Ok v -> v + | Error _ -> invalid_arg "mul_exn" - let of_cents_exn x = - match of_cents x with - | None -> invalid_arg "Qty.of_cents" + let of_mutez t = + if t < 0L then None + else Some t + + let of_mutez_exn x = + match of_mutez x with + | None -> invalid_arg "Qty.of_mutez" | Some v -> v let to_int64 t = t + let to_mutez t = t let encoding = let open Data_encoding in describe - ~title: "Amount in centiles" - (conv to_int64 (Json.wrap_error of_cents_exn) int64) + ~title: "Amount in mutez" + (conv to_int64 (Json.wrap_error of_mutez_exn) int64) let () = let open Data_encoding in diff --git a/lib_embedded_protocol_alpha/src/script_interpreter.ml b/lib_embedded_protocol_alpha/src/script_interpreter.ml index 22c544e49..d92b86954 100644 --- a/lib_embedded_protocol_alpha/src/script_interpreter.ml +++ b/lib_embedded_protocol_alpha/src/script_interpreter.ml @@ -325,7 +325,7 @@ let rec interp logged_return (Item (Script_int.mul_n x y, rest), qta - 1, ctxt) | Ediv_teznat, Item (x, Item (y, rest)) -> - let x = Script_int.of_int64 (Tez.to_cents x) in + let x = Script_int.of_int64 (Tez.to_mutez x) in let result = match Script_int.ediv x y with | None -> None @@ -334,7 +334,7 @@ let rec interp Script_int.to_int64 r with | Some q, Some r -> begin - match Tez.of_cents q, Tez.of_cents r with + match Tez.of_mutez q, Tez.of_mutez r with | Some q, Some r -> Some (q,r) (* Cannot overflow *) | _ -> assert false @@ -345,8 +345,8 @@ let rec interp logged_return (Item (result, rest), qta -1, ctxt) | Ediv_tez, Item (x, Item (y, rest)) -> - let x = Script_int.abs (Script_int.of_int64 (Tez.to_cents x)) in - let y = Script_int.abs (Script_int.of_int64 (Tez.to_cents y)) in + let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in + let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in begin match Script_int.ediv_n x y with | None -> logged_return (Item (None, rest), qta -1, ctxt) @@ -355,7 +355,7 @@ let rec interp match Script_int.to_int64 r with | None -> assert false (* Cannot overflow *) | Some r -> - match Tez.of_cents r with + match Tez.of_mutez r with | None -> assert false (* Cannot overflow *) | Some r -> r in logged_return (Item (Some (q, r), rest), qta -1, ctxt) diff --git a/lib_embedded_protocol_alpha/src/tezos_context.ml b/lib_embedded_protocol_alpha/src/tezos_context.ml index 474990bec..8d04341d1 100644 --- a/lib_embedded_protocol_alpha/src/tezos_context.ml +++ b/lib_embedded_protocol_alpha/src/tezos_context.ml @@ -17,13 +17,7 @@ module type BASIC_DATA = sig val pp: Format.formatter -> t -> unit end -module Tez = struct - include Tez_repr - let default_fee = - match of_cents 5L with - | None -> raise (Failure "internal error: Could not parse default_fee literal") - | Some fee -> fee -end +module Tez = Tez_repr module Period = Period_repr module Timestamp = struct diff --git a/lib_embedded_protocol_alpha/src/tezos_context.mli b/lib_embedded_protocol_alpha/src/tezos_context.mli index 1621945f7..bd6f4fdc4 100644 --- a/lib_embedded_protocol_alpha/src/tezos_context.mli +++ b/lib_embedded_protocol_alpha/src/tezos_context.mli @@ -44,10 +44,8 @@ module Tez : sig val of_string: string -> tez option val to_string: tez -> string - val of_cents: int64 -> tez option - val to_cents: tez -> int64 - - val default_fee : t + val of_mutez: int64 -> tez option + val to_mutez: tez -> int64 end diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index 32ae56ca2..6613aa456 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -190,12 +190,10 @@ module Account = struct let transfer ?(block = `Prevalidation) - ?(fee = 5L) + ?(fee = Tez.fifty_cents) ~(account:t) ~destination ~amount () = - let amount = match Tez.of_cents amount with None -> Tez.zero | Some a -> a in - let fee = match Tez.of_cents fee with None -> Tez.zero | Some a -> a in Client_proto_context.transfer (new Client_rpcs.rpc !rpc_config) block ~source:account.contract @@ -208,17 +206,11 @@ module Account = struct let originate ?(block = `Prevalidation) ?delegate - ?(fee=5L) + ?(fee = Tez.fifty_cents) ~(src:t) ~manager_pkh ~balance () = - let fee = match Tez.of_cents fee with - | None -> Tez.zero - | Some amount -> amount in - let balance = match Tez.of_cents balance with - | None -> Tez.zero - | Some amount -> amount in let delegatable, delegate = match delegate with | None -> false, None | Some delegate -> true, Some delegate in @@ -237,14 +229,11 @@ module Account = struct let set_delegate ?(block = `Prevalidation) - ?(fee = 5L) + ?(fee = Tez.fifty_cents) ~contract ~manager_sk ~src_pk delegate_opt = - let fee = match Tez.of_cents fee with - | None -> Tez.zero - | Some amount -> amount in Client_proto_context.set_delegate (new Client_rpcs.rpc !rpc_config) block @@ -319,21 +308,21 @@ module Assert = struct let equal_tez ?msg tz1 tz2 = let msg = Assert.format_msg msg in - let eq tz1 tz2 = Int64.equal (Tez.to_cents tz1) (Tez.to_cents tz2) in + let eq tz1 tz2 = Int64.equal (Tez.to_mutez tz1) (Tez.to_mutez tz2) in let prn = Tez.to_string in Assert.equal ?msg ~prn ~eq tz1 tz2 let balance_equal ?block ~msg account expected_balance = Account.balance ?block account >>=? fun actual_balance -> - match Tez.of_cents expected_balance with + match Tez.of_mutez expected_balance with | None -> failwith "invalid tez constant" | Some expected_balance -> - return (equal_tez ~msg actual_balance expected_balance) + return (equal_tez ~msg expected_balance actual_balance) let delegate_equal ?block ~msg contract expected_delegate = Account.delegate ?block contract >>|? fun actual_delegate -> - equal_pkh ~msg actual_delegate expected_delegate + equal_pkh ~msg expected_delegate actual_delegate let ecoproto_error f = function | Environment.Ecoproto_error errors -> @@ -460,7 +449,7 @@ module Baking = struct Client_proto_rpcs.Header.priority (new Client_rpcs.rpc !rpc_config) block >>=? fun prio -> Baking.endorsement_reward ~block_priority:prio >|= Environment.wrap_error >>|? - Tez.to_cents + Tez.to_mutez end diff --git a/test/proto_alpha/proto_alpha_helpers.mli b/test/proto_alpha/proto_alpha_helpers.mli index 814fced1f..644ae6dcd 100644 --- a/test/proto_alpha/proto_alpha_helpers.mli +++ b/test/proto_alpha/proto_alpha_helpers.mli @@ -58,25 +58,25 @@ module Account : sig val transfer : ?block:Client_proto_rpcs.block -> - ?fee:int64 -> + ?fee: Tez.t -> account:t -> destination:Contract.t -> - amount:int64 -> + amount: Tez.t -> unit -> (Operation_hash.t * Contract.t list) tzresult Lwt.t val originate : ?block:Client_proto_rpcs.block -> ?delegate:public_key_hash -> - ?fee:int64 -> + ?fee: Tez.t -> src:t -> manager_pkh:public_key_hash -> - balance:int64 -> + balance: Tez.t -> unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t val set_delegate : ?block:Client_proto_rpcs.block -> - ?fee:int64 -> + ?fee: Tez.t -> contract:Contract.t -> manager_sk:secret_key -> src_pk:public_key -> diff --git a/test/proto_alpha/test_endorsement.ml b/test/proto_alpha/test_endorsement.ml index 67253ee85..b7b07d1e9 100644 --- a/test/proto_alpha/test_endorsement.ml +++ b/test/proto_alpha/test_endorsement.ml @@ -106,7 +106,7 @@ let test_endorsement_rewards block0 = done ; return (!account, !cpt) in - let bond = Tez.to_cents Constants.endorsement_bond_cost in + let bond = Tez.to_mutez Constants.endorsement_bond_cost in (* Endorsement Rights *) (* #1 endorse & inject in a block *) @@ -117,7 +117,7 @@ let test_endorsement_rewards block0 = Helpers.Baking.bake block0 b1 [ op ] >>=? fun hash1 -> Helpers.display_level (`Hash hash1) >>=? fun () -> Assert.balance_equal ~block:(`Hash hash1) ~msg:__LOC__ account0 - (Int64.sub (Tez.to_cents balance0) bond) >>=? fun () -> + (Int64.sub (Tez.to_mutez balance0) bond) >>=? fun () -> (* #2 endorse & inject in a block *) let block1 = `Hash hash1 in @@ -128,7 +128,7 @@ let test_endorsement_rewards block0 = Helpers.Baking.bake block1 b1 [ op ] >>=? fun hash2 -> Helpers.display_level (`Hash hash2) >>=? fun () -> Assert.balance_equal ~block:(`Hash hash2) ~msg:__LOC__ account1 - (Int64.sub (Tez.to_cents balance1) bond) >>=? fun () -> + (Int64.sub (Tez.to_mutez balance1) bond) >>=? fun () -> (* Check rewards after one cycle for account0 *) Helpers.Baking.bake (`Hash hash2) b1 [] >>=? fun hash3 -> @@ -139,12 +139,12 @@ let test_endorsement_rewards block0 = Helpers.display_level (`Hash hash5) >>=? fun () -> Helpers.Baking.endorsement_reward block1 >>=? fun rw0 -> Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account0 - (Int64.add (Tez.to_cents balance0) rw0) >>=? fun () -> + (Int64.add (Tez.to_mutez balance0) rw0) >>=? fun () -> (* Check rewards after one cycle for account1 *) Helpers.Baking.endorsement_reward (`Hash hash2) >>=? fun rw1 -> Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account1 - (Int64.add (Tez.to_cents balance1) rw1) >>=? fun () -> + (Int64.add (Tez.to_mutez balance1) rw1) >>=? fun () -> (* #2 endorse and check reward only on the good chain *) Helpers.Baking.bake (`Hash hash5) b1 []>>=? fun hash6a -> @@ -178,14 +178,14 @@ let test_endorsement_rewards block0 = (* Check rewards after one cycle *) Helpers.Baking.endorsement_reward (`Hash hash7a) >>=? fun reward -> Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account3 - (Int64.add (Tez.to_cents balance3) reward) >>=? fun () -> + (Int64.add (Tez.to_mutez balance3) reward) >>=? fun () -> (* Check no reward for the fork *) begin if account3 = account4 then return () (* if account4 is different from account3, we need to check that there is no reward for him since the endorsement was in the fork branch *) - else Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account4 (Tez.to_cents balance4) + else Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account4 (Tez.to_mutez balance4) end >>=? fun () -> return () @@ -207,15 +207,15 @@ let run genesis = Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ; Assert.balance_equal - ~block:block ~msg:__LOC__ b1 3_999_000_00L >>=? fun () -> + ~block:block ~msg:__LOC__ b1 3_999_000_000_000L >>=? fun () -> Assert.balance_equal - ~block:block ~msg:__LOC__ b2 4_000_000_00L >>=? fun () -> + ~block:block ~msg:__LOC__ b2 4_000_000_000_000L >>=? fun () -> Assert.balance_equal - ~block:block ~msg:__LOC__ b3 4_000_000_00L >>=? fun () -> + ~block:block ~msg:__LOC__ b3 4_000_000_000_000L >>=? fun () -> Assert.balance_equal - ~block:block ~msg:__LOC__ b4 4_000_000_00L >>=? fun () -> + ~block:block ~msg:__LOC__ b4 4_000_000_000_000L >>=? fun () -> Assert.balance_equal - ~block:block ~msg:__LOC__ b5 4_000_000_00L >>=? fun () -> + ~block:block ~msg:__LOC__ b5 4_000_000_000_000L >>=? fun () -> (* Check Rewards *) test_endorsement_rewards block >>=? fun () -> diff --git a/test/proto_alpha/test_origination.ml b/test/proto_alpha/test_origination.ml index b09c54627..c628812d0 100644 --- a/test/proto_alpha/test_origination.ml +++ b/test/proto_alpha/test_origination.ml @@ -12,6 +12,11 @@ module Assert = Helpers.Assert let run blkid ({ b1 ; b2 ; _ } : Helpers.Account.bootstrap_accounts) = + let cents v = + match Tez.( *? ) Tez.one_cent v with + | Error _ -> Pervasives.failwith "cents" + | Ok r -> r in + Helpers.Baking.bake blkid b1 [] >>=? fun blkh -> let foo = Helpers.Account.create "foo" in @@ -19,46 +24,46 @@ let run blkid ({ b1 ; b2 ; _ } : Helpers.Account.bootstrap_accounts) = Helpers.Account.originate ~src:foo ~manager_pkh:foo.pkh - ~balance:0L () >>= fun result -> + ~balance:Tez.zero () >>= fun result -> Assert.unknown_contract ~msg:__LOC__ result ; (* Origination with amount = .5 tez *) Helpers.Account.originate ~src:b1 ~manager_pkh:foo.pkh - ~balance:50L () >>= fun result -> + ~balance:Tez.fifty_cents () >>= fun result -> Assert.initial_amount_too_low ~msg:__LOC__ result ; (* Origination with amount = 1 tez *) Helpers.Account.originate ~src:b1 ~manager_pkh:foo.pkh - ~balance:99L () >>= fun result -> + ~balance:(cents 99L) () >>= fun result -> Assert.initial_amount_too_low ~msg:__LOC__ result ; (* Origination with amount > 1 tez *) Helpers.Account.originate ~src:b1 ~manager_pkh:foo.pkh - ~balance:100L () >>= fun _result -> + ~balance:Tez.one () >>=? fun _result -> (* TODO: test if new contract exists *) (* Non-delegatable contract *) Helpers.Account.originate ~src:b1 ~manager_pkh:b1.pkh - ~balance:500L () >>=? fun (_oph, nd_contract) -> + ~balance:(cents 1000L) () >>=? fun (_oph, nd_contract) -> (* Delegatable contract *) Helpers.Account.originate ~src:b1 ~manager_pkh:b1.pkh ~delegate:b1.pkh - ~balance:500L () >>=? fun (_oph, d_contract) -> + ~balance:(cents 1000L) () >>=? fun (_oph, d_contract) -> (* Change delegate of a non-delegatable contract *) Helpers.Account.set_delegate - ~fee:5L + ~fee:(cents 5L) ~contract:nd_contract ~manager_sk:b1.sk ~src_pk:b1.pk @@ -70,7 +75,7 @@ let run blkid ({ b1 ; b2 ; _ } : Helpers.Account.bootstrap_accounts) = ~contract:d_contract ~manager_sk:b1.sk ~src_pk:b1.pk - (Some b2.pkh) >>= fun _result -> + (Some b2.pkh) >>=? fun _result -> Assert.delegate_equal ~msg:__LOC__ d_contract (Some b2.pkh) >>=? fun () -> return blkh diff --git a/test/proto_alpha/test_transaction.ml b/test/proto_alpha/test_transaction.ml index 84be46105..9e9c34529 100644 --- a/test/proto_alpha/test_transaction.ml +++ b/test/proto_alpha/test_transaction.ml @@ -16,20 +16,26 @@ let run blkid ({ b1 ; b2 ; b3 ; _ } : Helpers.Account.bootstrap_accounts) = let foo = Helpers.Account.create "foo" in let bar = Helpers.Account.create "bar" in + let tez v = + match Tez.( *? ) Tez.one v with + | Error _ -> Pervasives.failwith "cents" + | Ok r -> r in + (* Send from a sender with no balance (never seen). *) (* TODO: Is it OK to get Storage_error and not something more specific? *) Helpers.Account.transfer ~account:foo ~destination:b1.contract - ~amount:1000_00L () >>= fun result -> + ~amount:(tez 1000L) () >>= fun result -> Assert.unknown_contract ~msg:__LOC__ result ; (* Send 1000 tz to "foo". *) Helpers.Account.transfer ~account:b1 ~destination:foo.contract - ~amount:1000_00L () >>=? fun (_oph, contracts) -> - Assert.balance_equal ~msg:__LOC__ foo 1000_00L >>=? fun () -> + ~fee:Tez.zero + ~amount:(tez 1000L) () >>=? fun (_oph, contracts) -> + Assert.balance_equal ~msg:__LOC__ foo 1000_000_000L >>=? fun () -> (* Check that a basic transfer originates no contracts. *) Assert.equal_int ~msg:__LOC__ 0 (List.length contracts) ; @@ -38,35 +44,36 @@ let run blkid ({ b1 ; b2 ; b3 ; _ } : Helpers.Account.bootstrap_accounts) = Helpers.Account.transfer ~account:foo ~destination:bar.contract - ~amount:50_00L () >>=? fun _contracts -> - Assert.balance_equal ~msg:__LOC__ foo 949_95L >>=? fun () -> - Assert.balance_equal ~msg:__LOC__ bar 50_00L >>=? fun () -> + ~fee:Tez.zero + ~amount:(tez 50L) () >>=? fun _contracts -> + Assert.balance_equal ~msg:__LOC__ foo 950_000_000L >>=? fun () -> + Assert.balance_equal ~msg:__LOC__ bar 50_000_000L >>=? fun () -> (* Check balance too low. *) Helpers.Account.transfer ~account:bar ~destination:foo.contract - ~amount:1000_00L () >>= fun result -> + ~amount:(tez 1000L) () >>= fun result -> Assert.balance_too_low ~msg:__LOC__ result ; (* Check spendability of a spendable contract *) Helpers.Account.originate ~src:foo ~manager_pkh:foo.pkh - ~balance:50_00L () >>=? fun (_oph, spendable) -> + ~balance:(tez 50L) () >>=? fun (_oph, spendable) -> Format.printf "Created contract %a@." Contract.pp spendable ; let account = { foo with contract = spendable } in Helpers.Account.transfer ~account ~destination:foo.contract - ~amount:10_00L () >>=? fun _contracts -> + ~amount:(tez 10L) () >>=? fun _contracts -> (* Try spending a default account with unmatching pk/sk pairs. *) let account = { b1 with sk = b2.sk } in Helpers.Account.transfer ~account ~destination:b2.contract - ~amount:10_00L () >>= fun result -> + ~amount:(tez 10L) () >>= fun result -> Assert.generic_economic_error ~msg:__LOC__ result ; (* Try spending a default account with keys not matching the @@ -75,7 +82,7 @@ let run blkid ({ b1 ; b2 ; b3 ; _ } : Helpers.Account.bootstrap_accounts) = Helpers.Account.transfer ~account ~destination:b3.contract - ~amount:10_00L () >>= fun result -> + ~amount:(tez 10L) () >>= fun result -> Assert.inconsistent_pkh ~msg:__LOC__ result ; (* Try spending an originated contract without the manager's key. *) @@ -83,7 +90,7 @@ let run blkid ({ b1 ; b2 ; b3 ; _ } : Helpers.Account.bootstrap_accounts) = Helpers.Account.transfer ~account ~destination:b2.contract - ~amount:10_00L () >>= fun result -> + ~amount:(tez 10L) () >>= fun result -> Assert.inconsistent_public_key ~msg:__LOC__ result ; return blkh diff --git a/test/test_basic.sh b/test/test_basic.sh index c0b439dfe..224f6d96f 100755 --- a/test/test_basic.sh +++ b/test/test_basic.sh @@ -18,16 +18,17 @@ $client gen keys $key1 $client gen keys $key2 $client list known identities +$client get balance for bootstrap1 -$client transfer 1000 from bootstrap1 to $key1 -$client transfer 2000 from bootstrap1 to $key2 +$client transfer 1,000 from bootstrap1 to $key1 +$client transfer 2,000 from bootstrap1 to $key2 -$client get balance for $key1 | assert "1,000.00 ꜩ" -$client get balance for $key2 | assert "2,000.00 ꜩ" +$client get balance for $key1 | assert "1,000 ꜩ" +$client get balance for $key2 | assert "2,000 ꜩ" -$client transfer 1000 from $key2 to $key1 +$client transfer 1,000 from $key2 to $key1 -$client get balance for $key1 | assert "2,000.00 ꜩ" +$client get balance for $key1 | assert "2,000 ꜩ" $client get balance for $key2 | assert "999.95 ꜩ" # Should fail @@ -41,12 +42,12 @@ $client bake for bootstrap1 -max-priority 512 $client remember program noop file:contracts/noop.tz $client typecheck program noop $client originate contract noop \ - for $key1 transferring 1000 from bootstrap1 \ + for $key1 transferring 1,000 from bootstrap1 \ running noop $client transfer 10 from bootstrap1 to noop -arg "Unit" $client originate contract hardlimit \ - for $key1 transferring 1000 from bootstrap1 \ + for $key1 transferring 1,000 from bootstrap1 \ running file:contracts/hardlimit.tz -init "3" $client transfer 10 from bootstrap1 to hardlimit -arg "Unit" $client transfer 10 from bootstrap1 to hardlimit -arg "Unit" @@ -57,10 +58,10 @@ $client get delegate for free_account $client set delegate for free_account to $key2 $client get delegate for free_account -$client get balance for bootstrap5 | assert "4,000,000.00 ꜩ" -$client transfer 4000000.00 from bootstrap5 to bootstrap1 -fee 0 -$client transfer 4000000.00 from bootstrap1 to bootstrap5 -fee 0 -$client get balance for bootstrap5 | assert "4,000,000.00 ꜩ" +$client get balance for bootstrap5 | assert "4,000,000 ꜩ" +$client transfer 400,000 from bootstrap5 to bootstrap1 -fee 0 +$client transfer 400,000 from bootstrap1 to bootstrap5 -fee 0 +$client get balance for bootstrap5 | assert "4,000,000 ꜩ" echo echo End of test diff --git a/test/test_contracts.sh b/test/test_contracts.sh index 849a27030..947c033ee 100755 --- a/test/test_contracts.sh +++ b/test/test_contracts.sh @@ -218,16 +218,16 @@ assert_output $CONTRACT_PATH/exec_concat.tz Unit '"test"' '"test_abc"' assert_output $CONTRACT_PATH/steps_to_quota.tz Unit Unit 16382 # Get the current balance of the contract -assert_output $CONTRACT_PATH/balance.tz Unit Unit '"4,000,000.00"' +assert_output $CONTRACT_PATH/balance.tz Unit Unit '"4,000,000"' # Test comparisons on tez (List EQ GT LT GE LE) -assert_output $CONTRACT_PATH/compare.tz Unit '(Pair "1.00" "2.00")' '(List False False True False True)' -assert_output $CONTRACT_PATH/compare.tz Unit '(Pair "2.00" "1.00")' '(List False True False True False)' +assert_output $CONTRACT_PATH/compare.tz Unit '(Pair "1" "2")' '(List False False True False True)' +assert_output $CONTRACT_PATH/compare.tz Unit '(Pair "2" "1")' '(List False True False True False)' assert_output $CONTRACT_PATH/compare.tz Unit '(Pair "2.37" "2.37")' '(List True False False True True)' # Test addition and subtraction on tez -assert_output $CONTRACT_PATH/tez_add_sub.tz Unit '(Pair "2.00" "1.00")' '(Pair "3.00" "1.00")' -assert_output $CONTRACT_PATH/tez_add_sub.tz Unit '(Pair "2.31" "1.01")' '(Pair "3.32" "1.30")' +assert_output $CONTRACT_PATH/tez_add_sub.tz Unit '(Pair "2" "1")' '(Pair "3" "1")' +assert_output $CONTRACT_PATH/tez_add_sub.tz Unit '(Pair "2.31" "1.01")' '(Pair "3.32" "1.3")' # Test get first element of list assert_output $CONTRACT_PATH/first.tz Unit '(List 1 2 3 4)' '1' @@ -308,14 +308,14 @@ assert_output $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 500)' '3' '(Pair "hello" assert_output $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 7)' '100' '(Pair "hello" 100)' assert_storage $CONTRACT_PATH/set_caddaadr.tz \ -'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "0.00") 4) 5))) 6)' \ -'"3.00"' \ -'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "3.00") 4) 5))) 6)' +'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "0") 4) 5))) 6)' \ +'"3"' \ +'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "3") 4) 5))) 6)' assert_storage $CONTRACT_PATH/map_caddaadr.tz \ -'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "0.00") 4) 5))) 6)' \ +'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "0") 4) 5))) 6)' \ 'Unit' \ -'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "1.00") 4) 5))) 6)' +'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 "1") 4) 5))) 6)' # Did the given key sign the string? (key is bootstrap1) assert_output $CONTRACT_PATH/check_signature.tz \ @@ -330,16 +330,16 @@ assert_output $CONTRACT_PATH/check_signature.tz \ assert_output $CONTRACT_PATH/hash_key.tz Unit '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' assert_output $CONTRACT_PATH/hash_key.tz Unit '"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES"' '"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k"' -$client transfer 1000 from bootstrap1 to $key1 -$client transfer 2000 from bootstrap1 to $key2 +$client transfer 1,000 from bootstrap1 to $key1 +$client transfer 2,000 from bootstrap1 to $key2 -assert_balance $key1 "1,000.00 ꜩ" -assert_balance $key2 "2,000.00 ꜩ" +assert_balance $key1 "1,000 ꜩ" +assert_balance $key2 "2,000 ꜩ" # Create a contract and transfer 100 ꜩ to it init_with_transfer $CONTRACT_PATH/store_input.tz $key1 '""' 100 bootstrap1 $client transfer 100 from bootstrap1 to store_input -arg '"abcdefg"' -assert_balance store_input "200.00 ꜩ" +assert_balance store_input "200 ꜩ" assert_storage_contains store_input '"abcdefg"' $client transfer 100 from bootstrap1 to store_input -arg '"xyz"' assert_storage_contains store_input '"xyz"' @@ -375,35 +375,35 @@ assert_output $CONTRACT_PATH/diff_timestamps.tz Unit '(Pair "1970-01-01T00:03:20 # Tests TRANSFER_TO $client originate account "test_transfer_account1" for $key1 transferring 100 from bootstrap1 $client originate account "test_transfer_account2" for $key1 transferring 20 from bootstrap1 -init_with_transfer $CONTRACT_PATH/transfer_to.tz $key2 Unit 1000 bootstrap1 -assert_balance test_transfer_account1 "100.00 ꜩ" +init_with_transfer $CONTRACT_PATH/transfer_to.tz $key2 Unit 1,000 bootstrap1 +assert_balance test_transfer_account1 "100 ꜩ" $client transfer 100 from bootstrap1 to transfer_to \ -arg "\"$(get_contract_addr test_transfer_account1)\"" -assert_balance test_transfer_account1 "200.00 ꜩ" # Why isn't this 200 ꜩ? Baking fee? +assert_balance test_transfer_account1 "200 ꜩ" # Why isn't this 200 ꜩ? Baking fee? $client transfer 100 from bootstrap1 to transfer_to \ -arg "\"$(get_contract_addr test_transfer_account2)\"" -assert_balance test_transfer_account2 "120.00 ꜩ" # Why isn't this 120 ꜩ? Baking fee? +assert_balance test_transfer_account2 "120 ꜩ" # Why isn't this 120 ꜩ? Baking fee? # Tests create_account init_with_transfer $CONTRACT_PATH/create_account.tz $key2 \ - "\"$(get_contract_addr test_transfer_account1)\"" 1000 bootstrap1 + "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1 $client transfer 100 from bootstrap1 to create_account \ -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' | assert_in_output "New contract" # Creates a contract, transfers data to it and stores the data init_with_transfer $CONTRACT_PATH/create_contract.tz $key2 \ - "\"$(get_contract_addr test_transfer_account1)\"" 1000 bootstrap1 -$client transfer 0.00 from bootstrap1 to create_contract -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' + "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1 +$client transfer 0 from bootstrap1 to create_contract -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' assert_storage_contains create_contract '"abcdefg"' # Test DEFAULT_ACCOUNT init_with_transfer $CONTRACT_PATH/default_account.tz $key1 \ - Unit 1000 bootstrap1 -$client transfer 0.00 from bootstrap1 to default_account -arg "\"$BOOTSTRAP4_IDENTITY\"" -assert_balance $BOOTSTRAP4_IDENTITY "4,000,100.00 ꜩ" + Unit 1,000 bootstrap1 +$client transfer 0 from bootstrap1 to default_account -arg "\"$BOOTSTRAP4_IDENTITY\"" +assert_balance $BOOTSTRAP4_IDENTITY "4,000,100 ꜩ" account=tz1SuakBpFdG9b4twyfrSMqZzruxhpMeSrE5 -$client transfer 0.00 from bootstrap1 to default_account -arg "\"$account\"" -assert_balance $account "100.00 ꜩ" +$client transfer 0 from bootstrap1 to default_account -arg "\"$account\"" +assert_balance $account "100 ꜩ" assert_fails $client typecheck data '(Map (Item 0 1) (Item 0 1))' against type '(map nat nat)' assert_fails $client typecheck data '(Map (Item 0 1) (Item 10 1) (Item 5 1))' against type '(map nat nat)'