(*****************************************************************************) (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* *) (* 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. *) (* *) (*****************************************************************************) open Alpha_context open Data_encoding let error_encoding = def "error" ~description: "The full list of RPC errors would be too long to include.\n\ It is available at RPC `/errors` (GET).\n\ Errors specific to protocol Alpha have an id that starts with `proto.alpha`." @@ splitted ~json:(conv (fun err -> Data_encoding.Json.construct Error_monad.error_encoding err) (fun json -> Data_encoding.Json.destruct Error_monad.error_encoding json) json) ~binary:Error_monad.error_encoding type _ successful_manager_operation_result = | Reveal_result : { consumed_gas : Z.t } -> Kind.reveal successful_manager_operation_result | Transaction_result : { storage : Script.expr option ; big_map_diff : Contract.big_map_diff option ; balance_updates : Delegate.balance_updates ; originated_contracts : Contract.t list ; consumed_gas : Z.t ; storage_size : Z.t ; paid_storage_size_diff : Z.t ; allocated_destination_contract : bool ; } -> Kind.transaction successful_manager_operation_result | Origination_result : { big_map_diff : Contract.big_map_diff option ; balance_updates : Delegate.balance_updates ; originated_contracts : Contract.t list ; consumed_gas : Z.t ; storage_size : Z.t ; paid_storage_size_diff : Z.t ; } -> Kind.origination successful_manager_operation_result | Delegation_result : { consumed_gas : Z.t } -> Kind.delegation successful_manager_operation_result type packed_successful_manager_operation_result = | Successful_manager_result : 'kind successful_manager_operation_result -> packed_successful_manager_operation_result type 'kind manager_operation_result = | Applied of 'kind successful_manager_operation_result | Backtracked of 'kind successful_manager_operation_result * error list option | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result | Skipped : 'kind Kind.manager -> 'kind manager_operation_result type packed_internal_operation_result = | Internal_operation_result : 'kind internal_operation * 'kind manager_operation_result -> packed_internal_operation_result module Manager_result = struct type 'kind case = MCase : { op_case: 'kind Operation.Encoding.Manager_operations.case ; encoding: 'a Data_encoding.t ; kind: 'kind Kind.manager ; iselect: packed_internal_operation_result -> ('kind internal_operation * 'kind manager_operation_result) option; select: packed_successful_manager_operation_result -> 'kind successful_manager_operation_result option ; proj: 'kind successful_manager_operation_result -> 'a ; inj: 'a -> 'kind successful_manager_operation_result ; t: 'kind manager_operation_result Data_encoding.t ; } -> 'kind case let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj = let Operation.Encoding.Manager_operations.MCase { name ; _ } = op_case in let t = def (Format.asprintf "operation.alpha.operation_result.%s" name) @@ union ~tag_size:`Uint8 [ case (Tag 0) ~title:"Applied" (merge_objs (obj1 (req "status" (constant "applied"))) encoding) (fun o -> match o with | Skipped _ | Failed _ | Backtracked _ -> None | Applied o -> match select (Successful_manager_result o) with | None -> None | Some o -> Some ((), proj o)) (fun ((), x) -> (Applied (inj x))) ; case (Tag 1) ~title:"Failed" (obj2 (req "status" (constant "failed")) (req "errors" (list error_encoding))) (function (Failed (_, errs)) -> Some ((), errs) | _ -> None) (fun ((), errs) -> Failed (kind, errs)) ; case (Tag 2) ~title:"Skipped" (obj1 (req "status" (constant "skipped"))) (function Skipped _ -> Some () | _ -> None) (fun () -> Skipped kind) ; case (Tag 3) ~title:"Backtracked" (merge_objs (obj2 (req "status" (constant "backtracked")) (opt "errors" (list error_encoding))) encoding) (fun o -> match o with | Skipped _ | Failed _ | Applied _ -> None | Backtracked (o, errs) -> match select (Successful_manager_result o) with | None -> None | Some o -> Some (((), errs), proj o)) (fun (((), errs), x) -> (Backtracked (inj x, errs))) ; ] in MCase { op_case ; encoding ; kind ; iselect ; select ; proj ; inj ; t } let reveal_case = make ~op_case: Operation.Encoding.Manager_operations.reveal_case ~encoding: Data_encoding.(obj1 (dft "consumed_gas" z Z.zero)) ~iselect: (function | Internal_operation_result ({ operation = Reveal _ ; _} as op, res) -> Some (op, res) | _ -> None) ~select: (function | Successful_manager_result (Reveal_result _ as op) -> Some op | _ -> None) ~kind: Kind.Reveal_manager_kind ~proj: (function Reveal_result { consumed_gas } -> consumed_gas) ~inj: (fun consumed_gas -> Reveal_result { consumed_gas }) let transaction_case = make ~op_case: Operation.Encoding.Manager_operations.transaction_case ~encoding: (obj8 (opt "storage" Script.expr_encoding) (opt "big_map_diff" Contract.big_map_diff_encoding) (dft "balance_updates" Delegate.balance_updates_encoding []) (dft "originated_contracts" (list Contract.encoding) []) (dft "consumed_gas" z Z.zero) (dft "storage_size" z Z.zero) (dft "paid_storage_size_diff" z Z.zero) (dft "allocated_destination_contract" bool false)) ~iselect: (function | Internal_operation_result ({ operation = Transaction _ ; _} as op, res) -> Some (op, res) | _ -> None) ~select: (function | Successful_manager_result (Transaction_result _ as op) -> Some op | _ -> None) ~kind: Kind.Transaction_manager_kind ~proj: (function | Transaction_result { storage ; big_map_diff ; balance_updates ; originated_contracts ; consumed_gas ; storage_size ; paid_storage_size_diff ; allocated_destination_contract } -> (storage, big_map_diff, balance_updates, originated_contracts, consumed_gas, storage_size, paid_storage_size_diff, allocated_destination_contract)) ~inj: (fun (storage, big_map_diff, balance_updates, originated_contracts, consumed_gas, storage_size, paid_storage_size_diff, allocated_destination_contract) -> Transaction_result { storage ; big_map_diff ; balance_updates ; originated_contracts ; consumed_gas ; storage_size ; paid_storage_size_diff ; allocated_destination_contract }) let origination_case = make ~op_case: Operation.Encoding.Manager_operations.origination_case ~encoding: (obj6 (opt "big_map_diff" Contract.big_map_diff_encoding) (dft "balance_updates" Delegate.balance_updates_encoding []) (dft "originated_contracts" (list Contract.encoding) []) (dft "consumed_gas" z Z.zero) (dft "storage_size" z Z.zero) (dft "paid_storage_size_diff" z Z.zero)) ~iselect: (function | Internal_operation_result ({ operation = Origination _ ; _} as op, res) -> Some (op, res) | _ -> None) ~select: (function | Successful_manager_result (Origination_result _ as op) -> Some op | _ -> None) ~proj: (function | Origination_result { big_map_diff ; balance_updates ; originated_contracts ; consumed_gas ; storage_size ; paid_storage_size_diff } -> (big_map_diff, balance_updates, originated_contracts, consumed_gas, storage_size, paid_storage_size_diff)) ~kind: Kind.Origination_manager_kind ~inj: (fun (big_map_diff, balance_updates, originated_contracts, consumed_gas, storage_size, paid_storage_size_diff) -> Origination_result { big_map_diff ; balance_updates ; originated_contracts ; consumed_gas ; storage_size ; paid_storage_size_diff }) let delegation_case = make ~op_case: Operation.Encoding.Manager_operations.delegation_case ~encoding: Data_encoding.(obj1 (dft "consumed_gas" z Z.zero)) ~iselect: (function | Internal_operation_result ({ operation = Delegation _ ; _} as op, res) -> Some (op, res) | _ -> None) ~select: (function | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind: Kind.Delegation_manager_kind ~proj: (function Delegation_result { consumed_gas } -> consumed_gas) ~inj: (fun consumed_gas -> Delegation_result { consumed_gas }) end let internal_operation_result_encoding : packed_internal_operation_result Data_encoding.t = let make (type kind) (Manager_result.MCase res_case : kind Manager_result.case) = let Operation.Encoding.Manager_operations.MCase op_case = res_case.op_case in case (Tag op_case.tag) ~title:op_case.name (merge_objs (obj3 (req "kind" (constant op_case.name)) (req "source" Contract.encoding) (req "nonce" uint16)) (merge_objs op_case.encoding (obj1 (req "result" res_case.t)))) (fun op -> match res_case.iselect op with | Some (op, res) -> Some (((), op.source, op.nonce), (op_case.proj op.operation, res)) | None -> None) (fun (((), source, nonce), (op, res)) -> let op = { source ; operation = op_case.inj op ; nonce } in Internal_operation_result (op, res)) in def "operation.alpha.internal_operation_result" @@ union [ make Manager_result.reveal_case ; make Manager_result.transaction_case ; make Manager_result.origination_case ; make Manager_result.delegation_case ; ] type 'kind contents_result = | Endorsement_result : { balance_updates : Delegate.balance_updates ; delegate : Signature.Public_key_hash.t ; slots: int list ; } -> Kind.endorsement contents_result | Seed_nonce_revelation_result : Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result | Double_endorsement_evidence_result : Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result | Double_baking_evidence_result : Delegate.balance_updates -> Kind.double_baking_evidence contents_result | Activate_account_result : Delegate.balance_updates -> Kind.activate_account contents_result | Proposals_result : Kind.proposals contents_result | Ballot_result : Kind.ballot contents_result | Manager_operation_result : { balance_updates : Delegate.balance_updates ; operation_result : 'kind manager_operation_result ; internal_operation_results : packed_internal_operation_result list ; } -> 'kind Kind.manager contents_result type packed_contents_result = | Contents_result : 'kind contents_result -> packed_contents_result type packed_contents_and_result = | Contents_and_result : 'kind Operation.contents * 'kind contents_result -> packed_contents_and_result type ('a, 'b) eq = Eq : ('a, 'a) eq let equal_manager_kind : type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option = fun ka kb -> match ka, kb with | Kind.Reveal_manager_kind, Kind.Reveal_manager_kind -> Some Eq | Kind.Reveal_manager_kind, _ -> None | Kind.Transaction_manager_kind, Kind.Transaction_manager_kind -> Some Eq | Kind.Transaction_manager_kind, _ -> None | Kind.Origination_manager_kind, Kind.Origination_manager_kind -> Some Eq | Kind.Origination_manager_kind, _ -> None | Kind.Delegation_manager_kind, Kind.Delegation_manager_kind -> Some Eq | Kind.Delegation_manager_kind, _ -> None module Encoding = struct type 'kind case = Case : { op_case: 'kind Operation.Encoding.case ; encoding: 'a Data_encoding.t ; select: packed_contents_result -> 'kind contents_result option ; mselect: packed_contents_and_result -> ('kind contents * 'kind contents_result) option ; proj: 'kind contents_result -> 'a ; inj: 'a -> 'kind contents_result ; } -> 'kind case let tagged_case tag name args proj inj = let open Data_encoding in case tag ~title:(String.capitalize_ascii name) (merge_objs (obj1 (req "kind" (constant name))) args) (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case ; encoding = (obj3 (req "balance_updates" Delegate.balance_updates_encoding) (req "delegate" Signature.Public_key_hash.encoding) (req "slots" (list uint8))); select = (function | Contents_result (Endorsement_result _ as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Endorsement _ as op, res) -> Some (op, res) | _ -> None) ; proj = (function | Endorsement_result { balance_updates ; delegate ; slots } -> (balance_updates, delegate, slots)) ; inj = (fun (balance_updates, delegate, slots) -> Endorsement_result { balance_updates ; delegate ; slots }) } let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case ; encoding = (obj1 (req "balance_updates" Delegate.balance_updates_encoding)) ; select = (function | Contents_result (Seed_nonce_revelation_result _ as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Seed_nonce_revelation _ as op, res) -> Some (op, res) | _ -> None) ; proj = (fun (Seed_nonce_revelation_result bus) -> bus) ; inj = (fun bus -> Seed_nonce_revelation_result bus) ; } let double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case ; encoding = (obj1 (req "balance_updates" Delegate.balance_updates_encoding)) ; select = (function | Contents_result (Double_endorsement_evidence_result _ as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Double_endorsement_evidence _ as op, res) -> Some (op, res) | _ -> None) ; proj = (fun (Double_endorsement_evidence_result bus) -> bus) ; inj = (fun bus -> Double_endorsement_evidence_result bus) } let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case ; encoding = (obj1 (req "balance_updates" Delegate.balance_updates_encoding)) ; select = (function | Contents_result (Double_baking_evidence_result _ as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Double_baking_evidence _ as op, res) -> Some (op, res) | _ -> None) ; proj = (fun (Double_baking_evidence_result bus) -> bus) ; inj = (fun bus -> Double_baking_evidence_result bus) ; } let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case ; encoding = (obj1 (req "balance_updates" Delegate.balance_updates_encoding)) ; select = (function | Contents_result (Activate_account_result _ as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Activate_account _ as op, res) -> Some (op, res) | _ -> None) ; proj = (fun (Activate_account_result bus) -> bus) ; inj = (fun bus -> Activate_account_result bus) ; } let proposals_case = Case { op_case = Operation.Encoding.proposals_case ; encoding = Data_encoding.empty ; select = (function | Contents_result (Proposals_result as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Proposals _ as op, res) -> Some (op, res) | _ -> None) ; proj = (fun Proposals_result -> ()) ; inj = (fun () -> Proposals_result) ; } let ballot_case = Case { op_case = Operation.Encoding.ballot_case ; encoding = Data_encoding.empty ; select = (function | Contents_result (Ballot_result as op) -> Some op | _ -> None) ; mselect = (function | Contents_and_result (Ballot _ as op, res) -> Some (op, res) | _ -> None) ; proj = (fun Ballot_result -> ()) ; inj = (fun () -> Ballot_result) ; } let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = Case { op_case = Operation.Encoding.Case op_case ; encoding = (obj3 (req "balance_updates" Delegate.balance_updates_encoding) (req "operation_result" res_case.t) (dft "internal_operation_results" (list internal_operation_result_encoding) [])) ; select = (function | Contents_result (Manager_operation_result ({ operation_result = Applied res ; _ } as op)) -> begin match res_case.select (Successful_manager_result res) with | Some res -> Some (Manager_operation_result { op with operation_result = Applied res }) | None -> None end | Contents_result (Manager_operation_result ({ operation_result = Backtracked (res, errs) ; _ } as op)) -> begin match res_case.select (Successful_manager_result res) with | Some res -> Some (Manager_operation_result { op with operation_result = Backtracked (res, errs) }) | None -> None end | Contents_result (Manager_operation_result ({ operation_result = Skipped kind ; _ } as op)) -> begin match equal_manager_kind kind res_case.kind with | None -> None | Some Eq -> Some (Manager_operation_result { op with operation_result = Skipped kind }) end | Contents_result (Manager_operation_result ({ operation_result = Failed (kind, errs) ; _ } as op)) -> begin match equal_manager_kind kind res_case.kind with | None -> None | Some Eq -> Some (Manager_operation_result { op with operation_result = Failed (kind, errs) }) end | Contents_result Ballot_result -> None | Contents_result (Endorsement_result _) -> None | Contents_result (Seed_nonce_revelation_result _) -> None | Contents_result (Double_endorsement_evidence_result _) -> None | Contents_result (Double_baking_evidence_result _) -> None | Contents_result (Activate_account_result _) -> None | Contents_result Proposals_result -> None) ; mselect ; proj = (fun (Manager_operation_result { balance_updates = bus ; operation_result = r ; internal_operation_results = rs }) -> (bus, r, rs)) ; inj = (fun (bus, r, rs) -> Manager_operation_result { balance_updates = bus ; operation_result = r ; internal_operation_results = rs }) ; } let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case (function | Contents_and_result (Manager_operation { operation = Reveal _ ; _ } as op, res) -> Some (op, res) | _ -> None) let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case (function | Contents_and_result (Manager_operation { operation = Transaction _ ; _ } as op, res) -> Some (op, res) | _ -> None) let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case (function | Contents_and_result (Manager_operation { operation = Origination _ ; _ } as op, res) -> Some (op, res) | _ -> None) let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case (function | Contents_and_result (Manager_operation { operation = Delegation _ ; _ } as op, res) -> Some (op, res) | _ -> None) end let contents_result_encoding = let open Encoding in let make (Case { op_case = Operation.Encoding.Case { tag ; name ; _ } ; encoding ; mselect = _ ; select ; proj ; inj }) = let proj x = match select x with | None -> None | Some x -> Some (proj x) in let inj x = Contents_result (inj x) in tagged_case (Tag tag) name encoding proj inj in def "operation.alpha.contents_result" @@ union [ make endorsement_case ; make seed_nonce_revelation_case ; make double_endorsement_evidence_case ; make double_baking_evidence_case ; make activate_account_case ; make proposals_case ; make ballot_case ; make reveal_case ; make transaction_case ; make origination_case ; make delegation_case ; ] let contents_and_result_encoding = let open Encoding in let make (Case { op_case = Operation.Encoding.Case { tag ; name ; encoding ; proj ; inj ; _ } ; mselect ; encoding = meta_encoding ; proj = meta_proj ; inj = meta_inj ; _ }) = let proj c = match mselect c with | Some (op, res) -> Some (proj op, meta_proj res) | _ -> None in let inj (op, res) = Contents_and_result (inj op, meta_inj res) in let encoding = merge_objs encoding (obj1 (req "metadata" meta_encoding)) in tagged_case (Tag tag) name encoding proj inj in def "operation.alpha.operation_contents_and_result" @@ union [ make endorsement_case ; make seed_nonce_revelation_case ; make double_endorsement_evidence_case ; make double_baking_evidence_case ; make activate_account_case ; make proposals_case ; make ballot_case ; make reveal_case ; make transaction_case ; make origination_case ; make delegation_case ; ] type 'kind contents_result_list = | Single_result : 'kind contents_result -> 'kind contents_result_list | Cons_result : 'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list -> (('kind * 'rest) Kind.manager ) contents_result_list type packed_contents_result_list = Contents_result_list : 'kind contents_result_list -> packed_contents_result_list let contents_result_list_encoding = let rec to_list = function | Contents_result_list (Single_result o) -> [Contents_result o] | Contents_result_list (Cons_result (o, os)) -> Contents_result o :: to_list (Contents_result_list os) in let rec of_list = function | [] -> Pervasives.failwith "cannot decode empty operation result" | [Contents_result o] -> Contents_result_list (Single_result o) | (Contents_result o) :: os -> let Contents_result_list os = of_list os in match o, os with | Manager_operation_result _, Single_result (Manager_operation_result _) -> Contents_result_list (Cons_result (o, os)) | Manager_operation_result _, Cons_result _ -> Contents_result_list (Cons_result (o, os)) | _ -> Pervasives.failwith "cannot decode ill-formed operation result" in def "operation.alpha.contents_list_result" @@ conv to_list of_list (list contents_result_encoding) type 'kind contents_and_result_list = | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list type packed_contents_and_result_list = | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list let contents_and_result_list_encoding = let rec to_list = function | Contents_and_result_list (Single_and_result (op, res)) -> [Contents_and_result (op, res)] | Contents_and_result_list (Cons_and_result (op, res, rest)) -> Contents_and_result (op, res) :: to_list (Contents_and_result_list rest) in let rec of_list = function | [] -> Pervasives.failwith "cannot decode empty combined operation result" | [Contents_and_result (op, res)] -> Contents_and_result_list (Single_and_result (op, res)) | (Contents_and_result (op, res)) :: rest -> let Contents_and_result_list rest = of_list rest in match op, rest with | Manager_operation _, Single_and_result (Manager_operation _, _) -> Contents_and_result_list (Cons_and_result (op, res, rest)) | Manager_operation _, Cons_and_result (_, _, _) -> Contents_and_result_list (Cons_and_result (op, res, rest)) | _ -> Pervasives.failwith "cannot decode ill-formed combined operation result" in conv to_list of_list (Variable.list contents_and_result_encoding) type 'kind operation_metadata = { contents: 'kind contents_result_list ; } type packed_operation_metadata = | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata | No_operation_metadata : packed_operation_metadata let operation_metadata_encoding = def "operation.alpha.result" @@ union [ case (Tag 0) ~title:"Operation_metadata" contents_result_list_encoding (function | Operation_metadata { contents } -> Some (Contents_result_list contents) | _ -> None) (fun (Contents_result_list contents) -> Operation_metadata { contents }) ; case (Tag 1) ~title:"No_operation_metadata" empty (function | No_operation_metadata -> Some () | _ -> None) (fun () -> No_operation_metadata) ; ] let kind_equal : type kind kind2. kind contents -> kind2 contents_result -> (kind, kind2) eq option = fun op res -> match op, res with | Endorsement _, Endorsement_result _ -> Some Eq | Endorsement _, _ -> None | Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq | Seed_nonce_revelation _, _ -> None | Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> Some Eq | Double_endorsement_evidence _, _ -> None | Double_baking_evidence _, Double_baking_evidence_result _ -> Some Eq | Double_baking_evidence _, _ -> None | Activate_account _, Activate_account_result _ -> Some Eq | Activate_account _, _ -> None | Proposals _, Proposals_result -> Some Eq | Proposals _, _ -> None | Ballot _, Ballot_result -> Some Eq | Ballot _, _ -> None | Manager_operation { operation = Reveal _ ; _ }, Manager_operation_result { operation_result = Applied (Reveal_result _); _ } -> Some Eq | Manager_operation { operation = Reveal _ ; _ }, Manager_operation_result { operation_result = Backtracked (Reveal_result _, _) ; _ } -> Some Eq | Manager_operation { operation = Reveal _ ; _ }, Manager_operation_result { operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _); _ } -> Some Eq | Manager_operation { operation = Reveal _ ; _ }, Manager_operation_result { operation_result = Skipped (Alpha_context.Kind.Reveal_manager_kind); _ } -> Some Eq | Manager_operation { operation = Reveal _ ; _ }, _ -> None | Manager_operation { operation = Transaction _ ; _ }, Manager_operation_result { operation_result = Applied (Transaction_result _); _ } -> Some Eq | Manager_operation { operation = Transaction _ ; _ }, Manager_operation_result { operation_result = Backtracked (Transaction_result _, _); _ } -> Some Eq | Manager_operation { operation = Transaction _ ; _ }, Manager_operation_result { operation_result = Failed (Alpha_context.Kind.Transaction_manager_kind, _); _ } -> Some Eq | Manager_operation { operation = Transaction _ ; _ }, Manager_operation_result { operation_result = Skipped (Alpha_context.Kind.Transaction_manager_kind); _ } -> Some Eq | Manager_operation { operation = Transaction _ ; _ }, _ -> None | Manager_operation { operation = Origination _ ; _ }, Manager_operation_result { operation_result = Applied (Origination_result _); _ } -> Some Eq | Manager_operation { operation = Origination _ ; _ }, Manager_operation_result { operation_result = Backtracked (Origination_result _, _); _ } -> Some Eq | Manager_operation { operation = Origination _ ; _ }, Manager_operation_result { operation_result = Failed (Alpha_context.Kind.Origination_manager_kind, _); _ } -> Some Eq | Manager_operation { operation = Origination _ ; _ }, Manager_operation_result { operation_result = Skipped (Alpha_context.Kind.Origination_manager_kind); _ } -> Some Eq | Manager_operation { operation = Origination _ ; _ }, _ -> None | Manager_operation { operation = Delegation _ ; _ }, Manager_operation_result { operation_result = Applied (Delegation_result _) ; _ } -> Some Eq | Manager_operation { operation = Delegation _ ; _ }, Manager_operation_result { operation_result = Backtracked (Delegation_result _, _) ; _ } -> Some Eq | Manager_operation { operation = Delegation _ ; _ }, Manager_operation_result { operation_result = Failed (Alpha_context.Kind.Delegation_manager_kind, _); _ } -> Some Eq | Manager_operation { operation = Delegation _ ; _ }, Manager_operation_result { operation_result = Skipped (Alpha_context.Kind.Delegation_manager_kind); _ } -> Some Eq | Manager_operation { operation = Delegation _ ; _ }, _ -> None let rec kind_equal_list : type kind kind2. kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option = fun contents res -> match contents, res with | Single op, Single_result res -> begin match kind_equal op res with | None -> None | Some Eq -> Some Eq end | Cons (op, ops), Cons_result (res, ress) -> begin match kind_equal op res with | None -> None | Some Eq -> match kind_equal_list ops ress with | None -> None | Some Eq -> Some Eq end | _ -> None let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> kind contents_and_result_list = fun contents res -> begin match contents, res with | Single op, Single_result res -> Single_and_result (op, res) | Cons (op, ops), Cons_result (res, ress) -> Cons_and_result (op, res, pack_contents_list ops ress) | Single (Manager_operation _), Cons_result (Manager_operation_result _, Single_result _) -> . | Cons (_, _), Single_result (Manager_operation_result { operation_result = Failed _ ; _}) -> . | Cons (_, _), Single_result (Manager_operation_result { operation_result = Skipped _ ; _}) -> . | Cons (_, _), Single_result (Manager_operation_result { operation_result = Applied _ ; _}) -> . | Cons (_, _), Single_result (Manager_operation_result { operation_result = Backtracked _ ; _}) -> . | Single _, Cons_result _ -> . end let rec unpack_contents_list : type kind. kind contents_and_result_list -> (kind contents_list * kind contents_result_list) = function | Single_and_result (op, res) -> Single op, Single_result res | Cons_and_result (op, res, rest) -> let ops, ress = unpack_contents_list rest in Cons (op, ops), Cons_result (res, ress) let rec to_list = function | Contents_result_list (Single_result o) -> [Contents_result o] | Contents_result_list (Cons_result (o, os)) -> Contents_result o :: to_list (Contents_result_list os) let rec of_list = function | [] -> assert false | [Contents_result o] -> Contents_result_list (Single_result o) | (Contents_result o) :: os -> let Contents_result_list os = of_list os in match o, os with | Manager_operation_result _, Single_result (Manager_operation_result _) -> Contents_result_list (Cons_result (o, os)) | Manager_operation_result _, Cons_result _ -> Contents_result_list (Cons_result (o, os)) | _ -> Pervasives.failwith "Operation result list of length > 1 \ should only contains manager operations result." let operation_data_and_metadata_encoding = def "operation.alpha.operation_with_metadata" @@ union [ case (Tag 0) ~title:"Operation_with_metadata" (obj2 (req "contents" (dynamic_size contents_and_result_list_encoding)) (opt "signature" Signature.encoding)) (function | (Operation_data _, No_operation_metadata) -> None | (Operation_data op, Operation_metadata res) -> match kind_equal_list op.contents res.contents with | None -> Pervasives.failwith "cannot decode inconsistent combined operation result" | Some Eq -> Some (Contents_and_result_list (pack_contents_list op.contents res.contents), op.signature)) (fun (Contents_and_result_list contents, signature) -> let op_contents, res_contents = unpack_contents_list contents in (Operation_data { contents = op_contents ; signature }, Operation_metadata { contents = res_contents })) ; case (Tag 1) ~title:"Operation_without_metadata" (obj2 (req "contents" (dynamic_size Operation.contents_list_encoding)) (opt "signature" Signature.encoding)) (function | (Operation_data op, No_operation_metadata) -> Some (Contents_list op.contents, op.signature) | (Operation_data _, Operation_metadata _) -> None) (fun (Contents_list contents, signature) -> (Operation_data { contents ; signature }, No_operation_metadata)) ] type block_metadata = { baker: Signature.Public_key_hash.t ; level: Level.t ; voting_period_kind: Voting_period.kind ; nonce_hash: Nonce_hash.t option ; consumed_gas: Z.t ; deactivated: Signature.Public_key_hash.t list ; balance_updates: Delegate.balance_updates ; } let block_metadata_encoding = let open Data_encoding in def "block_header.alpha.metadata" @@ conv (fun { baker ; level ; voting_period_kind ; nonce_hash ; consumed_gas ; deactivated ; balance_updates } -> ( baker, level, voting_period_kind, nonce_hash, consumed_gas, deactivated, balance_updates )) (fun ( baker, level, voting_period_kind, nonce_hash, consumed_gas, deactivated, balance_updates ) -> { baker ; level ; voting_period_kind ; nonce_hash ; consumed_gas ; deactivated ; balance_updates }) (obj7 (req "baker" Signature.Public_key_hash.encoding) (req "level" Level.encoding) (req "voting_period_kind" Voting_period.kind_encoding) (req "nonce_hash" (option Nonce_hash.encoding)) (req "consumed_gas" (check_size 10 n)) (req "deactivated" (list Signature.Public_key_hash.encoding)) (req "balance_updates" Delegate.balance_updates_encoding))