From 8e7364229d8ccea585cf081d3e87741f3e0e6f54 Mon Sep 17 00:00:00 2001 From: Joel Bjornson Date: Fri, 3 Sep 2021 13:15:29 +0100 Subject: [PATCH 1/6] Proto: Add ticket-balance storage module --- src/proto_alpha/lib_protocol/TEZOS_PROTOCOL | 1 + src/proto_alpha/lib_protocol/alpha_context.ml | 4 + .../lib_protocol/alpha_context.mli | 12 ++ src/proto_alpha/lib_protocol/dune.inc | 5 + src/proto_alpha/lib_protocol/fees_storage.ml | 6 +- src/proto_alpha/lib_protocol/fees_storage.mli | 12 +- src/proto_alpha/lib_protocol/storage.ml | 11 ++ src/proto_alpha/lib_protocol/storage.mli | 16 ++ src/proto_alpha/lib_protocol/test/main.ml | 1 + .../lib_protocol/test/test_ticket_storage.ml | 172 ++++++++++++++++++ .../lib_protocol/ticket_storage.ml | 77 ++++++++ .../lib_protocol/ticket_storage.mli | 49 +++++ 12 files changed, 363 insertions(+), 3 deletions(-) create mode 100644 src/proto_alpha/lib_protocol/test/test_ticket_storage.ml create mode 100644 src/proto_alpha/lib_protocol/ticket_storage.ml create mode 100644 src/proto_alpha/lib_protocol/ticket_storage.mli diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 0f2d2aa13ead..e0b8096ea9f7 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -65,6 +65,7 @@ "Vote_storage", "Commitment_storage", "Fees_storage", + "Ticket_storage", "Liquidity_baking_repr", "Liquidity_baking_cpmm", "Liquidity_baking_lqt", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index b4c0654bf0ed..189e37f7d219 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -548,3 +548,7 @@ module Cache = struct let identifier_rank ctxt id = Admin.key_rank ctxt (mk ~id) end) end + +module Ticket_balance = struct + include Ticket_storage +end diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 39bb91900b60..dc7ae5cbbe21 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"),*) @@ -2084,3 +2085,14 @@ module Liquidity_baking : sig (context -> Contract.t -> (context * 'a list) tzresult Lwt.t) -> (context * 'a list * escape_ema) tzresult Lwt.t end + +(** This module re-exports functions from [Ticket_storage]. See + documentation of the functions there. + *) +module Ticket_balance : sig + val adjust_balance : + context -> Script_expr_hash.t -> delta:Z.t -> (Z.t * context) tzresult Lwt.t + + val get_balance : + context -> Script_expr_hash.t -> (Z.t option * context) tzresult Lwt.t +end diff --git a/src/proto_alpha/lib_protocol/dune.inc b/src/proto_alpha/lib_protocol/dune.inc index c01d88500d16..588b53411e54 100644 --- a/src/proto_alpha/lib_protocol/dune.inc +++ b/src/proto_alpha/lib_protocol/dune.inc @@ -88,6 +88,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml fees_storage.mli fees_storage.ml + ticket_storage.mli ticket_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml liquidity_baking_lqt.ml @@ -193,6 +194,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml fees_storage.mli fees_storage.ml + ticket_storage.mli ticket_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml liquidity_baking_lqt.ml @@ -298,6 +300,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml fees_storage.mli fees_storage.ml + ticket_storage.mli ticket_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml liquidity_baking_lqt.ml @@ -425,6 +428,7 @@ include Tezos_raw_protocol_alpha.Main Vote_storage Commitment_storage Fees_storage + Ticket_storage Liquidity_baking_repr Liquidity_baking_cpmm Liquidity_baking_lqt @@ -569,6 +573,7 @@ include Tezos_raw_protocol_alpha.Main vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml fees_storage.mli fees_storage.ml + ticket_storage.mli ticket_storage.ml liquidity_baking_repr.mli liquidity_baking_repr.ml liquidity_baking_cpmm.ml liquidity_baking_lqt.ml diff --git a/src/proto_alpha/lib_protocol/fees_storage.ml b/src/proto_alpha/lib_protocol/fees_storage.ml index 7d3da62e3e92..588e52a9ccd5 100644 --- a/src/proto_alpha/lib_protocol/fees_storage.ml +++ b/src/proto_alpha/lib_protocol/fees_storage.ml @@ -71,7 +71,7 @@ let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c (* TODO: https://gitlab.com/tezos/tezos/-/issues/1615 Refactor other functions in module to use this one. - + This function was added when adding the table of globals feature. In principle other parts of this module could be refactored to use this function. *) @@ -97,6 +97,10 @@ let record_global_constant_storage_space context size = let to_be_paid = Z.add size cost_of_key in (Raw_context.update_storage_space_to_pay context to_be_paid, to_be_paid) +(* Same as [record_global_constant_storage_space]. We also charge fixed price + for the keys. *) +let record_ticket_balance_storage_space = record_global_constant_storage_space + let record_paid_storage_space_subsidy c contract = let c = start_counting_storage_fees c in record_paid_storage_space c contract >>=? fun (c, size, to_be_paid, _) -> diff --git a/src/proto_alpha/lib_protocol/fees_storage.mli b/src/proto_alpha/lib_protocol/fees_storage.mli index a2d61b0083ca..230247f09674 100644 --- a/src/proto_alpha/lib_protocol/fees_storage.mli +++ b/src/proto_alpha/lib_protocol/fees_storage.mli @@ -50,8 +50,16 @@ val record_paid_storage_space : val record_global_constant_storage_space : Raw_context.t -> Z.t -> Raw_context.t * Z.t -(** Record paid storage space for contract without burn. - For use only in subsidies. +(** [record_ticket_balance_storage_space ctxt size] records + paid storage space for registering a new ticket-balance entry. + Cost is in bytes + 65 additional bytes for the key + hash of the ticket token type. Returns new context and the cost. +*) +val record_ticket_balance_storage_space : + Raw_context.t -> Z.t -> Raw_context.t * Z.t + +(** Record paid storage space for contract without burn. + For use only in subsidies. Will fail if storage_space_to_pay has been initialized.*) val record_paid_storage_space_subsidy : Raw_context.t -> Contract_repr.t -> (Raw_context.t * Z.t * Z.t) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index eaab9bcb047d..8af81826d060 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1327,3 +1327,14 @@ module Liquidity_baking = struct end) (Contract_repr) end + +module Ticket_balance = struct + module Name = struct + let name = ["ticket_balance"] + end + + module Sub_context = Make_subcontext (Registered) (Raw_context) (Name) + module Index = Make_index (Script_expr_hash) + module Table = + Make_indexed_carbonated_data_storage (Sub_context) (Index) (Encoding.Z) +end diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index ac28bdc722dd..c05f73959eab 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -530,3 +530,19 @@ 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 + hashed representation of: + - A ticketer, i.e. the creator of the ticket + - The content of a the ticket + - The contract that owns some amount of the ticket + The values of the table are the amounts owned by each key. + *) +module Ticket_balance : sig + module Table : + Non_iterable_indexed_carbonated_data_storage + with type t := Raw_context.t + and type key = Script_expr_hash.t + and type value = Z.t +end diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index bd6fe5bb572d..3b568a27fb27 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -68,5 +68,6 @@ let () = ("temp big maps", Test_temp_big_maps.tests); ("timelock", Test_timelock.tests); ("script typed ir size", Test_script_typed_ir_size.tests); + ("ticket storage", Test_ticket_storage.tests); ] |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml new file mode 100644 index 000000000000..e603bba40cd3 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml @@ -0,0 +1,172 @@ +(*****************************************************************************) +(* *) +(* 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 (Alpha_context.Ticket_balance) + Invocation: dune exec src/proto_alpha/lib_protocol/test/main.exe -- test "^ticket storage$" + Subject: Ticket storage functions tested using the Ticket_balance module in Alpha_context. +*) + +open Protocol +open Alpha_context + +let ( let* ) m f = m >>=? f + +let wrap m = m >|= Environment.wrap_tzresult + +let make_context () = + let* (block, _) = Context.init 1 in + let* incr = Incremental.begin_construction block in + return (Fees.start_counting_storage_fees @@ Incremental.alpha_ctxt incr) + +let hash_key ctxt key = + wrap + @@ let* key = Lwt.return @@ Script_string_repr.of_string key in + Script_ir_translator.hash_comparable_data + ctxt + (Script_typed_ir.string_key ~annot:None) + key + +let assert_balance ctxt ~loc key expected = + let* (balance, _) = wrap @@ Ticket_balance.get_balance ctxt key in + match balance with + | Some b -> Assert.equal_int ~loc (Z.to_int b) expected + | None -> failwith "Expected balance %d" expected + +let assert_no_balance ctxt key = + let* (balance, _) = wrap @@ Ticket_balance.get_balance ctxt key in + match balance with + | Some b -> failwith "Expected empty (none) balance but got %d" (Z.to_int b) + | None -> return () + +let adjust_balance ctxt key delta = + wrap @@ Ticket_balance.adjust_balance ctxt key ~delta:(Z.of_int delta) + +(** Test that updating the ticket balance table has + the intended effect. + *) +let test_ticket_balance_single_update () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (_, ctxt) = adjust_balance ctxt alice_red 1 in + assert_balance ctxt ~loc:__LOC__ alice_red 1 + +(** Test that updating the ticket-balance table with different keys + updates both entries. *) +let test_ticket_balance_different_owners () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_blue, ctxt) = hash_key ctxt "alice_blue" in + let* (_, ctxt) = adjust_balance ctxt alice_red 1 in + let* (_, ctxt) = adjust_balance ctxt alice_blue 1 in + let* () = assert_balance ctxt ~loc:__LOC__ alice_red 1 in + let* () = assert_balance ctxt ~loc:__LOC__ alice_blue 1 in + return () + +(** Test updating the same entry with mulitple updates yields + the net result of all balance updates *) +let test_ticket_balance_multiple_updates () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (_, ctxt) = adjust_balance ctxt alice_red 1 in + let* (_, ctxt) = adjust_balance ctxt alice_red 2 in + let* (_, ctxt) = adjust_balance ctxt alice_red (-1) in + assert_balance ctxt ~loc:__LOC__ alice_red 2 + +(** Test that with no updates to the table, no balance is present in + the table *) +let test_empty_balance () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + assert_no_balance ctxt alice_red + +(** Test that adding one entry with positive balance and then + updating with a negative balance also removes the entry *) +let test_empty_balance_after_update () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (_, ctxt) = adjust_balance ctxt alice_red 1 in + let* (_, ctxt) = adjust_balance ctxt alice_red (-1) in + assert_no_balance ctxt alice_red + +(** Test that attempting to update an entry with a negative balance + results in an error. *) +let test_negative_balance () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + adjust_balance ctxt alice_red (-1) >>= fun res -> + Assert.proto_error ~loc:__LOC__ res (fun _err -> true) + +(** Test that positive storage fees are returned for operations + resulting in extra storage space. *) +let test_storage_fee () = + let* ctxt = make_context () in + let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + (* Initial fee is at least 65 *) + let* (fee, ctxt) = adjust_balance ctxt alice_red 1 in + let* () = Assert.leq_int ~loc:__LOC__ 65 (Z.to_int fee) in + (* Adding one is free *) + let* (fee, ctxt) = adjust_balance ctxt alice_red 1 in + let* () = Assert.equal_int ~loc:__LOC__ 0 (Z.to_int fee) in + (* Adding a big balance cost some extra *) + let* (fee, ctxt) = adjust_balance ctxt alice_red 1000 in + let* () = Assert.leq_int ~loc:__LOC__ 1 (Z.to_int fee) in + (* Reset balance to zero doesn't cost anything *) + let* (b, ctxt) = wrap @@ Ticket_balance.get_balance ctxt alice_red in + let* (fee, ctxt) = + wrap + (Ticket_balance.adjust_balance + ctxt + alice_red + ~delta:(Z.neg @@ Option.value ~default:Z.zero b)) + in + let* () = Assert.equal_int ~loc:__LOC__ 0 (Z.to_int fee) in + (* Adding a balance again comes with a fee *) + let* (fee, _) = adjust_balance ctxt alice_red 1 in + Assert.leq_int ~loc:__LOC__ 65 (Z.to_int fee) + +let tests = + [ + Tztest.tztest + "ticket balance single update" + `Quick + test_ticket_balance_single_update; + Tztest.tztest "empty balance" `Quick test_empty_balance; + Tztest.tztest + "empty balance after update" + `Quick + test_empty_balance_after_update; + Tztest.tztest "negative balance" `Quick test_negative_balance; + Tztest.tztest + "ticket balance multiple updates" + `Quick + test_ticket_balance_multiple_updates; + Tztest.tztest + "ticket balance different owners" + `Quick + test_ticket_balance_different_owners; + Tztest.tztest "ticket storage fee" `Quick test_storage_fee; + ] 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 000000000000..63e9c4e3694f --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_storage.ml @@ -0,0 +1,77 @@ +(*****************************************************************************) +(* *) +(* 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 += + | Negative_ticket_balance of {key : Script_expr_hash.t; balance : Z.t} + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"negative_ticket_balance" + ~title:"Negative ticket balance" + ~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 + Script_expr_hash.pp + key) + (obj2 (req "key" Script_expr_hash.encoding) (req "balance" Data_encoding.z)) + (function + | Negative_ticket_balance {key; balance} -> Some (key, balance) + | _ -> None) + (fun (key, balance) -> Negative_ticket_balance {key; balance}) + +let get_balance ctxt key = + Storage.Ticket_balance.Table.find ctxt key >|=? fun (ctxt, res) -> (res, ctxt) + +let set_balance ctxt key balance = + fail_when + Compare.Z.(balance < Z.zero) + (Negative_ticket_balance {key; balance}) + >>=? fun () -> + if Compare.Z.(balance = Z.zero) then + Storage.Ticket_balance.Table.remove ctxt key + >|=? fun (ctxt, _freed, _existed) -> (Z.zero, ctxt) + else + Storage.Ticket_balance.Table.add ctxt key balance + >|=? fun (ctxt, size_diff, _existed) -> + (* Only records cost for storing when the size diff is positive. *) + if Compare.Int.(size_diff <= 0) then (Z.zero, ctxt) + else + let (ctxt, fee) = + Fees_storage.record_ticket_balance_storage_space + ctxt + (Z.of_int size_diff) + in + (fee, ctxt) + +let adjust_balance ctxt key ~delta = + get_balance ctxt key >>=? fun (res, ctxt) -> + let old_balance = Option.value ~default:Z.zero res in + set_balance ctxt key (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 000000000000..cfe2f976bbb8 --- /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. *) +(* *) +(*****************************************************************************) + +(** [get_balance ctxt key] receives the ticket balance for the given + key. The key represents a ticket content and a ticket creator pair. *) +val get_balance : + Raw_context.t -> + Script_expr_hash.t -> + (Z.t option * Raw_context.t) tzresult Lwt.t + +(** [adjust_balance ctxt key ~delta] adjusts the balance of the + given key (representing a ticket content, creator and owner pair) + and [delta]. The value of [delta] can be positive as well as negative. + If there is no pre-exising balance for the given ticket type and owner, + it is assumed to be 0 and the new balance is [delta]. + + In case a new entry is created, a storage fee is charged and is + also returned (the first component of the tuple). + + The function fails with a [Negative_ticket_balance] error + in case the resulting balance is negative. + *) +val adjust_balance : + Raw_context.t -> + Script_expr_hash.t -> + delta:Z.t -> + (Z.t * Raw_context.t) tzresult Lwt.t -- GitLab From 3d2c94bc00dc27f052686a30032931f174a9239e Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Tue, 12 Oct 2021 14:57:34 +0000 Subject: [PATCH 2/6] Apply 1 suggestion(s) to 1 file(s) --- src/proto_alpha/lib_protocol/test/test_ticket_storage.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml index e603bba40cd3..57da98591877 100644 --- a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml @@ -86,7 +86,7 @@ let test_ticket_balance_different_owners () = let* () = assert_balance ctxt ~loc:__LOC__ alice_blue 1 in return () -(** Test updating the same entry with mulitple updates yields +(** Test updating the same entry with multiple updates yields the net result of all balance updates *) let test_ticket_balance_multiple_updates () = let* ctxt = make_context () in -- GitLab From e02bcf09a68933b85480be5f962c90add06ea2b1 Mon Sep 17 00:00:00 2001 From: Joel Bjornson Date: Tue, 12 Oct 2021 16:06:04 +0100 Subject: [PATCH 3/6] Fix: comment --- src/proto_alpha/lib_protocol/ticket_storage.mli | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/ticket_storage.mli b/src/proto_alpha/lib_protocol/ticket_storage.mli index cfe2f976bbb8..7ee8dc66433c 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.mli +++ b/src/proto_alpha/lib_protocol/ticket_storage.mli @@ -24,7 +24,10 @@ (*****************************************************************************) (** [get_balance ctxt key] receives the ticket balance for the given - key. The key represents a ticket content and a ticket creator pair. *) + [key] in the context [ctxt]. The [key] represents a ticket content and a + ticket creator pair. In case there exists no value for the given [key], + [None] is returned. + *) val get_balance : Raw_context.t -> Script_expr_hash.t -> -- GitLab From c502bd27b9842eeb2970d4d7df93581fd61204de Mon Sep 17 00:00:00 2001 From: Joel Bjornson Date: Wed, 13 Oct 2021 17:51:22 +0100 Subject: [PATCH 4/6] Fix: Don't charge storage fees here --- src/proto_alpha/lib_protocol/fees_storage.ml | 6 +-- src/proto_alpha/lib_protocol/fees_storage.mli | 12 +----- .../lib_protocol/test/test_ticket_storage.ml | 43 +++++++++++-------- .../lib_protocol/ticket_storage.ml | 26 ++++++----- .../lib_protocol/ticket_storage.mli | 8 ++-- 5 files changed, 46 insertions(+), 49 deletions(-) diff --git a/src/proto_alpha/lib_protocol/fees_storage.ml b/src/proto_alpha/lib_protocol/fees_storage.ml index 588e52a9ccd5..7d3da62e3e92 100644 --- a/src/proto_alpha/lib_protocol/fees_storage.ml +++ b/src/proto_alpha/lib_protocol/fees_storage.ml @@ -71,7 +71,7 @@ let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c (* TODO: https://gitlab.com/tezos/tezos/-/issues/1615 Refactor other functions in module to use this one. - + This function was added when adding the table of globals feature. In principle other parts of this module could be refactored to use this function. *) @@ -97,10 +97,6 @@ let record_global_constant_storage_space context size = let to_be_paid = Z.add size cost_of_key in (Raw_context.update_storage_space_to_pay context to_be_paid, to_be_paid) -(* Same as [record_global_constant_storage_space]. We also charge fixed price - for the keys. *) -let record_ticket_balance_storage_space = record_global_constant_storage_space - let record_paid_storage_space_subsidy c contract = let c = start_counting_storage_fees c in record_paid_storage_space c contract >>=? fun (c, size, to_be_paid, _) -> diff --git a/src/proto_alpha/lib_protocol/fees_storage.mli b/src/proto_alpha/lib_protocol/fees_storage.mli index 230247f09674..a2d61b0083ca 100644 --- a/src/proto_alpha/lib_protocol/fees_storage.mli +++ b/src/proto_alpha/lib_protocol/fees_storage.mli @@ -50,16 +50,8 @@ val record_paid_storage_space : val record_global_constant_storage_space : Raw_context.t -> Z.t -> Raw_context.t * Z.t -(** [record_ticket_balance_storage_space ctxt size] records - paid storage space for registering a new ticket-balance entry. - Cost is in bytes + 65 additional bytes for the key - hash of the ticket token type. Returns new context and the cost. -*) -val record_ticket_balance_storage_space : - Raw_context.t -> Z.t -> Raw_context.t * Z.t - -(** Record paid storage space for contract without burn. - For use only in subsidies. +(** Record paid storage space for contract without burn. + For use only in subsidies. Will fail if storage_space_to_pay has been initialized.*) val record_paid_storage_space_subsidy : Raw_context.t -> Contract_repr.t -> (Raw_context.t * Z.t * Z.t) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml index 57da98591877..5a51e103174a 100644 --- a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml @@ -120,33 +120,38 @@ let test_negative_balance () = adjust_balance ctxt alice_red (-1) >>= fun res -> Assert.proto_error ~loc:__LOC__ res (fun _err -> true) -(** Test that positive storage fees are returned for operations - resulting in extra storage space. *) -let test_storage_fee () = +(** Test that positive storage spaces are returned for operations + resulting in extra storage space and negative for ones that frees up storage. + *) +let test_storage_space () = let* ctxt = make_context () in let* (alice_red, ctxt) = hash_key ctxt "alice_red" in - (* Initial fee is at least 65 *) - let* (fee, ctxt) = adjust_balance ctxt alice_red 1 in - let* () = Assert.leq_int ~loc:__LOC__ 65 (Z.to_int fee) in - (* Adding one is free *) - let* (fee, ctxt) = adjust_balance ctxt alice_red 1 in - let* () = Assert.equal_int ~loc:__LOC__ 0 (Z.to_int fee) in - (* Adding a big balance cost some extra *) - let* (fee, ctxt) = adjust_balance ctxt alice_red 1000 in - let* () = Assert.leq_int ~loc:__LOC__ 1 (Z.to_int fee) in - (* Reset balance to zero doesn't cost anything *) + (* Space for adding an entry is 65 for the key plus 1 for the value. *) + let* (space, ctxt) = adjust_balance ctxt alice_red 1 in + let* () = Assert.equal_int ~loc:__LOC__ 66 (Z.to_int space) in + (* Adding one does not consume additional space. *) + let* (space, ctxt) = adjust_balance ctxt alice_red 1 in + let* () = Assert.equal_int ~loc:__LOC__ 0 (Z.to_int space) in + (* Adding a big balance costs extra. *) + let* (space, ctxt) = adjust_balance ctxt alice_red 1000 in + let* () = Assert.equal_int ~loc:__LOC__ 1 (Z.to_int space) in + (* Reset balance to zero should free up space. + The freed up space is 65 for the key + 2 for the value *) let* (b, ctxt) = wrap @@ Ticket_balance.get_balance ctxt alice_red in - let* (fee, ctxt) = + let* (space, ctxt) = wrap (Ticket_balance.adjust_balance ctxt alice_red ~delta:(Z.neg @@ Option.value ~default:Z.zero b)) in - let* () = Assert.equal_int ~loc:__LOC__ 0 (Z.to_int fee) in - (* Adding a balance again comes with a fee *) - let* (fee, _) = adjust_balance ctxt alice_red 1 in - Assert.leq_int ~loc:__LOC__ 65 (Z.to_int fee) + let* () = Assert.equal_int ~loc:__LOC__ (-67) (Z.to_int space) in + (* Adjusting the space to 0 again should not free anything *) + let* (space, ctxt) = adjust_balance ctxt alice_red 0 in + let* () = Assert.equal_int ~loc:__LOC__ 0 (Z.to_int space) in + (* Adding a balance requiers extra space. *) + let* (space, _) = adjust_balance ctxt alice_red 10 in + Assert.equal_int ~loc:__LOC__ 66 (Z.to_int space) let tests = [ @@ -168,5 +173,5 @@ let tests = "ticket balance different owners" `Quick test_ticket_balance_different_owners; - Tztest.tztest "ticket storage fee" `Quick test_storage_fee; + Tztest.tztest "ticket storage space" `Quick test_storage_space; ] diff --git a/src/proto_alpha/lib_protocol/ticket_storage.ml b/src/proto_alpha/lib_protocol/ticket_storage.ml index 63e9c4e3694f..df3b21dd198b 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/ticket_storage.ml @@ -51,25 +51,29 @@ let get_balance ctxt key = Storage.Ticket_balance.Table.find ctxt key >|=? fun (ctxt, res) -> (res, ctxt) let set_balance ctxt key balance = + let cost_of_key = Z.of_int 65 in fail_when Compare.Z.(balance < Z.zero) (Negative_ticket_balance {key; balance}) >>=? fun () -> if Compare.Z.(balance = Z.zero) then Storage.Ticket_balance.Table.remove ctxt key - >|=? fun (ctxt, _freed, _existed) -> (Z.zero, ctxt) + >|=? fun (ctxt, freed, existed) -> + (* If we remove an existing entry, then we return the freed size for + both the key and the value. *) + let freed = + if existed then Z.neg @@ Z.add cost_of_key (Z.of_int freed) else Z.zero + in + (freed, ctxt) else Storage.Ticket_balance.Table.add ctxt key balance - >|=? fun (ctxt, size_diff, _existed) -> - (* Only records cost for storing when the size diff is positive. *) - if Compare.Int.(size_diff <= 0) then (Z.zero, ctxt) - else - let (ctxt, fee) = - Fees_storage.record_ticket_balance_storage_space - ctxt - (Z.of_int size_diff) - in - (fee, ctxt) + >|=? fun (ctxt, size_diff, existed) -> + let size_diff = + let z_diff = Z.of_int size_diff in + (* For a new entry we also charge the space for storing the key *) + if existed then z_diff else Z.add cost_of_key z_diff + in + (size_diff, ctxt) let adjust_balance ctxt key ~delta = get_balance ctxt key >>=? fun (res, ctxt) -> diff --git a/src/proto_alpha/lib_protocol/ticket_storage.mli b/src/proto_alpha/lib_protocol/ticket_storage.mli index 7ee8dc66433c..ca832918134d 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.mli +++ b/src/proto_alpha/lib_protocol/ticket_storage.mli @@ -37,10 +37,10 @@ val get_balance : given key (representing a ticket content, creator and owner pair) and [delta]. The value of [delta] can be positive as well as negative. If there is no pre-exising balance for the given ticket type and owner, - it is assumed to be 0 and the new balance is [delta]. - - In case a new entry is created, a storage fee is charged and is - also returned (the first component of the tuple). + it is assumed to be 0 and the new balance is [delta]. The function also + returns the difference between the old and the new size of the storage. + Note that the difference may be negative. For example, because when + setting the balance to zero, an entry is removed. The function fails with a [Negative_ticket_balance] error in case the resulting balance is negative. -- GitLab From faa6a41e7b8e7885024273cf4bc833f037eddbcb Mon Sep 17 00:00:00 2001 From: Joel Bjornson Date: Mon, 18 Oct 2021 19:08:59 +0100 Subject: [PATCH 5/6] Fix: introduce abstract key-hash type --- .../lib_protocol/alpha_context.mli | 17 ++- .../lib_protocol/test/test_ticket_storage.ml | 139 ++++++++++++++++-- .../lib_protocol/ticket_storage.ml | 28 ++++ .../lib_protocol/ticket_storage.mli | 33 ++++- 4 files changed, 193 insertions(+), 24 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index dc7ae5cbbe21..9e6186a3f2ce 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2090,9 +2090,20 @@ end documentation of the functions there. *) module Ticket_balance : sig + type key_hash + + val script_expr_hash_of_key_hash : key_hash -> Script_expr_hash.t + + val make_key_hash : + context -> + ticketer:Script.node -> + typ:Script.node -> + contents:Script.node -> + owner:Script.node -> + (key_hash * context) tzresult + val adjust_balance : - context -> Script_expr_hash.t -> delta:Z.t -> (Z.t * context) tzresult Lwt.t + context -> key_hash -> delta:Z.t -> (Z.t * context) tzresult Lwt.t - val get_balance : - context -> Script_expr_hash.t -> (Z.t option * context) tzresult Lwt.t + val get_balance : context -> key_hash -> (Z.t option * context) tzresult Lwt.t end diff --git a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml index 5a51e103174a..16801bdca0cb 100644 --- a/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/test/test_ticket_storage.ml @@ -42,13 +42,19 @@ let make_context () = let* incr = Incremental.begin_construction block in return (Fees.start_counting_storage_fees @@ Incremental.alpha_ctxt incr) -let hash_key ctxt key = +let hash_key ctxt ~ticketer ~typ ~contents ~owner = + let ticketer = Micheline.root @@ Expr.from_string ticketer in + let typ = Micheline.root @@ Expr.from_string typ in + let contents = Micheline.root @@ Expr.from_string contents in + let owner = Micheline.root @@ Expr.from_string owner in wrap - @@ let* key = Lwt.return @@ Script_string_repr.of_string key in - Script_ir_translator.hash_comparable_data - ctxt - (Script_typed_ir.string_key ~annot:None) - key + @@ Lwt.return + (Alpha_context.Ticket_balance.make_key_hash + ctxt + ~ticketer + ~typ + ~contents + ~owner) let assert_balance ctxt ~loc key expected = let* (balance, _) = wrap @@ Ticket_balance.get_balance ctxt key in @@ -65,12 +71,101 @@ let assert_no_balance ctxt key = let adjust_balance ctxt key delta = wrap @@ Ticket_balance.adjust_balance ctxt key ~delta:(Z.of_int delta) +let assert_non_overlapping_keys ~loc ~ticketer1 ~ticketer2 ~contents1 ~contents2 + ~typ1 ~typ2 ~owner1 ~owner2 = + let* ctxt = make_context () in + let* (k1, ctxt) = + hash_key + ctxt + ~ticketer:ticketer1 + ~typ:typ1 + ~contents:contents1 + ~owner:owner1 + in + let* (k2, _ctxt) = + hash_key + ctxt + ~ticketer:ticketer2 + ~typ:typ2 + ~contents:contents2 + ~owner:owner2 + in + let k1 = Ticket_balance.script_expr_hash_of_key_hash k1 in + let k2 = Ticket_balance.script_expr_hash_of_key_hash k2 in + Assert.not_equal + ~loc + Script_expr_hash.equal + "Keys should not overlap" + Script_expr_hash.pp + k1 + k2 + +let make_key ctxt content = + hash_key + ctxt + ~ticketer:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~typ:"string" + ~contents:(Printf.sprintf {|"%s"|} content) + ~owner:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + +(** Test that key-hashes constructed from different ticketers don't overlap. *) +let test_non_overlapping_keys_ticketer () = + assert_non_overlapping_keys + ~loc:__LOC__ + ~ticketer1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~ticketer2:{|"KT1PWx2mnDueood7fEmfbBDKx1D9BAnnXitn"|} + ~typ1:"nat" + ~typ2:"int" + ~contents1:{|"1"|} + ~contents2:{|"1"|} + ~owner1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~owner2:{|"KT1PWx2mnDueood7fEmfbBDKx1D9BAnnXitn"|} + +(** Test that key-hashes constructed from different contents don't overlap. *) +let test_non_overlapping_keys_contents () = + assert_non_overlapping_keys + ~loc:__LOC__ + ~ticketer1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~ticketer2:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~typ1:"string" + ~typ2:"string" + ~contents1:{|"red"|} + ~contents2:{|"blue"|} + ~owner1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~owner2:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + +(** Test that key-hashes constructed from different content-types don't overlap. *) +let test_non_overlapping_keys_type () = + assert_non_overlapping_keys + ~loc:__LOC__ + ~ticketer1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~ticketer2:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~typ1:"nat" + ~typ2:"int" + ~contents1:{|"1"|} + ~contents2:{|"1"|} + ~owner1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~owner2:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + +(** Test that key-hashes constructed from different owners don't overlap. *) +let test_non_overlapping_keys_owner () = + assert_non_overlapping_keys + ~loc:__LOC__ + ~ticketer1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~ticketer2:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~typ1:"nat" + ~typ2:"int" + ~contents1:{|"1"|} + ~contents2:{|"1"|} + ~owner1:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~owner2:{|"KT1PWx2mnDueood7fEmfbBDKx1D9BAnnXitn"|} + (** Test that updating the ticket balance table has the intended effect. *) let test_ticket_balance_single_update () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in let* (_, ctxt) = adjust_balance ctxt alice_red 1 in assert_balance ctxt ~loc:__LOC__ alice_red 1 @@ -78,8 +173,8 @@ let test_ticket_balance_single_update () = updates both entries. *) let test_ticket_balance_different_owners () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in - let* (alice_blue, ctxt) = hash_key ctxt "alice_blue" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in + let* (alice_blue, ctxt) = make_key ctxt "alice_blue" in let* (_, ctxt) = adjust_balance ctxt alice_red 1 in let* (_, ctxt) = adjust_balance ctxt alice_blue 1 in let* () = assert_balance ctxt ~loc:__LOC__ alice_red 1 in @@ -90,7 +185,7 @@ let test_ticket_balance_different_owners () = the net result of all balance updates *) let test_ticket_balance_multiple_updates () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in let* (_, ctxt) = adjust_balance ctxt alice_red 1 in let* (_, ctxt) = adjust_balance ctxt alice_red 2 in let* (_, ctxt) = adjust_balance ctxt alice_red (-1) in @@ -100,14 +195,14 @@ let test_ticket_balance_multiple_updates () = the table *) let test_empty_balance () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in assert_no_balance ctxt alice_red (** Test that adding one entry with positive balance and then updating with a negative balance also removes the entry *) let test_empty_balance_after_update () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in let* (_, ctxt) = adjust_balance ctxt alice_red 1 in let* (_, ctxt) = adjust_balance ctxt alice_red (-1) in assert_no_balance ctxt alice_red @@ -116,7 +211,7 @@ let test_empty_balance_after_update () = results in an error. *) let test_negative_balance () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in adjust_balance ctxt alice_red (-1) >>= fun res -> Assert.proto_error ~loc:__LOC__ res (fun _err -> true) @@ -125,7 +220,7 @@ let test_negative_balance () = *) let test_storage_space () = let* ctxt = make_context () in - let* (alice_red, ctxt) = hash_key ctxt "alice_red" in + let* (alice_red, ctxt) = make_key ctxt "alice_red" in (* Space for adding an entry is 65 for the key plus 1 for the value. *) let* (space, ctxt) = adjust_balance ctxt alice_red 1 in let* () = Assert.equal_int ~loc:__LOC__ 66 (Z.to_int space) in @@ -155,6 +250,22 @@ let test_storage_space () = let tests = [ + Tztest.tztest + "no overlapping keys for ticketer" + `Quick + test_non_overlapping_keys_ticketer; + Tztest.tztest + "no overlapping keys for content" + `Quick + test_non_overlapping_keys_contents; + Tztest.tztest + "no overlapping keys for content type" + `Quick + test_non_overlapping_keys_type; + Tztest.tztest + "no overlapping keys for owner" + `Quick + test_non_overlapping_keys_owner; Tztest.tztest "ticket balance single update" `Quick diff --git a/src/proto_alpha/lib_protocol/ticket_storage.ml b/src/proto_alpha/lib_protocol/ticket_storage.ml index df3b21dd198b..08ffcf2b367d 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/ticket_storage.ml @@ -23,6 +23,34 @@ (* *) (*****************************************************************************) +type key_hash = Script_expr_hash.t + +let script_expr_hash_of_key_hash key_hash = key_hash + +let hash_bytes_cost bytes = + let module S = Saturation_repr in + let ( + ) = S.add in + let v0 = S.safe_int @@ Bytes.length bytes in + let ( lsr ) = S.shift_right in + S.safe_int 200 + (v0 + (v0 lsr 2)) |> Gas_limit_repr.atomic_step_cost + +let hash_of_nodes ctxt (nodes : Script_repr.node list) = + List.fold_left_e + (fun (bs, ctxt) expr -> + let node = Micheline.strip_locations expr in + let lexpr = Script_repr.lazy_expr node in + Raw_context.consume_gas ctxt @@ Script_repr.force_bytes_cost lexpr + >>? fun ctxt -> + Script_repr.force_bytes lexpr >>? fun b -> + Raw_context.consume_gas ctxt (hash_bytes_cost b) >|? fun ctxt -> + (b :: bs, ctxt)) + ([], ctxt) + nodes + >|? fun (bs, ctxt) -> (Script_expr_hash.hash_bytes bs, ctxt) + +let make_key_hash ctxt ~ticketer ~typ ~contents ~owner = + hash_of_nodes ctxt [ticketer; typ; contents; owner] + type error += | Negative_ticket_balance of {key : Script_expr_hash.t; balance : Z.t} diff --git a/src/proto_alpha/lib_protocol/ticket_storage.mli b/src/proto_alpha/lib_protocol/ticket_storage.mli index ca832918134d..c116eb052177 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.mli +++ b/src/proto_alpha/lib_protocol/ticket_storage.mli @@ -23,15 +23,37 @@ (* *) (*****************************************************************************) +(** A value of type [key_hash] is a hashed combination of: + - Ticketer + - Content type + - Content + - Owner +*) +type key_hash + +(** [script_expr_hash_of_key_hash key_hash] returns a [Script_expr_hash.t] value + representation of the given [key_hash]. This is useful for comparing and + pretty-printing key-hash values. *) +val script_expr_hash_of_key_hash : key_hash -> Script_expr_hash.t + +(** [make_key_hash ctxt ~ticketer ~typ ~contents ~owner] creates a hashed + representation of the given [ticketer], [typ], [contents] and [owner]. +*) +val make_key_hash : + Raw_context.t -> + ticketer:Script_repr.node -> + typ:Script_repr.node -> + contents:Script_repr.node -> + owner:Script_repr.node -> + (key_hash * Raw_context.t) tzresult + (** [get_balance ctxt key] receives the ticket balance for the given [key] in the context [ctxt]. The [key] represents a ticket content and a ticket creator pair. In case there exists no value for the given [key], [None] is returned. *) val get_balance : - Raw_context.t -> - Script_expr_hash.t -> - (Z.t option * Raw_context.t) tzresult Lwt.t + Raw_context.t -> key_hash -> (Z.t option * Raw_context.t) tzresult Lwt.t (** [adjust_balance ctxt key ~delta] adjusts the balance of the given key (representing a ticket content, creator and owner pair) @@ -46,7 +68,4 @@ val get_balance : in case the resulting balance is negative. *) val adjust_balance : - Raw_context.t -> - Script_expr_hash.t -> - delta:Z.t -> - (Z.t * Raw_context.t) tzresult Lwt.t + Raw_context.t -> key_hash -> delta:Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t -- GitLab From 42457665a27eccf1f3078c35f3b330ebe77ad7a6 Mon Sep 17 00:00:00 2001 From: Joel Bjornson Date: Tue, 19 Oct 2021 09:56:31 +0100 Subject: [PATCH 6/6] Fix: simplify hashing of nodes --- .../lib_protocol/ticket_storage.ml | 47 +++++++++++-------- 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/src/proto_alpha/lib_protocol/ticket_storage.ml b/src/proto_alpha/lib_protocol/ticket_storage.ml index 08ffcf2b367d..4fad95fcd5d4 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/ticket_storage.ml @@ -25,6 +25,10 @@ type key_hash = Script_expr_hash.t +type error += + | Negative_ticket_balance of {key : Script_expr_hash.t; balance : Z.t} + | Failed_to_hash_node + let script_expr_hash_of_key_hash key_hash = key_hash let hash_bytes_cost bytes = @@ -34,31 +38,24 @@ let hash_bytes_cost bytes = let ( lsr ) = S.shift_right in S.safe_int 200 + (v0 + (v0 lsr 2)) |> Gas_limit_repr.atomic_step_cost -let hash_of_nodes ctxt (nodes : Script_repr.node list) = - List.fold_left_e - (fun (bs, ctxt) expr -> - let node = Micheline.strip_locations expr in - let lexpr = Script_repr.lazy_expr node in - Raw_context.consume_gas ctxt @@ Script_repr.force_bytes_cost lexpr - >>? fun ctxt -> - Script_repr.force_bytes lexpr >>? fun b -> - Raw_context.consume_gas ctxt (hash_bytes_cost b) >|? fun ctxt -> - (b :: bs, ctxt)) - ([], ctxt) - nodes - >|? fun (bs, ctxt) -> (Script_expr_hash.hash_bytes bs, ctxt) +let hash_of_node ctxt node = + Raw_context.consume_gas ctxt (Script_repr.strip_locations_cost node) + >>? fun ctxt -> + let node = Micheline.strip_locations node in + match Data_encoding.Binary.to_bytes_opt Script_repr.expr_encoding node with + | Some bytes -> + Raw_context.consume_gas ctxt (hash_bytes_cost bytes) >|? fun ctxt -> + (Script_expr_hash.hash_bytes [bytes], ctxt) + | None -> error Failed_to_hash_node let make_key_hash ctxt ~ticketer ~typ ~contents ~owner = - hash_of_nodes ctxt [ticketer; typ; contents; owner] - -type error += - | Negative_ticket_balance of {key : Script_expr_hash.t; balance : Z.t} + hash_of_node ctxt @@ Micheline.Seq (0, [ticketer; typ; contents; owner]) let () = let open Data_encoding in register_error_kind `Permanent - ~id:"negative_ticket_balance" + ~id:"Negative_ticket_balance" ~title:"Negative ticket balance" ~description:"Attempted to set a negative ticket balance value" ~pp:(fun ppf (key, balance) -> @@ -73,7 +70,19 @@ let () = (function | Negative_ticket_balance {key; balance} -> Some (key, balance) | _ -> None) - (fun (key, balance) -> Negative_ticket_balance {key; balance}) + (fun (key, balance) -> Negative_ticket_balance {key; balance}) ; + register_error_kind + `Branch + ~id:"Failed_to_hash_node" + ~title:"Failed to hash node" + ~description:"Failed to hash node for a key in the ticket-balance table" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Failed to hash node for a key in the ticket-balance table") + Data_encoding.empty + (function Failed_to_hash_node -> Some () | _ -> None) + (fun () -> Failed_to_hash_node) let get_balance ctxt key = Storage.Ticket_balance.Table.find ctxt key >|=? fun (ctxt, res) -> (res, ctxt) -- GitLab