Alpha: Add 4 more decimals to tez representation.
Now a tez cent is 10_000L. All constants are now in the
Constants_repr module and expressed as multiples of one_cent.
Add new function Qty_repr.mul_exn to multiply `tez` by `int`
eg. `10 tez = Tez_repr.(mul_exn one 10)`
`10 cents = Tez_repr.(mul_exn one_cents 10)`
Remove `Tez.{to,of}_cents` and replace them with `Tez.{to,of}_mutez`.
This commit is contained in:
Pietro Abate
Benjamin Canou
parent
a67de99ddb
commit
174ea10d6d
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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 ;
|
||||
}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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 ->
|
||||
|
||||
@ -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 () ->
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user