diff --git a/src/stages/1-ast_imperative/combinators.mli b/src/stages/1-ast_imperative/combinators.mli index 9e1a28b5b..46e02fa9e 100644 --- a/src/stages/1-ast_imperative/combinators.mli +++ b/src/stages/1-ast_imperative/combinators.mli @@ -49,6 +49,7 @@ val t_michelson_pair : ?loc:Location.t -> type_expression -> michelson_prct_anno val t_operator : ?loc:Location.t -> type_operator -> type_expression list -> type_expression result val t_set : ?loc:Location.t -> type_expression -> type_expression +val t_contract : ?loc:Location.t -> type_expression -> type_expression val make_e : ?loc:Location.t -> expression_content -> expression diff --git a/src/test/contracts/FA1.2.ligo b/src/test/contracts/FA1.2.ligo new file mode 100644 index 000000000..15d3bb917 --- /dev/null +++ b/src/test/contracts/FA1.2.ligo @@ -0,0 +1,116 @@ +type tokens is big_map (address, nat) +type allowances is big_map (address * address, nat) (* (sender,account) -> value *) + +type storage is record [ + tokens : tokens; + allowances : allowances; + total_amount : nat; +] + +type transfer is record [ + address_from : address; + address_to : address; + value : nat; +] + +type approve is record [ + spender : address; + value : nat; +] + +type getAllowance is record [ + owner : address; + spender : address; + callback : contract (nat); +] + +type getBalance is record [ + owner : address; + callback : contract (nat); +] + +type getTotalSupply is record [ + callback : contract (nat); +] + +type action is + Transfer of transfer +| Approve of approve +| GetAllowance of getAllowance +| GetBalance of getBalance +| GetTotalSupply of getTotalSupply + +function transfer (const p : transfer; const s: storage) : list (operation) * storage is block { + var new_allowances : allowances := Big_map.empty; + if Tezos.sender = p.address_from + then { new_allowances := s.allowances; } + else { + var authorized_value : nat := + case (Big_map.find_opt ((Tezos.sender,p.address_from), s.allowances)) of + Some (value) -> value + | None -> 0n + end; + if (authorized_value < p.value) + then { failwith("Not Enough Allowance")} + else { new_allowances := Big_map.update ((Tezos.sender,p.address_from), (Some (abs(authorized_value - p.value))), s.allowances) } + }; + var sender_balance : nat := case (Big_map.find_opt (p.address_from, s.tokens)) of + Some (value) -> value + | None -> 0n + end; + var new_tokens : tokens := Big_map.empty; + if (sender_balance < p.value) + then { failwith ("Not Enough Balance")} + else { + new_tokens := Big_map.update (p.address_from, (Some (abs(sender_balance - p.value))), s.tokens); + var receiver_balance : nat := case (Big_map.find_opt (p.address_to, s.tokens)) of + Some (value) -> value + | None -> 0n + end; + new_tokens := Big_map.update (p.address_to, (Some (receiver_balance + p.value)), new_tokens); + } +} with ((nil: list (operation)), s with record [tokens = new_tokens; allowances = new_allowances]) + +function approve (const p : approve; const s : storage) : list (operation) * storage is block { + var previous_value : nat := case Big_map.find_opt ((p.spender, Tezos.sender), s.allowances) of + Some (value) -> value + | None -> 0n + end; + var new_allowances : allowances := Big_map.empty; + if previous_value > 0n and p.value > 0n + then { failwith ("Unsafe Allowance Change")} + else { + new_allowances := Big_map.update ((p.spender, Tezos.sender), (Some (p.value)), s.allowances); + } +} with ((nil: list (operation)), s with record [allowances = new_allowances]) + +function getAllowance (const p : getAllowance; const s : storage) : list (operation) * storage is block { + var value : nat := case Big_map.find_opt ((p.owner, p.spender), s.allowances) of + Some (value) -> value + | None -> 0n + end; + var op : operation := Tezos.transaction (value, 0mutez, p.callback); +} with (list [op],s) + +function getBalance (const p : getBalance; const s : storage) : list (operation) * storage is block { + var value : nat := case Big_map.find_opt (p.owner, s.tokens) of + Some (value) -> value + | None -> 0n + end; + var op : operation := Tezos.transaction (value, 0mutez, p.callback); +} with (list [op],s) + +function getTotalSupply (const p : getTotalSupply; const s : storage) : list (operation) * storage is block { + var total : nat := s.total_amount; + var op : operation := Tezos.transaction (total, 0mutez, p.callback); +} with (list [op],s) + + +function main (const a : action; const s : storage) : list (operation) * storage is + case a of + Transfer (p) -> transfer (p,s) + | Approve (p) -> approve (p,s) + | GetAllowance (p) -> getAllowance (p,s) + | GetBalance (p) -> getBalance (p,s) + | GetTotalSupply (p) -> getTotalSupply (p,s) + end; diff --git a/src/test/contracts/FA1.2.mligo b/src/test/contracts/FA1.2.mligo new file mode 100644 index 000000000..f03f3c2f9 --- /dev/null +++ b/src/test/contracts/FA1.2.mligo @@ -0,0 +1,109 @@ +type tokens = (address, nat) big_map +type allowances = (address * address, nat) big_map (* (sender,account) -> value *) + +type storage = { + tokens : tokens; + allowances : allowances; + total_amount : nat; +} + +type transfer = { + address_from : address; + address_to : address; + value : nat; +} + +type approve = { + spender : address; + value : nat; +} + +type getAllowance = { + owner : address; + spender : address; + callback : nat contract; +} + +type getBalance = { + owner : address; + callback : nat contract; +} + +type getTotalSupply = { + callback : nat contract; +} + +type action = + Transfer of transfer +| Approve of approve +| GetAllowance of getAllowance +| GetBalance of getBalance +| GetTotalSupply of getTotalSupply + +let transfer (p,s : transfer * storage) : operation list * storage = + let new_allowances = + if Tezos.sender = p.address_from then s.allowances + else + let authorized_value = match Big_map.find_opt (Tezos.sender,p.address_from) s.allowances with + Some value -> value + | None -> 0n + in + if (authorized_value < p.value) + then (failwith "Not Enough Allowance" : allowances) + else Big_map.update (Tezos.sender,p.address_from) (Some (abs(authorized_value - p.value))) s.allowances + in + let sender_balance = match Big_map.find_opt p.address_from s.tokens with + Some value -> value + | None -> 0n + in + if (sender_balance < p.value) + then (failwith "Not Enough Balance" : operation list * storage) + else + let new_tokens = Big_map.update p.address_from (Some (abs(sender_balance - p.value))) s.tokens in + let receiver_balance = match Big_map.find_opt p.address_to s.tokens with + Some value -> value + | None -> 0n + in + let new_tokens = Big_map.update p.address_to (Some (receiver_balance + p.value)) new_tokens in + ([]:operation list), {s with tokens = new_tokens; allowances = new_allowances} + +let approve (p,s : approve * storage) : operation list * storage = + let previous_value = match Big_map.find_opt (p.spender, Tezos.sender) s.allowances with + Some value -> value + | None -> 0n + in + if previous_value > 0n && p.value > 0n + then (failwith "Unsafe Allowance Change" : operation list * storage) + else + let new_allowances = Big_map.update (p.spender, Tezos.sender) (Some (p.value)) s.allowances in + ([] : operation list), {s with allowances = new_allowances} + +let getAllowance (p,s : getAllowance * storage) : operation list * storage = + let value = match Big_map.find_opt (p.owner, p.spender) s.allowances with + Some value -> value + | None -> 0n + in + let op = Tezos.transaction value 0mutez p.callback in + ([op],s) + +let getBalance (p,s : getBalance * storage) : operation list * storage = + let value = match Big_map.find_opt p.owner s.tokens with + Some value -> value + | None -> 0n + in + let op = Tezos.transaction value 0mutez p.callback in + ([op],s) + +let getTotalSupply (p,s : getTotalSupply * storage) : operation list * storage = + let total = s.total_amount in + let op = Tezos.transaction total 0mutez p.callback in + ([op],s) + + +let main (a,s:action * storage) = + match a with + Transfer p -> transfer (p,s) + | Approve p -> approve (p,s) + | GetAllowance p -> getAllowance (p,s) + | GetBalance p -> getBalance (p,s) + | GetTotalSupply p -> getTotalSupply (p,s) diff --git a/src/test/contracts/FA1.2.religo b/src/test/contracts/FA1.2.religo new file mode 100644 index 000000000..37b194738 --- /dev/null +++ b/src/test/contracts/FA1.2.religo @@ -0,0 +1,115 @@ +type tokens = big_map (address, nat) +type allowances = big_map ((address, address), nat) /* (sender,account) -> value */ + +type storage = { + tokens : tokens, + allowances : allowances, + total_amount : nat, +} + +type transfer = { + address_from : address, + address_to : address, + value : nat, +} + +type approve = { + spender : address, + value : nat, +} + +type getAllowance = { + owner : address, + spender : address, + callback : contract (nat), +} + +type getBalance = { + owner : address, + callback : contract (nat), +} + +type getTotalSupply = { + callback : contract (nat), +} + +type action = +| Transfer ( transfer ) +| Approve ( approve ) +| GetAllowance ( getAllowance ) +| GetBalance ( getBalance ) +| GetTotalSupply ( getTotalSupply ) + +let transfer = ((p,s) : (transfer, storage)) : (list (operation), storage) => { + let new_allowances = + if (Tezos.sender == p.address_from) { s.allowances; } + else { + let authorized_value = switch (Big_map.find_opt ((Tezos.sender,p.address_from), s.allowances)) { + | Some value => value + | None => 0n + }; + if (authorized_value < p.value) { (failwith ("Not Enough Allowance") : allowances); } + else { Big_map.update ((Tezos.sender,p.address_from), (Some (abs(authorized_value - p.value))), s.allowances); }; + }; + let sender_balance = switch (Big_map.find_opt (p.address_from, s.tokens)) { + | Some value => value + | None => 0n + }; + if (sender_balance < p.value) { (failwith ("Not Enough Balance") : (list (operation), storage)); } + else { + let new_tokens = Big_map.update (p.address_from, (Some (abs(sender_balance - p.value))), s.tokens); + let receiver_balance = switch (Big_map.find_opt (p.address_to, s.tokens)) { + | Some value => value + | None => 0n + }; + let new_tokens = Big_map.update (p.address_to, (Some (receiver_balance + p.value)), new_tokens); + (([]: list (operation)), { ...s,tokens:new_tokens, allowances:new_allowances}); + }; +}; + +let approve = ((p,s) : (approve, storage)) : (list (operation), storage) => { + let previous_value = switch (Big_map.find_opt ((p.spender, Tezos.sender), s.allowances)){ + | Some value => value + | None => 0n + }; + if (previous_value > 0n && p.value > 0n) + { (failwith ("Unsafe Allowance Change") : (list (operation), storage)); } + else { + let new_allowances = Big_map.update ((p.spender, Tezos.sender), (Some (p.value)), s.allowances); + (([] : list (operation)), { ...s, allowances : new_allowances}); + }; +}; + +let getAllowance = ((p,s) : (getAllowance, storage)) : (list (operation), storage) => { + let value = switch (Big_map.find_opt ((p.owner, p.spender), s.allowances)) { + | Some value => value + | None => 0n + }; + let op = Tezos.transaction (value, 0mutez, p.callback); + ([op],s) +}; + +let getBalance = ((p,s) : (getBalance, storage)) : (list (operation), storage) => { + let value = switch (Big_map.find_opt (p.owner, s.tokens)) { + | Some value => value + | None => 0n + }; + let op = Tezos.transaction (value, 0mutez, p.callback); + ([op],s) +}; + +let getTotalSupply = ((p,s) : (getTotalSupply, storage)) : (list (operation), storage) => { + let total = s.total_amount; + let op = Tezos.transaction (total, 0mutez, p.callback); + ([op],s) +}; + + +let main = ((a,s): (action, storage)) => + switch a { + | Transfer p => transfer ((p,s)) + | Approve p => approve ((p,s)) + | GetAllowance p => getAllowance ((p,s)) + | GetBalance p => getBalance ((p,s)) + | GetTotalSupply p => getTotalSupply ((p,s)) + }; diff --git a/src/test/test.ml b/src/test/test.ml index c21411092..01d8a78f6 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -18,5 +18,6 @@ let () = Hash_lock_tests.main ; Time_lock_repeat_tests.main ; Pledge_tests.main ; + Tzip12_tests.main ; ] ; () diff --git a/src/test/tzip12_tests.ml b/src/test/tzip12_tests.ml new file mode 100644 index 000000000..db5996c9e --- /dev/null +++ b/src/test/tzip12_tests.ml @@ -0,0 +1,190 @@ +open Trace +open Test_helpers + +let file_FA12 = "./contracts/FA1.2.ligo" +let mfile_FA12 = "./contracts/FA1.2.mligo" +let refile_FA12 = "./contracts/FA1.2.religo" + +let type_file f s = + let%bind typed,state = Ligo.Compile.Utils.type_file f s (Contract "main") in + ok @@ (typed,state) + +let get_program f st = + let s = ref None in + fun () -> match !s with + | Some s -> ok s + | None -> ( + let%bind program = type_file f st in + s := Some program ; + ok program + ) + +let compile_main f s () = + let%bind typed_prg,_ = get_program f s () in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Ligo.Compile.Of_michelson.build_contract michelson_prg in + ok () + +open Ast_imperative + + +let (sender , contract) = + let open Proto_alpha_utils.Memory_proto_alpha in + let id = List.nth dummy_environment.identities 0 in + let kt = id.implicit_contract in + Protocol.Alpha_context.Contract.to_b58check kt , kt + +let external_contract = + let open Proto_alpha_utils.Memory_proto_alpha in + let id = List.nth dummy_environment.identities 4 in + let kh = id.public_key_hash in + Tezos_utils.Signature.Public_key_hash.to_string kh + +let from_ = e_address @@ addr 5 +let to_ = e_address @@ addr 2 +let sender = e_address @@ sender +let external_contract = e_annotation (e_constant C_IMPLICIT_ACCOUNT [e_key_hash external_contract]) (t_contract (t_nat ())) + +let transfer f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair sender from_, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("address_from", from_);("address_to",to_); ("value",e_nat 10)] in + let new_storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 90); (to_, e_nat 110)]); + ("allowances", e_big_map [(e_pair sender from_, e_nat 90)]); + ("total_amount",e_nat 300); + ] in + let input = e_pair parameter storage in + let expected = e_pair (e_typed_list [] (t_operation ())) new_storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_eq program ~options "transfer" input expected + +let transfer_not_e_allowance f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair sender from_, e_nat 0)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("address_from", from_);("address_to",to_); ("value",e_nat 10)] in + let input = e_pair parameter storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_string_failwith ~options program "transfer" input + "Not Enough Allowance" + +let transfer_not_e_balance f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 0); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair sender from_, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("address_from", from_);("address_to",to_); ("value",e_nat 10)] in + let input = e_pair parameter storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_string_failwith ~options program "transfer" input + "Not Enough Balance" + +let approve f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair from_ sender, e_nat 0)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("spender", from_);("value",e_nat 100)] in + let new_storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let input = e_pair parameter storage in + let expected = e_pair (e_typed_list [] (t_operation ())) new_storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_eq program ~options "approve" input expected + +let approve_unsafe f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("spender", from_);("value",e_nat 100)] in + let input = e_pair parameter storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_string_failwith ~options program "approve" input + "Unsafe Allowance Change" + +let get_allowance f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("owner", from_);("spender",sender); ("callback", external_contract)] in + let input = e_pair parameter storage in + let expected = e_pair (e_typed_list [] (t_operation ())) storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_eq program ~options "getAllowance" input expected + +let get_balance f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("owner", from_);("callback", external_contract)] in + let input = e_pair parameter storage in + let expected = e_pair (e_typed_list [] (t_operation ())) storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_eq program ~options "getBalance" input expected + +let get_total_supply f s () = + let%bind program,_ = get_program f s () in + let storage = e_record_ez [ + ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); + ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); + ("total_amount",e_nat 300); + ] in + let parameter = e_record_ez [("callback", external_contract)] in + let input = e_pair parameter storage in + let expected = e_pair (e_typed_list [] (t_operation ())) storage in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in + expect_eq program ~options "getTotalSupply" input expected + +let main = test_suite "tzip-12" [ + test "transfer" (transfer file_FA12 "pascaligo"); + test "transfer (not enough allowance)" (transfer_not_e_allowance file_FA12 "pascaligo"); + test "transfer (not enough balance)" (transfer_not_e_balance file_FA12 "pascaligo"); + test "approve" (approve file_FA12 "pascaligo"); + test "approve (unsafe allowance change)" (approve_unsafe file_FA12 "pascaligo"); + (* test "getAllowance" (get_allowance file_FA12 "pascaligo"); + test "getBalance" (get_balance file_FA12 "pascaligo"); + test "getTotalSupply" (get_total_supply file_FA12 "pascaligo"); waiting for a dummy_contract with type nat contractt*) + test "transfer" (transfer mfile_FA12 "cameligo"); + test "transfer (not enough allowance)" (transfer_not_e_allowance mfile_FA12 "cameligo"); + test "transfer (not enough balance)" (transfer_not_e_balance mfile_FA12 "cameligo"); + test "approve" (approve mfile_FA12 "cameligo"); + test "approve (unsafe allowance change)" (approve_unsafe mfile_FA12 "cameligo"); + (* test "getAllowance" (get_allowance mfile_FA12 "cameligo"); + test "getBalance" (get_balance mfile_FA12 "cameligo"); + test "getTotalSupply" (get_total_supply mfile_FA12 "cameligo"); waiting for a dummy_contract with type nat contractt*) + test "transfer" (transfer refile_FA12 "reasonligo"); + test "transfer (not enough allowance)" (transfer_not_e_allowance refile_FA12 "reasonligo"); + test "transfer (not enough balance)" (transfer_not_e_balance refile_FA12 "reasonligo"); + test "approve" (approve refile_FA12 "reasonligo"); + test "approve (unsafe allowance change)" (approve_unsafe refile_FA12 "reasonligo"); + (* test "getAllowance" (get_allowance refile_FA12 "reasonligo"); + test "getBalance" (get_balance refile_FA12 "reasonligo"); + test "getTotalSupply" (get_total_supply refile_FA12 "reasonligo"); waiting for a dummy_contract with type nat contractt*) + ]