fa2_allowances.mligo 3.4 KB
Newer Older
1
(**
2 3 4 5 6 7 8 9
  This is a sample implementation of the FA2 transfer hook which supports transfer
  allowances for token spenders.
  Spender is a Tezos address which initiates token transfer operation.
  Owner is a Tezos address which can hold tokens. Owner can transfer its own tokens.
  Spender, other than the owner, MUST be approved to withdraw specific tokens held by
  the owner up to the allowance amount.
  Only token owner can set allowances for specific token types and spenders. 
  The owner does not need to be approved to transfer its own tokens.
10 11
 *)

12
#include "hook_lib.mligo"
13 14 15


type  entry_points =
16
  | Allowances of fa2_allowances_config_entry_points
17
  | Tokens_transferred_hook of hook_param
18 19
  | Register_with_fa2 of fa2_entry_points contract

20 21 22 23
(**
This will not work with babylon/LIGO since `allowance_key` is a composite
non-comparable record which cannot be used as a key in the big_map.
 *)
24
type allowances = (allowance_id, nat) big_map
25

26 27
let get_current_allowance (id : allowance_id) (a : allowances) : nat =
  let a = Big_map.find_opt id a in
28 29 30 31
  match a with
  | Some a -> a
  | None -> 0n

Eugene Mishura's avatar
Eugene Mishura committed
32
let track_allowances (operator : address) (a_tx : allowances * hook_transfer) : allowances =
33 34 35
  let a , tx = a_tx in
  match tx.from_ with
  | None -> a
Eugene Mishura's avatar
Eugene Mishura committed
36 37
  | Some from_ ->
    if Current.self_address <> from_
38
    then a
Eugene Mishura's avatar
Eugene Mishura committed
39
    else
40 41 42 43 44 45 46
      let id : allowance_id = {
        owner = from_;
        token_id = tx.token_id;
        token_manager = Current.sender;
        spender = operator;
      } in 
      let allowance = get_current_allowance id a in
47
      let new_a = Michelson.is_nat (allowance - tx.amount) in
Eugene Mishura's avatar
Eugene Mishura committed
48 49 50 51
      let new_allowance = match new_a with
      | None -> (failwith "Insufficient allowance" : nat)
      | Some a -> a
      in
52
      let new_a = Big_map.update id (Some new_allowance) a in
Eugene Mishura's avatar
Eugene Mishura committed
53
      new_a
54

55 56 57 58 59 60 61 62 63 64 65
let validate_owner (allowances : set_allowance_param list) : unit = 
  let owner = Current.self_address in
  let u = List.iter (fun (a : set_allowance_param) ->
      if a.allowance_id.owner = owner
      then unit
      else failwith "only owner can change its allowances"
    ) allowances in
  unit

let config_allowances (param : fa2_allowances_config_entry_points) (s : allowances)
    : (operation list) * allowances =
66
  match param with
67 68 69 70 71 72 73 74 75 76
  | Set_allowances ps ->
    let u = validate_owner ps in
    let new_s = List.fold (fun (a, cur : allowances * set_allowance_param ) ->
        (* compare and swap *)
        let allowance = get_current_allowance cur.allowance_id s in
        if allowance <> cur.prev_allowance
        then (failwith "cannot update allowance" : allowances)
        else Big_map.update cur.allowance_id (Some cur.new_allowance) a
      ) ps s in
    ([] : operation list),  new_s
77

78 79 80 81 82 83 84 85 86
  | Get_allowances p ->
    let resp = List.map (fun (id : allowance_id) ->
        let allowance = get_current_allowance id s in
        let r : get_allowance_response = {
          allowance_id = id;
          allowance = allowance;
        } in
        r
      ) p.allowance_ids in
87 88 89
    let op = Operation.transaction resp 0mutez p.view in
    [op], s

90 91 92
let main (param, s : entry_points * allowances) : (operation list) * allowances =
  match param with

93
  | Allowances p -> config_allowances p s
94

95
  | Tokens_transferred_hook p ->
Eugene Mishura's avatar
Eugene Mishura committed
96 97
    let new_s = List.fold (track_allowances p.operator) p.batch s in
    ([] : operation list),  new_s
98 99

  | Register_with_fa2 fa2 ->
100
    let op = create_register_hook_op fa2 [Allowances_config Current.self_address] in
101
    [op], s