diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 0adcfbfb4cdc7e22bbeba521a0345db00857f5c9..a26f292860112088bd9063a94fae529c6e955cdb 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -38,6 +38,7 @@ "Commitment_repr", "Parameters_repr", "Sapling_repr", + "Ticket_repr", "Lazy_storage_kind", "Receipt_repr", "Migration_repr", @@ -63,6 +64,7 @@ "Voting_period_storage", "Vote_storage", "Commitment_storage", + "Ticket_storage", "Fees_storage", "Liquidity_baking_repr", "Liquidity_baking_cpmm", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index d1727ef94015e6efb1177c91b0ad68cb0466fd5e..12d0c73f80db1c4f195fb5a325e81617cd16bcb2 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -521,3 +521,12 @@ module Cache = struct let identifier_rank ctxt id = Admin.key_rank ctxt (mk ~id) end) end + +module Ticket_balance = struct + include Ticket_repr + include Ticket_storage + + module Internal_for_tests = struct + let get_balance = get_balance + end +end diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index e87b92a7294fe359700a94fed3580b34ad05ce79..fe52e366f32ef40c7c3f4c2d51b2034e8223d4ad 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* Copyright (c) 2019-2021 Nomadic Labs *) +(* Copyright (c) 2021 Trili Tech, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -2064,3 +2065,40 @@ module Liquidity_baking : sig (context -> Contract.t -> (context * 'a list) tzresult Lwt.t) -> (context * 'a list * escape_ema) tzresult Lwt.t end + +(** This module exposes a balance table for tracking ticket ownership. + The table is a mapping from keys to values where the keys consist of: + - A token, which is a ticketer and a content pair. + - The contract that owns the tokens. + Values represent the amount owned of a particular token type. + + This module re-exports functions from [Ticket_repr] and [Ticket_storage]. + See documentation of the functions there. + *) +module Ticket_balance : sig + type error += + | Ticket_balance_negative of {key : Ticket_repr.key; balance : Z.t} + + type token = {ticketer : Contract.t; content : bytes} + + val pp_token : Format.formatter -> token -> unit + + val token_encoding : token Data_encoding.t + + val compare_token : token -> token -> int + + val adjust_balance : + t -> + token:token -> + owner:Contract.t -> + delta:Z.t -> + (t, error trace) result Lwt.t + + module Internal_for_tests : sig + val get_balance : + t -> + token:token -> + owner:Contract.t -> + (Z.t option * t, error trace) result Lwt.t + end +end diff --git a/src/proto_alpha/lib_protocol/dune.inc b/src/proto_alpha/lib_protocol/dune.inc index 639f69fcda37d98b1521c4c280025e7175b39ee1..7540dc652588b8e22bd919646a273baff4d80b82 100644 --- a/src/proto_alpha/lib_protocol/dune.inc +++ b/src/proto_alpha/lib_protocol/dune.inc @@ -63,6 +63,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml sapling_repr.ml + ticket_repr.mli ticket_repr.ml lazy_storage_kind.mli lazy_storage_kind.ml receipt_repr.mli receipt_repr.ml migration_repr.mli migration_repr.ml @@ -86,6 +87,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end voting_period_storage.mli voting_period_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml + ticket_storage.mli ticket_storage.ml fees_storage.mli fees_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml @@ -163,6 +165,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml sapling_repr.ml + ticket_repr.mli ticket_repr.ml lazy_storage_kind.mli lazy_storage_kind.ml receipt_repr.mli receipt_repr.ml migration_repr.mli migration_repr.ml @@ -186,6 +189,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end voting_period_storage.mli voting_period_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml + ticket_storage.mli ticket_storage.ml fees_storage.mli fees_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml @@ -263,6 +267,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml sapling_repr.ml + ticket_repr.mli ticket_repr.ml lazy_storage_kind.mli lazy_storage_kind.ml receipt_repr.mli receipt_repr.ml migration_repr.mli migration_repr.ml @@ -286,6 +291,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end voting_period_storage.mli voting_period_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml + ticket_storage.mli ticket_storage.ml fees_storage.mli fees_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml @@ -385,6 +391,7 @@ include Tezos_raw_protocol_alpha.Main Commitment_repr Parameters_repr Sapling_repr + Ticket_repr Lazy_storage_kind Receipt_repr Migration_repr @@ -408,6 +415,7 @@ include Tezos_raw_protocol_alpha.Main Voting_period_storage Vote_storage Commitment_storage + Ticket_storage Fees_storage Liquidity_baking_repr Liquidity_baking_cpmm @@ -524,6 +532,7 @@ include Tezos_raw_protocol_alpha.Main commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml sapling_repr.ml + ticket_repr.mli ticket_repr.ml lazy_storage_kind.mli lazy_storage_kind.ml receipt_repr.mli receipt_repr.ml migration_repr.mli migration_repr.ml @@ -547,6 +556,7 @@ include Tezos_raw_protocol_alpha.Main voting_period_storage.mli voting_period_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml + ticket_storage.mli ticket_storage.ml fees_storage.mli fees_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index eaab9bcb047d9e36c4e80f238e3daafdb970446a..bb51466bbf664a7bb141cdf413045cb872920d74 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1327,3 +1327,15 @@ module Liquidity_baking = struct end) (Contract_repr) end + +module Ticket_balance = struct + module Name = struct + let name = ["ticket_balance"] + end + + module Ticket_index = Make_index (Ticket_repr.Index) + module Ticket_subcontext = Make_subcontext (Registered) (Raw_context) (Name) + module Table = + Make_indexed_carbonated_data_storage (Ticket_subcontext) (Ticket_index) + (Encoding.Z) +end diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index ac28bdc722ddd7bd22f4f240fe006e431666eb13..9af7d317b496edb9978b7a9ab6b4b792036b1653 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -530,3 +530,17 @@ module Global_constants : sig and type key = Script_expr_hash.t and type value = Script_repr.expr end + +(** This module exposes a balance table for tracking ticket ownership. + The table is a mapping from keys to values where the keys consist of: + - A token, which is a ticketer and a content pair. + - The contract that owns the tokens. + Values represent the amount owned of a particular token type. + *) +module Ticket_balance : sig + module Table : + Non_iterable_indexed_carbonated_data_storage + with type t := Raw_context.t + and type key = Ticket_repr.key + and type value = Z.t +end diff --git a/src/proto_alpha/lib_protocol/test/dune b/src/proto_alpha/lib_protocol/test/dune index 14fd104dabbfb6aac8edd61a89e28a1dbba5a33b..07756af2e2fc433a08539b364b958f7e2f14598d 100644 --- a/src/proto_alpha/lib_protocol/test/dune +++ b/src/proto_alpha/lib_protocol/test/dune @@ -4,7 +4,8 @@ test_gas_properties test_tez_repr liquidity_baking_pbt - test_script_comparison) + test_script_comparison + test_ticket_repr) (libraries tezos-base tezos-micheline tezos-protocol-environment @@ -69,6 +70,11 @@ (package tezos-protocol-alpha-tests) (action (run %{exe:liquidity_baking_pbt.exe}))) +(rule + (alias runtest_ticket_repr) + (package tezos-protocol-alpha-tests) + (action (run %{exe:test_ticket_repr.exe}))) + (rule (alias runtest) (package tezos-protocol-alpha-tests) @@ -77,5 +83,6 @@ (alias runtest_saturation_fuzzing) (alias runtest_test_tez_repr) (alias runtest_liquidity_baking_pbt) + (alias runtest_ticket_repr) (alias runtest_test_script_comparison)) (action (progn))) diff --git a/src/proto_alpha/lib_protocol/test/test_ticket_repr.ml b/src/proto_alpha/lib_protocol/test/test_ticket_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..83572ec62c830cf89096333c662a5d94406bcbda --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/test_ticket_repr.ml @@ -0,0 +1,139 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Protocol (Ticket_repr) + Invocation: dune exec src/proto_alpha/lib_protocol/test/test_ticket_repr.exe + Subject: Ticket repr tests +*) + +open Protocol + +let make_contract s = + let op_hash = Operation_hash.of_bytes_exn (Bytes.of_string s) in + let org_nonce = Contract_repr.initial_origination_nonce @@ op_hash in + Contract_repr.originated_contract org_nonce + +let make_token ticketer content = Ticket_repr.{ticketer; content} + +let make_key token owner = Ticket_repr.{token; owner} + +let key_to_string key = + match Ticket_repr.Index.to_path key [] with [x] -> x | _ -> assert false + +let compare_string_keys k1 k2 = + String.compare (key_to_string k1) (key_to_string k2) + +let test_key_equal k1 k2 = + let r1 = Ticket_repr.Index.compare k1 k2 = 0 in + let r2 = compare_string_keys k1 k2 = 0 in + Alcotest.equal Alcotest.bool r1 r2 + +module Generators = struct + open Lib_test + open QCheck + + let ( let* ) = QCheck.Gen.( >>= ) + + let contract_gen = + let addr = Gen.string_size (Gen.return 32) in + let def_contract = make_contract "test-operation-hash-of-length-32" in + Gen.oneof [Gen.map make_contract addr; Gen.return def_contract] + + let token_with_ticketer_gen ~ticketer = + let* arb_content = Qcheck_helpers.bytes_arb.gen in + Gen.oneof + [ + Gen.return (make_token ticketer arb_content); + Gen.return (make_token ticketer @@ Bytes.empty); + Gen.return (make_token ticketer @@ Bytes.of_string "A"); + Gen.return (make_token ticketer @@ Bytes.of_string "0"); + ] + + let key_gen = + let* ticketer = contract_gen in + let* owner = Gen.oneof [Gen.return ticketer; contract_gen] in + let* token = token_with_ticketer_gen ~ticketer in + Gen.return @@ make_key token owner + + let token_gen = + let* ticketer = contract_gen in + token_with_ticketer_gen ~ticketer +end + +let prop_token_encode_decode token = + let string_token = + Data_encoding.Binary.to_string_exn Ticket_repr.token_encoding token + in + let token2 = + Data_encoding.Binary.of_string_exn Ticket_repr.token_encoding string_token + in + let string_token2 = + Data_encoding.Binary.to_string_exn Ticket_repr.token_encoding token2 + in + Ticket_repr.compare_token token token2 = 0 + && String.equal string_token string_token2 + +let prop_key_encode_decode key = + let string_key = + Data_encoding.Binary.to_string_exn Ticket_repr.key_encoding key + in + let key2 = + Data_encoding.Binary.of_string_exn Ticket_repr.key_encoding string_key + in + let string_key2 = + Data_encoding.Binary.to_string_exn Ticket_repr.key_encoding key2 + in + Ticket_repr.Index.compare key key2 = 0 && String.equal string_key string_key2 + +let tests = + [ + QCheck.Test.make + ~count:1000 + ~name:"Test ticket-key equality for the same ticket" + (QCheck.make Generators.key_gen) + (fun key -> test_key_equal key key); + QCheck.Test.make + ~count:1000 + ~name:"Test ticket-key equality for different tickets" + (QCheck.make @@ QCheck.Gen.pair Generators.key_gen Generators.key_gen) + (fun (key1, key2) -> test_key_equal key1 key2); + QCheck.Test.make + ~count:1000 + ~name:"Test token encoding-decoding roundtrip" + (QCheck.make Generators.token_gen) + prop_token_encode_decode; + QCheck.Test.make + ~count:1000 + ~name:"Test key encoding-decoding roundtrip" + (QCheck.make Generators.key_gen) + prop_key_encode_decode; + ] + +let () = + Alcotest.run + "Ticket_repr" + [("Ticket_repr", Lib_test.Qcheck_helpers.qcheck_wrap tests)] diff --git a/src/proto_alpha/lib_protocol/ticket_repr.ml b/src/proto_alpha/lib_protocol/ticket_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..71e136d349fa7b8989ee677ca82c45d4dc8a882c --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_repr.ml @@ -0,0 +1,105 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type token = {ticketer : Contract_repr.t; content : bytes} + +type key = {token : token; owner : Contract_repr.t} + +let token_encoding = + let open Data_encoding in + let of_t {ticketer; content} = (ticketer, content) in + let to_t (ticketer, content) = {ticketer; content} in + conv + of_t + to_t + (obj2 (req "ticketer" Contract_repr.encoding) (req "content" bytes)) + +let key_encoding = + let open Data_encoding in + let of_t {token; owner} = (token, owner) in + let to_t (token, owner) = {token; owner} in + conv + of_t + to_t + (obj2 (req "token" token_encoding) (req "owner" Contract_repr.encoding)) + +let key_to_string key = + let raw_key = Data_encoding.Binary.to_bytes_exn key_encoding key in + let (`Hex key) = Hex.of_bytes raw_key in + key + +let key_of_string_opt key = + let raw_key = Hex.to_bytes (`Hex key) in + Data_encoding.Binary.of_bytes_opt key_encoding raw_key + +let compare_token {ticketer = t1; content = c1} {ticketer = t2; content = c2} = + match Contract_repr.compare t1 t2 with 0 -> Bytes.compare c1 c2 | n -> n + +let compare_key {token = t1; owner = o1} {token = t2; owner = o2} = + match compare_token t1 t2 with 0 -> Contract_repr.compare o1 o2 | n -> n + +let pp_key out {token = {ticketer; content}; owner} = + Format.fprintf + out + "(%a, %s, %a)" + Contract_repr.pp + ticketer + (Bytes.to_string content) + Contract_repr.pp + owner + +let pp_token out {ticketer; content} = + Format.fprintf + out + "(%a, %s)" + Contract_repr.pp + ticketer + (Bytes.to_string content) + +(* Ticket ownership is indexed by [key] values *) +module Index = struct + type t = key + + let path_length : int = 1 + + let to_path key path = key_to_string key :: path + + let of_path = function [key] -> key_of_string_opt key | _ -> None + + let rpc_arg = + RPC_arg.make + ~descr:"A ticket key identifier." + ~name:"ticket_key" + ~construct:key_to_string + ~destruct:(fun s -> + match key_of_string_opt s with + | Some x -> Ok x + | None -> Error "Failed to destruct ticket key.") + () + + let encoding = key_encoding + + let compare = compare_key +end diff --git a/src/proto_alpha/lib_protocol/ticket_repr.mli b/src/proto_alpha/lib_protocol/ticket_repr.mli new file mode 100644 index 0000000000000000000000000000000000000000..c4cd8d22f9fcbf4309daf81606d4c83624621b45 --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_repr.mli @@ -0,0 +1,48 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** A [token] represents a ticketer contract and a ticket content pair. *) +type token = {ticketer : Contract_repr.t; content : bytes} + +(** A [key] consists of a token and a contract owner. *) +type key = {token : token; owner : Contract_repr.t} + +(** [pp_key fmt key] pretty prints [key] to the formater [fmt]. *) +val pp_key : Format.formatter -> key -> unit + +(** [pp_token fmt token] pretty prints [token] to the formater [fmt]. *) +val pp_token : Format.formatter -> token -> unit + +(** [token_encoding] encoder for [token] values. *) +val token_encoding : token Data_encoding.t + +(** [key_encoding] encoder for [key] values. *) +val key_encoding : key Data_encoding.t + +(** [compare_token t1 t2] compares [t1] and [t2]. *) +val compare_token : token -> token -> int + +(** Module used for constructing the ticket-balance table. *) +module Index : Storage_description.INDEX with type t = key diff --git a/src/proto_alpha/lib_protocol/ticket_storage.ml b/src/proto_alpha/lib_protocol/ticket_storage.ml new file mode 100644 index 0000000000000000000000000000000000000000..1790b7c64fe9c9d6dca122bc6d357375903f4631 --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_storage.ml @@ -0,0 +1,73 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Ticket_balance_negative of {key : Ticket_repr.key; balance : Z.t} + +let ( let* ) = ( >>=? ) + +let ( let+ ) = ( >|=? ) + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"ticket_balance_negative" + ~title:"Ticket balance negative" + ~description:"Attempted to set a negative ticket balance value" + ~pp:(fun ppf (key, balance) -> + Format.fprintf + ppf + "Attempted to set negative ticket balance value '%a' for key %a." + Z.pp_print + balance + Ticket_repr.pp_key + key) + (obj2 (req "key" Ticket_repr.key_encoding) (req "balance" Data_encoding.z)) + (function + | Ticket_balance_negative {key; balance} -> Some (key, balance) + | _ -> None) + (fun (key, balance) -> Ticket_balance_negative {key; balance}) + +let get_balance ctxt ~token ~owner = + let key = {Ticket_repr.token; owner} in + let+ (ctxt, res) = Storage.Ticket_balance.Table.find ctxt key in + (res, ctxt) + +let set_balance ctxt ~token ~owner balance = + let key = {Ticket_repr.token; owner} in + if Z.lt balance Z.zero then fail @@ Ticket_balance_negative {key; balance} + else + let* (ctxt, exist) = Storage.Ticket_balance.Table.mem ctxt key in + if exist then + let+ (ctxt, _) = Storage.Ticket_balance.Table.update ctxt key balance in + ctxt + else + let+ (ctxt, _, _) = Storage.Ticket_balance.Table.add ctxt key balance in + ctxt + +let adjust_balance ctxt ~token ~owner ~delta = + let* (res, ctxt) = get_balance ctxt ~token ~owner in + let old_balance = Option.value ~default:Z.zero res in + set_balance ctxt ~token ~owner (Z.add old_balance delta) diff --git a/src/proto_alpha/lib_protocol/ticket_storage.mli b/src/proto_alpha/lib_protocol/ticket_storage.mli new file mode 100644 index 0000000000000000000000000000000000000000..6bffb915ced58a8dce9235e706b53b56be602497 --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_storage.mli @@ -0,0 +1,49 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Ticket_balance_negative of {key : Ticket_repr.key; balance : Z.t} + +(** [get_balance ctxt ~token ~owner] receives the ticket balance for the given + [token] and [owner]. The token represents a ticket content and + a ticket creator pair. *) +val get_balance : + Raw_context.t -> + token:Ticket_repr.token -> + owner:Contract_repr.t -> + (Z.t option * Raw_context.t, error trace) result Lwt.t + +(** [adjust_balance ctxt ~token ~owner ~delta] adjusts the balance of the + given [token] and [owner] with [delta]. The value of [delta] + can be positive as well as negative. If there is no pre-exising balance + for the given token and owner, it is assumed to be 0 and the new + balance is [delta]. The function fails with a [Ticket_balance_negative] error + in case the resulting balance is negative. + *) +val adjust_balance : + Raw_context.t -> + token:Ticket_repr.token -> + owner:Contract_repr.t -> + delta:Z.t -> + (Raw_context.t, error trace) result Lwt.t