Commit 58c06dd4 authored by Eugene Mishura's avatar Eugene Mishura

Merge branch 'tzip12-draft' into 'master'

Initial draft of FA2

See merge request !41
parents 0e880f52 da22af71
......@@ -23,7 +23,7 @@ A TZIP should additionally contain an FAQ which documents, compares, and answers
| [TZIP-9] | Info Field for Payment Requests | 06/25/2019 | Work In Progress |
| [TZIP-10] | **LA1** - Wallet Interaction Standard | 09/17/2019 | Draft |
| [TZIP-11] | Contract Specification Schema | - | Work In Progress |
| [TZIP-12] | **FA2** - Multi-Asset Interface | - | Work In Progress |
| [TZIP-12] | **FA2** - Multi-Asset Interface | 01/24/2020 | Work In Progress |
| [TZIP-13] | **FA1.3** - Fungible Asset Standard | 01/02/2020 | Draft |
| [TZIP-14] | GraphQL interface to Tezos node data | 02/03/2020 | Work In Progress |
......
#include "fa2_hook_lib.mligo"
(** generic transfer hook implementation. Behavior is driven by `permissions_descriptor` *)
type get_owner = transfer_descriptor -> address option
type to_hook = address -> (transfer_descriptor_param contract) option
let get_owners (batch, get_owner : (transfer_descriptor list) * get_owner) : address set =
List.fold
(fun (acc, tx : (address set) * transfer_descriptor) ->
match get_owner tx with
| None -> acc
| Some a -> Set.add a acc)
batch
(Set.empty : address set)
let validate_owner_hook (p, get_owner, to_hook, is_required :
transfer_descriptor_param * get_owner * to_hook * bool)
: operation list =
let owners = get_owners (p.batch, get_owner) in
Set.fold
(fun (ops, owner : (operation list) * address) ->
let hook = to_hook owner in
match hook with
| Some h ->
let op = Operation.transaction p 0mutez h in
op :: ops
| None ->
if is_required
then (failwith "token owner does not implement hook interface" : operation list)
else ops)
owners ([] : operation list)
let validate_owner(p, policy, get_owner, to_hook :
transfer_descriptor_param * owner_transfer_policy * get_owner * to_hook)
: operation list =
match policy with
| Owner_no_op -> ([] : operation list)
| Optional_owner_hook -> validate_owner_hook (p, get_owner, to_hook, false)
| Required_owner_hook -> validate_owner_hook (p, get_owner, to_hook, true)
let to_receiver_hook : to_hook = fun (a : address) ->
let c : (transfer_descriptor_param contract) option =
Operation.get_entrypoint_opt "%tokens_received" a in
c
let validate_receivers (p, policy : transfer_descriptor_param * owner_transfer_policy)
: operation list =
let get_receiver : get_owner = fun (tx : transfer_descriptor) -> tx.to_ in
validate_owner (p, policy, get_receiver, to_receiver_hook)
let to_sender_hook : to_hook = fun (a : address) ->
let c : (transfer_descriptor_param contract) option =
Operation.get_entrypoint_opt "%tokens_sent" a in
c
let validate_senders (p, policy : transfer_descriptor_param * owner_transfer_policy)
: operation list =
let get_sender : get_owner = fun (tx : transfer_descriptor) -> tx.from_ in
validate_owner (p, policy, get_sender, to_sender_hook)
let standard_transfer_hook (p, descriptor : transfer_descriptor_param * permissions_descriptor)
: operation list =
let sender_ops = validate_senders (p, descriptor.sender) in
let receiver_ops = validate_receivers (p, descriptor.receiver) in
(* merge two lists *)
List.fold (fun (l, o : (operation list) * operation) -> o :: l) receiver_ops sender_ops
(**
Implementation of the permission transfer hook, with custom behavior.
It uses a combination of a receiver while list and `fa2_token_receiver` interface.
Transfer is permitted if a receiver address is in the receiver white list OR implements
`fa2_token_receiver` interface. If a receiver address implements `fa2_token_receiver`
interface, its `tokens_received` entry point must be called.
*)
#include "fa2_behaviors.mligo"
type storage = {
fa2_registry : fa2_registry;
receiver_whitelist : address set;
}
let custom_validate_receivers (p, wl : transfer_descriptor_param * (address set))
: operation list =
let get_receiver : get_owner = fun (tx : transfer_descriptor) -> tx.to_ in
let receivers = get_owners (p.batch, get_receiver) in
Set.fold
(fun (ops, r : (operation list) * address) ->
let hook = to_sender_hook r in
match hook with
| Some h ->
let op = Operation.transaction p 0mutez h in
op :: ops
| None ->
if Set.mem r wl
then ops
else (failwith "receiver not permitted" : operation list)
)
receivers ([] : operation list)
let custom_transfer_hook (p, s : transfer_descriptor_param * storage) : operation list =
custom_validate_receivers (p, s.receiver_whitelist)
let get_policy_descriptor (u : unit) : permissions_descriptor =
{
self = Self_transfer_permitted;
operator = Operator_transfer_permitted;
sender = Owner_no_op;
receiver = Owner_no_op ; (* overridden by the custom policy *)
custom = Some {
tag = "receiver_hook_and_whitelist";
config_api = (Some Current.self_address);
};
}
type config_whitelist =
| Add_receiver_to_whitelist of address set
| Remove_receiver_from_whitelist of address set
let configure_receiver_whitelist (cfg, wl : config_whitelist * (address set))
: address set =
match cfg with
| Add_receiver_to_whitelist rs ->
Set.fold
(fun (l, a : (address set) * address) -> Set.add a l)
rs wl
| Remove_receiver_from_whitelist rs ->
Set.fold
(fun (l, a : (address set) * address) -> Set.remove a l)
rs wl
type entry_points =
| Tokens_transferred_hook of transfer_descriptor_param
| Register_with_fa2 of fa2_with_hook_entry_points contract
| Config_receiver_whitelist of config_whitelist
let main (param, s : entry_points * storage)
: (operation list) * storage =
match param with
| Tokens_transferred_hook p ->
let u = validate_hook_call (p.fa2, s.fa2_registry) in
let ops = custom_transfer_hook (p, s) in
ops, s
| Register_with_fa2 fa2 ->
let descriptor = get_policy_descriptor unit in
let op , new_registry = register_with_fa2 (fa2, descriptor, s.fa2_registry) in
let new_s = { s with fa2_registry = new_registry; } in
[op], new_s
| Config_receiver_whitelist cfg ->
let new_wl = configure_receiver_whitelist (cfg, s.receiver_whitelist) in
let new_s = { s with receiver_whitelist = new_wl; } in
([] : operation list), new_s
(**
Implementation of the permission transfer hook, which behavior is driven
by a particular settings of `permission_policy`.
*)
#include "fa2_behaviors.mligo"
type storage = {
fa2_registry : fa2_registry;
descriptor : permissions_descriptor;
}
type entry_points =
| Tokens_transferred_hook of transfer_descriptor_param
| Register_with_fa2 of fa2_with_hook_entry_points contract
let main (param, s : entry_points * storage)
: (operation list) * storage =
match param with
| Tokens_transferred_hook p ->
let u = validate_hook_call (p.fa2, s.fa2_registry) in
let ops = standard_transfer_hook (p, s.descriptor) in
ops, s
| Register_with_fa2 fa2 ->
let op , new_registry = register_with_fa2 (fa2, s.descriptor, s.fa2_registry) in
let new_s = { s with fa2_registry = new_registry; } in
[op], new_s
(** example policies *)
(* the policy which allows only token owners to transfer their own tokens. *)
let own_policy : permissions_descriptor = {
self = Self_transfer_permitted;
operator = Operator_transfer_denied;
sender = Owner_no_op;
receiver = Owner_no_op;
custom = (None : custom_permission_policy option);
}
(* non-transferable token (neither token owner, nor operators can transfer tokens. *)
let own_policy : permissions_descriptor = {
self = Self_transfer_denied;
operator = Operator_transfer_denied;
sender = Owner_no_op;
receiver = Owner_no_op;
custom = (None : custom_permission_policy option);
}
#include "../fa2_hook.mligo"
let get_hook_entrypoint (hook_contract : address) (u : unit)
: transfer_descriptor_param contract =
let hook_entry : transfer_descriptor_param contract =
Operation.get_entrypoint "%tokens_transferred_hook" hook_contract in
hook_entry
let create_register_hook_op
(fa2, descriptor : (fa2_with_hook_entry_points contract) * permissions_descriptor) : operation =
let hook_fn = get_hook_entrypoint Current.self_address in
let pp : set_hook_param = {
hook = hook_fn;
permissions_descriptor = descriptor;
} in
Operation.transaction (Set_transfer_hook pp) 0mutez fa2
type fa2_registry = address set
let register_with_fa2 (fa2, descriptor, registry :
(fa2_with_hook_entry_points contract) * permissions_descriptor * fa2_registry)
: operation * fa2_registry =
let op = create_register_hook_op (fa2, descriptor) in
let fa2_address = Current.address fa2 in
let new_registry = Set.add fa2_address registry in
op, new_registry
let validate_hook_call (fa2, registry: address * fa2_registry) : unit =
if Set.mem fa2 registry
then unit
else failwith "unknown FA2 contract called a transfer hook"
(**
Implementation of the permission transfer hook, which behavior is driven
by a particular settings of `permission_policy`. It is possible to use
additional custom policy "schedule" which let pause/unpause transfers
based on used schedule
*)
#include "fa2_behaviors.mligo"
type schedule_interval = {
interval : int;
locked : bool;
}
type schedule = {
start : timestamp;
schedule : schedule_interval list;
cyclic : bool;
}
type schedule_policy = {
schedule : schedule;
schedule_interval : int;
}
type permission_policy = {
descriptor : permission_policy_descriptor;
schedule_policy : schedule_policy option;
}
type storage = {
fa2_registry : fa2_registry;
policy : permission_policy;
}
type schedule_config =
| Set_schedule of schedule
| View_schedule of (schedule option) contract
let configure_schedule (cfg, policy : schedule_config * schedule_policy option)
: (operation list) * (schedule_policy option) =
match cfg with
| Set_schedule s ->
let total_interval = List.fold
(fun (t, i : int * schedule_interval) -> t + i.interval)
s.schedule 0 in
let new_policy : schedule_policy = { schedule = s; schedule_interval = total_interval; } in
([] : operation list), (Some new_policy)
| View_schedule v ->
let s = match policy with
| Some p -> Some p.schedule
| None -> (None : schedule option)
in
let op = Operation.transaction s 0mutez v in
[op], policy
let custom_policy_to_descriptor (p : permission_policy) : permission_policy_descriptor =
match p.schedule_policy with
| None -> p.descriptor
| Some s ->
let custom_p : custom_permission_policy = {
tag = "schedule";
config_api = Some Current.self_address;
}
in
{p.descriptor with custom = Some custom_p; }
type interval_result =
| Reminder of int
| Found of schedule_interval
let is_schedule_locked (policy : schedule_policy) : bool =
let elapsed : int = Current.time - policy.schedule.start in
if elapsed > policy.schedule_interval && not policy.schedule.cyclic
then true
else (* find schedule interval *)
let e = (elapsed mod policy.schedule_interval) + 0 in
let interval = List.fold
(fun (acc, i : interval_result * schedule_interval) ->
match acc with
| Found si -> acc
| Reminder r ->
if r < i.interval then Found i
else Reminder (r - i.interval)
) policy.schedule.schedule (Reminder e) in
match interval with
| Reminder r -> (failwith "schedule logic error" : bool)
| Found i -> i.locked
let validate_schedule (policy : schedule_policy option) : unit =
match policy with
| None -> unit
| Some p ->
let locked = is_schedule_locked p in
if locked
then failwith "transactions are schedule locked"
else unit
type entry_points =
| Tokens_transferred_hook of transfer_descriptor_param
| Register_with_fa2 of fa2_with_hook_entry_points contract
| Config_schedule of schedule_config
let main (param, s : entry_points * storage)
: (operation list) * storage =
match param with
| Tokens_transferred_hook p ->
let u1 = validate_hook_call (p.fa2, s.fa2_registry) in
let u2 = validate_schedule(s.policy.schedule_policy) in
let ops = standard_transfer_hook (p, s.policy.descriptor) in
ops, s
| Register_with_fa2 fa2 ->
let descriptor = custom_policy_to_descriptor s.policy in
let op , new_registry = register_with_fa2 (fa2, descriptor, s.fa2_registry) in
let new_s = { s with fa2_registry = new_registry; } in
[op], new_s
| Config_schedule cfg ->
let ops, new_schedule = configure_schedule (cfg, s.policy.schedule_policy) in
let new_s = { s with policy.schedule_policy = new_schedule; } in
ops, new_s
(** Reference implementation of the FA2 operator storage and config API functions *)
#include "../fa2_interface.mligo"
type operator_tokens_entry =
| All_operator_tokens
| Some_operator_tokens of token_id set
| All_operator_tokens_except of token_id set
(* (owner * operator) -> tokens *)
type operator_storage = ((address * address), operator_tokens_entry) big_map
let add_tokens (existing_ts, ts_to_add : (operator_tokens_entry option) * (token_id set))
: operator_tokens_entry =
match existing_ts with
| None -> Some_operator_tokens ts_to_add
| Some ets -> (
match ets with
| All_operator_tokens -> All_operator_tokens
| Some_operator_tokens ets ->
(* merge sets *)
let new_ts = Set.fold
(fun (acc, tid : (token_id set) * token_id) -> Set.add tid acc)
ts_to_add ets in
Some_operator_tokens new_ts
| All_operator_tokens_except ets ->
(* subtract sets *)
let new_ts = Set.fold
(fun (acc, tid : (token_id set) * token_id) -> Set.remove tid acc)
ts_to_add ets in
if (Set.size new_ts) = 0n
then All_operator_tokens
else All_operator_tokens_except new_ts
)
let add_operator (op, storage : operator_param * operator_storage) : operator_storage =
let key = op.owner, op.operator in
let new_tokens = match op.tokens with
| All_tokens -> All_operator_tokens
| Some_tokens ts_to_add ->
let existing_tokens = Big_map.find_opt key storage in
add_tokens (existing_tokens, ts_to_add)
in
Big_map.update key (Some new_tokens) storage
let remove_tokens (existing_ts, ts_to_remove : (operator_tokens_entry option) * (token_id set))
: operator_tokens_entry option =
match existing_ts with
| None -> (None : operator_tokens_entry option)
| Some ets -> (
match ets with
| All_operator_tokens -> Some (All_operator_tokens_except ts_to_remove)
| Some_operator_tokens ets ->
(* subtract sets *)
let new_ts = Set.fold
(fun (acc, tid : (token_id set) * token_id) -> Set.remove tid acc)
ts_to_remove ets in
if (Set.size new_ts) = 0n
then (None : operator_tokens_entry option)
else Some (Some_operator_tokens new_ts)
| All_operator_tokens_except ets ->
(* merge sets *)
let new_ts = Set.fold
(fun (acc, tid : (token_id set) * token_id) -> Set.add tid acc)
ts_to_remove ets in
Some (All_operator_tokens_except new_ts)
)
let remove_operator (op, storage : operator_param * operator_storage) : operator_storage =
let key = op.owner, op.operator in
let new_tokens_opt = match op.tokens with
| All_tokens -> (None : operator_tokens_entry option)
| Some_tokens ts_to_remove ->
let existing_tokens = Big_map.find_opt key storage in
remove_tokens (existing_tokens, ts_to_remove)
in
Big_map.update key new_tokens_opt storage
let are_tokens_included (existing_tokens, ts : operator_tokens_entry * operator_tokens) : bool =
match existing_tokens with
| All_operator_tokens -> true
| Some_operator_tokens ets -> (
match ts with
| All_tokens -> false
| Some_tokens ots ->
(* all ots tokens must be in ets set*)
Set.fold (fun (res, ti : bool * token_id) ->
if (Set.mem ti ets) then res else false
) ots true
)
| All_operator_tokens_except ets -> (
match ts with
| All_tokens -> false
| Some_tokens ots ->
(* None of the its tokens must be in ets *)
Set.fold (fun (res, ti : bool * token_id) ->
if (Set.mem ti ets) then false else res
) ots true
)
let is_operator_impl (p, storage : operator_param * operator_storage) : bool =
let key = p.owner, p.operator in
let op_tokens = Big_map.find_opt key storage in
match op_tokens with
| None -> false
| Some existing_tokens -> are_tokens_included (existing_tokens, p.tokens)
let update_operators (params, storage : (update_operator list) * operator_storage)
: operator_storage =
List.fold
(fun (s, up : operator_storage * update_operator) ->
match up with
| Add_operator op -> add_operator (op, s)
| Remove_operator op -> remove_operator (op, s)
) params storage
let is_operator (param, storage : is_operator_param * operator_storage) : operation =
let is_op = is_operator_impl (param.operator, storage) in
let r : is_operator_response = {
operator = param.operator;
is_operator = is_op;
} in
Operation.transaction r 0mutez param.callback
type owner_to_tokens = (address, (token_id set)) map
let validate_operator (self, txs, ops_storage
: self_transfer_policy * (transfer list) * operator_storage) : unit =
let can_self_tx = match self with
| Self_transfer_permitted -> true
| Self_transfer_denied -> false
in
let operator = Current.sender in
let tokens_by_owner = List.fold
(fun (owners, tx : owner_to_tokens * transfer) ->
let tokens = Map.find_opt tx.from_ owners in
let new_tokens = match tokens with
| None -> Set.literal [tx.token_id]
| Some ts -> Set.add tx.token_id ts
in
Map.update tx.from_ (Some new_tokens) owners
) txs (Map.empty : owner_to_tokens) in
Map.iter
(fun (owner, tokens : address * (token_id set)) ->
if can_self_tx && owner = operator
then unit
else
let oparam : operator_param = {
owner = owner;
operator = sender;
tokens = Some_tokens tokens;
} in
let is_op = is_operator_impl (oparam, ops_storage) in
if is_op then unit else failwith "not permitted operator"
) tokens_by_owner
This diff is collapsed.
#include "fa2_interface.mligo"
type set_hook_param = {
hook : unit -> transfer_descriptor_param contract;
permissions_descriptor : permissions_descriptor;
}
type fa2_with_hook_entry_points =
| Fa2 of fa2_entry_points
| Set_transfer_hook of set_hook_param
type token_id = nat
type transfer = {
from_ : address;
to_ : address;
token_id : token_id;
amount : nat;
}
type balance_of_request = {
owner : address;
token_id : token_id;
}
type balance_of_response = {
request : balance_of_request;
balance : nat;
}
type balance_of_param = {
requests : balance_of_request list;
callback : (balance_of_response list) contract;
}
type total_supply_response = {
token_id : token_id;
total_supply : nat;
}
type total_supply_param = {
token_ids : token_id list;
callback : (total_supply_response list) contract;
}
type token_metadata = {
token_id : token_id;
symbol : string;
name : string;
decimals : nat;
extras : (string, string) map;
}
type token_metadata_param = {
token_ids : token_id list;
callback : (token_metadata list) contract;
}
type operator_tokens =
| All_tokens
| Some_tokens of token_id set
type operator_param = {
owner : address;
operator : address;
tokens : operator_tokens;
}
type update_operator =
| Add_operator of operator_param
| Remove_operator of operator_param
type is_operator_response = {
operator : operator_param;
is_operator : bool;
}
type is_operator_param = {
operator : operator_param;
callback : (is_operator_response) contract;
}
(* permission policy definition *)
type self_transfer_policy =
| Self_transfer_permitted
| Self_transfer_denied
type operator_transfer_policy =
| Operator_transfer_permitted
| Operator_transfer_denied
type owner_transfer_policy =
| Owner_no_op
| Optional_owner_hook
| Required_owner_hook
type custom_permission_policy = {
tag : string;
config_api: address option;
}
type permissions_descriptor = {
self : self_transfer_policy;
operator : operator_transfer_policy;
receiver : owner_transfer_policy;
sender : owner_transfer_policy;
custom : custom_permission_policy option;
}
type fa2_entry_points =
| Transfer of transfer list
| Balance_of of balance_of_param
| Total_supply of total_supply_param
| Token_metadata of token_metadata_param
| Permissions_descriptor of permissions_descriptor contract
| Update_operators of update_operator list
| Is_operator of is_operator_param
type transfer_descriptor = {
from_ : address option;
to_ : address option;
token_id : token_id;
amount : nat;
}
type transfer_descriptor_param = {
fa2 : address;
batch : transfer_descriptor list;
operator : address;
}
type fa2_token_receiver =
| Tokens_received of transfer_descriptor_param
type fa2_token_sender =
| Tokens_sent of transfer_descriptor_param
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment