857 lines
27 KiB
OCaml
857 lines
27 KiB
OCaml
(*****************************************************************************)
|
|
(* *)
|
|
(* Open Source License *)
|
|
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* 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. *)
|
|
(* *)
|
|
(*****************************************************************************)
|
|
|
|
(* Tezos Protocol Implementation - Low level Repr. of Operations *)
|
|
|
|
module Kind = struct
|
|
type seed_nonce_revelation = Seed_nonce_revelation_kind
|
|
|
|
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
|
|
|
type double_baking_evidence = Double_baking_evidence_kind
|
|
|
|
type activate_account = Activate_account_kind
|
|
|
|
type endorsement = Endorsement_kind
|
|
|
|
type proposals = Proposals_kind
|
|
|
|
type ballot = Ballot_kind
|
|
|
|
type reveal = Reveal_kind
|
|
|
|
type transaction = Transaction_kind
|
|
|
|
type origination = Origination_kind
|
|
|
|
type delegation = Delegation_kind
|
|
|
|
type 'a manager =
|
|
| Reveal_manager_kind : reveal manager
|
|
| Transaction_manager_kind : transaction manager
|
|
| Origination_manager_kind : origination manager
|
|
| Delegation_manager_kind : delegation manager
|
|
end
|
|
|
|
type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}
|
|
|
|
let raw_encoding = Operation.encoding
|
|
|
|
type 'kind operation = {
|
|
shell : Operation.shell_header;
|
|
protocol_data : 'kind protocol_data;
|
|
}
|
|
|
|
and 'kind protocol_data = {
|
|
contents : 'kind contents_list;
|
|
signature : Signature.t option;
|
|
}
|
|
|
|
and _ contents_list =
|
|
| Single : 'kind contents -> 'kind contents_list
|
|
| Cons :
|
|
'kind Kind.manager contents * 'rest Kind.manager contents_list
|
|
-> ('kind * 'rest) Kind.manager contents_list
|
|
|
|
and _ contents =
|
|
| Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents
|
|
| Seed_nonce_revelation : {
|
|
level : Raw_level_repr.t;
|
|
nonce : Seed_repr.nonce;
|
|
}
|
|
-> Kind.seed_nonce_revelation contents
|
|
| Double_endorsement_evidence : {
|
|
op1 : Kind.endorsement operation;
|
|
op2 : Kind.endorsement operation;
|
|
}
|
|
-> Kind.double_endorsement_evidence contents
|
|
| Double_baking_evidence : {
|
|
bh1 : Block_header_repr.t;
|
|
bh2 : Block_header_repr.t;
|
|
}
|
|
-> Kind.double_baking_evidence contents
|
|
| Activate_account : {
|
|
id : Ed25519.Public_key_hash.t;
|
|
activation_code : Blinded_public_key_hash.activation_code;
|
|
}
|
|
-> Kind.activate_account contents
|
|
| Proposals : {
|
|
source : Signature.Public_key_hash.t;
|
|
period : Voting_period_repr.t;
|
|
proposals : Protocol_hash.t list;
|
|
}
|
|
-> Kind.proposals contents
|
|
| Ballot : {
|
|
source : Signature.Public_key_hash.t;
|
|
period : Voting_period_repr.t;
|
|
proposal : Protocol_hash.t;
|
|
ballot : Vote_repr.ballot;
|
|
}
|
|
-> Kind.ballot contents
|
|
| Manager_operation : {
|
|
source : Signature.public_key_hash;
|
|
fee : Tez_repr.tez;
|
|
counter : counter;
|
|
operation : 'kind manager_operation;
|
|
gas_limit : Z.t;
|
|
storage_limit : Z.t;
|
|
}
|
|
-> 'kind Kind.manager contents
|
|
|
|
and _ manager_operation =
|
|
| Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
|
|
| Transaction : {
|
|
amount : Tez_repr.tez;
|
|
parameters : Script_repr.lazy_expr;
|
|
entrypoint : string;
|
|
destination : Contract_repr.contract;
|
|
}
|
|
-> Kind.transaction manager_operation
|
|
| Origination : {
|
|
delegate : Signature.Public_key_hash.t option;
|
|
script : Script_repr.t;
|
|
credit : Tez_repr.tez;
|
|
preorigination : Contract_repr.t option;
|
|
}
|
|
-> Kind.origination manager_operation
|
|
| Delegation :
|
|
Signature.Public_key_hash.t option
|
|
-> Kind.delegation manager_operation
|
|
|
|
and counter = Z.t
|
|
|
|
let manager_kind : type kind. kind manager_operation -> kind Kind.manager =
|
|
function
|
|
| Reveal _ ->
|
|
Kind.Reveal_manager_kind
|
|
| Transaction _ ->
|
|
Kind.Transaction_manager_kind
|
|
| Origination _ ->
|
|
Kind.Origination_manager_kind
|
|
| Delegation _ ->
|
|
Kind.Delegation_manager_kind
|
|
|
|
type 'kind internal_operation = {
|
|
source : Contract_repr.contract;
|
|
operation : 'kind manager_operation;
|
|
nonce : int;
|
|
}
|
|
|
|
type packed_manager_operation =
|
|
| Manager : 'kind manager_operation -> packed_manager_operation
|
|
|
|
type packed_contents = Contents : 'kind contents -> packed_contents
|
|
|
|
type packed_contents_list =
|
|
| Contents_list : 'kind contents_list -> packed_contents_list
|
|
|
|
type packed_protocol_data =
|
|
| Operation_data : 'kind protocol_data -> packed_protocol_data
|
|
|
|
type packed_operation = {
|
|
shell : Operation.shell_header;
|
|
protocol_data : packed_protocol_data;
|
|
}
|
|
|
|
let pack ({shell; protocol_data} : _ operation) : packed_operation =
|
|
{shell; protocol_data = Operation_data protocol_data}
|
|
|
|
type packed_internal_operation =
|
|
| Internal_operation : 'kind internal_operation -> packed_internal_operation
|
|
|
|
let rec to_list = function
|
|
| Contents_list (Single o) ->
|
|
[Contents o]
|
|
| Contents_list (Cons (o, os)) ->
|
|
Contents o :: to_list (Contents_list os)
|
|
|
|
let rec of_list = function
|
|
| [] ->
|
|
assert false
|
|
| [Contents o] ->
|
|
Contents_list (Single o)
|
|
| Contents o :: os -> (
|
|
let (Contents_list os) = of_list os in
|
|
match (o, os) with
|
|
| (Manager_operation _, Single (Manager_operation _)) ->
|
|
Contents_list (Cons (o, os))
|
|
| (Manager_operation _, Cons _) ->
|
|
Contents_list (Cons (o, os))
|
|
| _ ->
|
|
Pervasives.failwith
|
|
"Operation list of length > 1 should only contains manager \
|
|
operations." )
|
|
|
|
module Encoding = struct
|
|
open Data_encoding
|
|
|
|
let 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)
|
|
|
|
module Manager_operations = struct
|
|
type 'kind case =
|
|
| MCase : {
|
|
tag : int;
|
|
name : string;
|
|
encoding : 'a Data_encoding.t;
|
|
select : packed_manager_operation -> 'kind manager_operation option;
|
|
proj : 'kind manager_operation -> 'a;
|
|
inj : 'a -> 'kind manager_operation;
|
|
}
|
|
-> 'kind case
|
|
|
|
let reveal_case =
|
|
MCase
|
|
{
|
|
tag = 0;
|
|
name = "reveal";
|
|
encoding = obj1 (req "public_key" Signature.Public_key.encoding);
|
|
select = (function Manager (Reveal _ as op) -> Some op | _ -> None);
|
|
proj = (function Reveal pkh -> pkh);
|
|
inj = (fun pkh -> Reveal pkh);
|
|
}
|
|
|
|
let entrypoint_encoding =
|
|
def
|
|
~title:"entrypoint"
|
|
~description:"Named entrypoint to a Michelson smart contract"
|
|
"entrypoint"
|
|
@@
|
|
let builtin_case tag name =
|
|
Data_encoding.case
|
|
(Tag tag)
|
|
~title:name
|
|
(constant name)
|
|
(fun n -> if Compare.String.(n = name) then Some () else None)
|
|
(fun () -> name)
|
|
in
|
|
union
|
|
[ builtin_case 0 "default";
|
|
builtin_case 1 "root";
|
|
builtin_case 2 "do";
|
|
builtin_case 3 "set_delegate";
|
|
builtin_case 4 "remove_delegate";
|
|
Data_encoding.case
|
|
(Tag 255)
|
|
~title:"named"
|
|
(Bounded.string 31)
|
|
(fun s -> Some s)
|
|
(fun s -> s) ]
|
|
|
|
let transaction_case =
|
|
MCase
|
|
{
|
|
tag = 1;
|
|
name = "transaction";
|
|
encoding =
|
|
obj3
|
|
(req "amount" Tez_repr.encoding)
|
|
(req "destination" Contract_repr.encoding)
|
|
(opt
|
|
"parameters"
|
|
(obj2
|
|
(req "entrypoint" entrypoint_encoding)
|
|
(req "value" Script_repr.lazy_expr_encoding)));
|
|
select =
|
|
(function Manager (Transaction _ as op) -> Some op | _ -> None);
|
|
proj =
|
|
(function
|
|
| Transaction {amount; destination; parameters; entrypoint} ->
|
|
let parameters =
|
|
if
|
|
Script_repr.is_unit_parameter parameters
|
|
&& Compare.String.(entrypoint = "default")
|
|
then None
|
|
else Some (entrypoint, parameters)
|
|
in
|
|
(amount, destination, parameters));
|
|
inj =
|
|
(fun (amount, destination, parameters) ->
|
|
let (entrypoint, parameters) =
|
|
match parameters with
|
|
| None ->
|
|
("default", Script_repr.unit_parameter)
|
|
| Some (entrypoint, value) ->
|
|
(entrypoint, value)
|
|
in
|
|
Transaction {amount; destination; parameters; entrypoint});
|
|
}
|
|
|
|
let origination_case =
|
|
MCase
|
|
{
|
|
tag = 2;
|
|
name = "origination";
|
|
encoding =
|
|
obj3
|
|
(req "balance" Tez_repr.encoding)
|
|
(opt "delegate" Signature.Public_key_hash.encoding)
|
|
(req "script" Script_repr.encoding);
|
|
select =
|
|
(function Manager (Origination _ as op) -> Some op | _ -> None);
|
|
proj =
|
|
(function
|
|
| Origination
|
|
{ credit;
|
|
delegate;
|
|
script;
|
|
preorigination =
|
|
_
|
|
(* the hash is only used internally
|
|
when originating from smart
|
|
contracts, don't serialize it *)
|
|
} ->
|
|
(credit, delegate, script));
|
|
inj =
|
|
(fun (credit, delegate, script) ->
|
|
Origination {credit; delegate; script; preorigination = None});
|
|
}
|
|
|
|
let delegation_case =
|
|
MCase
|
|
{
|
|
tag = 3;
|
|
name = "delegation";
|
|
encoding = obj1 (opt "delegate" Signature.Public_key_hash.encoding);
|
|
select =
|
|
(function Manager (Delegation _ as op) -> Some op | _ -> None);
|
|
proj = (function Delegation key -> key);
|
|
inj = (fun key -> Delegation key);
|
|
}
|
|
|
|
let encoding =
|
|
let make (MCase {tag; name; encoding; select; proj; inj}) =
|
|
case
|
|
(Tag tag)
|
|
name
|
|
encoding
|
|
(fun o ->
|
|
match select o with None -> None | Some o -> Some (proj o))
|
|
(fun x -> Manager (inj x))
|
|
in
|
|
union
|
|
~tag_size:`Uint8
|
|
[ make reveal_case;
|
|
make transaction_case;
|
|
make origination_case;
|
|
make delegation_case ]
|
|
end
|
|
|
|
type 'b case =
|
|
| Case : {
|
|
tag : int;
|
|
name : string;
|
|
encoding : 'a Data_encoding.t;
|
|
select : packed_contents -> 'b contents option;
|
|
proj : 'b contents -> 'a;
|
|
inj : 'a -> 'b contents;
|
|
}
|
|
-> 'b case
|
|
|
|
let endorsement_encoding = obj1 (req "level" Raw_level_repr.encoding)
|
|
|
|
let endorsement_case =
|
|
Case
|
|
{
|
|
tag = 0;
|
|
name = "endorsement";
|
|
encoding = endorsement_encoding;
|
|
select =
|
|
(function Contents (Endorsement _ as op) -> Some op | _ -> None);
|
|
proj = (fun (Endorsement {level}) -> level);
|
|
inj = (fun level -> Endorsement {level});
|
|
}
|
|
|
|
let endorsement_encoding =
|
|
let make (Case {tag; name; encoding; select = _; proj; inj}) =
|
|
case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x)
|
|
in
|
|
let to_list : Kind.endorsement contents_list -> _ = function
|
|
| Single o ->
|
|
o
|
|
in
|
|
let of_list : Kind.endorsement contents -> _ = function o -> Single o in
|
|
def "inlined.endorsement"
|
|
@@ conv
|
|
(fun ({shell; protocol_data = {contents; signature}} : _ operation) ->
|
|
(shell, (contents, signature)))
|
|
(fun (shell, (contents, signature)) ->
|
|
({shell; protocol_data = {contents; signature}} : _ operation))
|
|
(merge_objs
|
|
Operation.shell_header_encoding
|
|
(obj2
|
|
(req
|
|
"operations"
|
|
( conv to_list of_list
|
|
@@ def "inlined.endorsement.contents"
|
|
@@ union [make endorsement_case] ))
|
|
(varopt "signature" Signature.encoding)))
|
|
|
|
let seed_nonce_revelation_case =
|
|
Case
|
|
{
|
|
tag = 1;
|
|
name = "seed_nonce_revelation";
|
|
encoding =
|
|
obj2
|
|
(req "level" Raw_level_repr.encoding)
|
|
(req "nonce" Seed_repr.nonce_encoding);
|
|
select =
|
|
(function
|
|
| Contents (Seed_nonce_revelation _ as op) -> Some op | _ -> None);
|
|
proj = (fun (Seed_nonce_revelation {level; nonce}) -> (level, nonce));
|
|
inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce});
|
|
}
|
|
|
|
let double_endorsement_evidence_case : Kind.double_endorsement_evidence case
|
|
=
|
|
Case
|
|
{
|
|
tag = 2;
|
|
name = "double_endorsement_evidence";
|
|
encoding =
|
|
obj2
|
|
(req "op1" (dynamic_size endorsement_encoding))
|
|
(req "op2" (dynamic_size endorsement_encoding));
|
|
select =
|
|
(function
|
|
| Contents (Double_endorsement_evidence _ as op) ->
|
|
Some op
|
|
| _ ->
|
|
None);
|
|
proj = (fun (Double_endorsement_evidence {op1; op2}) -> (op1, op2));
|
|
inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2});
|
|
}
|
|
|
|
let double_baking_evidence_case =
|
|
Case
|
|
{
|
|
tag = 3;
|
|
name = "double_baking_evidence";
|
|
encoding =
|
|
obj2
|
|
(req "bh1" (dynamic_size Block_header_repr.encoding))
|
|
(req "bh2" (dynamic_size Block_header_repr.encoding));
|
|
select =
|
|
(function
|
|
| Contents (Double_baking_evidence _ as op) -> Some op | _ -> None);
|
|
proj = (fun (Double_baking_evidence {bh1; bh2}) -> (bh1, bh2));
|
|
inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2});
|
|
}
|
|
|
|
let activate_account_case =
|
|
Case
|
|
{
|
|
tag = 4;
|
|
name = "activate_account";
|
|
encoding =
|
|
obj2
|
|
(req "pkh" Ed25519.Public_key_hash.encoding)
|
|
(req "secret" Blinded_public_key_hash.activation_code_encoding);
|
|
select =
|
|
(function
|
|
| Contents (Activate_account _ as op) -> Some op | _ -> None);
|
|
proj =
|
|
(fun (Activate_account {id; activation_code}) ->
|
|
(id, activation_code));
|
|
inj =
|
|
(fun (id, activation_code) -> Activate_account {id; activation_code});
|
|
}
|
|
|
|
let proposals_case =
|
|
Case
|
|
{
|
|
tag = 5;
|
|
name = "proposals";
|
|
encoding =
|
|
obj3
|
|
(req "source" Signature.Public_key_hash.encoding)
|
|
(req "period" Voting_period_repr.encoding)
|
|
(req "proposals" (list Protocol_hash.encoding));
|
|
select =
|
|
(function Contents (Proposals _ as op) -> Some op | _ -> None);
|
|
proj =
|
|
(fun (Proposals {source; period; proposals}) ->
|
|
(source, period, proposals));
|
|
inj =
|
|
(fun (source, period, proposals) ->
|
|
Proposals {source; period; proposals});
|
|
}
|
|
|
|
let ballot_case =
|
|
Case
|
|
{
|
|
tag = 6;
|
|
name = "ballot";
|
|
encoding =
|
|
obj4
|
|
(req "source" Signature.Public_key_hash.encoding)
|
|
(req "period" Voting_period_repr.encoding)
|
|
(req "proposal" Protocol_hash.encoding)
|
|
(req "ballot" Vote_repr.ballot_encoding);
|
|
select = (function Contents (Ballot _ as op) -> Some op | _ -> None);
|
|
proj =
|
|
(function
|
|
| Ballot {source; period; proposal; ballot} ->
|
|
(source, period, proposal, ballot));
|
|
inj =
|
|
(fun (source, period, proposal, ballot) ->
|
|
Ballot {source; period; proposal; ballot});
|
|
}
|
|
|
|
let manager_encoding =
|
|
obj5
|
|
(req "source" Signature.Public_key_hash.encoding)
|
|
(req "fee" Tez_repr.encoding)
|
|
(req "counter" (check_size 10 n))
|
|
(req "gas_limit" (check_size 10 n))
|
|
(req "storage_limit" (check_size 10 n))
|
|
|
|
let extract (type kind)
|
|
(Manager_operation
|
|
{source; fee; counter; gas_limit; storage_limit; operation = _} :
|
|
kind Kind.manager contents) =
|
|
(source, fee, counter, gas_limit, storage_limit)
|
|
|
|
let rebuild (source, fee, counter, gas_limit, storage_limit) operation =
|
|
Manager_operation
|
|
{source; fee; counter; gas_limit; storage_limit; operation}
|
|
|
|
let make_manager_case tag (type kind)
|
|
(Manager_operations.MCase mcase : kind Manager_operations.case) =
|
|
Case
|
|
{
|
|
tag;
|
|
name = mcase.name;
|
|
encoding = merge_objs manager_encoding mcase.encoding;
|
|
select =
|
|
(function
|
|
| Contents (Manager_operation ({operation; _} as op)) -> (
|
|
match mcase.select (Manager operation) with
|
|
| None ->
|
|
None
|
|
| Some operation ->
|
|
Some (Manager_operation {op with operation}) )
|
|
| _ ->
|
|
None);
|
|
proj =
|
|
(function
|
|
| Manager_operation {operation; _} as op ->
|
|
(extract op, mcase.proj operation));
|
|
inj = (fun (op, contents) -> rebuild op (mcase.inj contents));
|
|
}
|
|
|
|
let reveal_case = make_manager_case 107 Manager_operations.reveal_case
|
|
|
|
let transaction_case =
|
|
make_manager_case 108 Manager_operations.transaction_case
|
|
|
|
let origination_case =
|
|
make_manager_case 109 Manager_operations.origination_case
|
|
|
|
let delegation_case =
|
|
make_manager_case 110 Manager_operations.delegation_case
|
|
|
|
let contents_encoding =
|
|
let make (Case {tag; name; encoding; select; proj; inj}) =
|
|
case
|
|
(Tag tag)
|
|
name
|
|
encoding
|
|
(fun o -> match select o with None -> None | Some o -> Some (proj o))
|
|
(fun x -> Contents (inj x))
|
|
in
|
|
def "operation.alpha.contents"
|
|
@@ 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_list_encoding =
|
|
conv to_list of_list (Variable.list contents_encoding)
|
|
|
|
let optional_signature_encoding =
|
|
conv
|
|
(function Some s -> s | None -> Signature.zero)
|
|
(fun s -> if Signature.equal s Signature.zero then None else Some s)
|
|
Signature.encoding
|
|
|
|
let protocol_data_encoding =
|
|
def "operation.alpha.contents_and_signature"
|
|
@@ conv
|
|
(fun (Operation_data {contents; signature}) ->
|
|
(Contents_list contents, signature))
|
|
(fun (Contents_list contents, signature) ->
|
|
Operation_data {contents; signature})
|
|
(obj2
|
|
(req "contents" contents_list_encoding)
|
|
(req "signature" optional_signature_encoding))
|
|
|
|
let operation_encoding =
|
|
conv
|
|
(fun {shell; protocol_data} -> (shell, protocol_data))
|
|
(fun (shell, protocol_data) -> {shell; protocol_data})
|
|
(merge_objs Operation.shell_header_encoding protocol_data_encoding)
|
|
|
|
let unsigned_operation_encoding =
|
|
def "operation.alpha.unsigned_operation"
|
|
@@ merge_objs
|
|
Operation.shell_header_encoding
|
|
(obj1 (req "contents" contents_list_encoding))
|
|
|
|
let internal_operation_encoding =
|
|
def "operation.alpha.internal_operation"
|
|
@@ conv
|
|
(fun (Internal_operation {source; operation; nonce}) ->
|
|
((source, nonce), Manager operation))
|
|
(fun ((source, nonce), Manager operation) ->
|
|
Internal_operation {source; operation; nonce})
|
|
(merge_objs
|
|
(obj2 (req "source" Contract_repr.encoding) (req "nonce" uint16))
|
|
Manager_operations.encoding)
|
|
end
|
|
|
|
let encoding = Encoding.operation_encoding
|
|
|
|
let contents_encoding = Encoding.contents_encoding
|
|
|
|
let contents_list_encoding = Encoding.contents_list_encoding
|
|
|
|
let protocol_data_encoding = Encoding.protocol_data_encoding
|
|
|
|
let unsigned_operation_encoding = Encoding.unsigned_operation_encoding
|
|
|
|
let internal_operation_encoding = Encoding.internal_operation_encoding
|
|
|
|
let raw ({shell; protocol_data} : _ operation) =
|
|
let proto =
|
|
Data_encoding.Binary.to_bytes_exn
|
|
protocol_data_encoding
|
|
(Operation_data protocol_data)
|
|
in
|
|
{Operation.shell; proto}
|
|
|
|
let acceptable_passes (op : packed_operation) =
|
|
let (Operation_data protocol_data) = op.protocol_data in
|
|
match protocol_data.contents with
|
|
| Single (Endorsement _) ->
|
|
[0]
|
|
| Single (Proposals _) ->
|
|
[1]
|
|
| Single (Ballot _) ->
|
|
[1]
|
|
| Single (Seed_nonce_revelation _) ->
|
|
[2]
|
|
| Single (Double_endorsement_evidence _) ->
|
|
[2]
|
|
| Single (Double_baking_evidence _) ->
|
|
[2]
|
|
| Single (Activate_account _) ->
|
|
[2]
|
|
| Single (Manager_operation _) ->
|
|
[3]
|
|
| Cons _ ->
|
|
[3]
|
|
|
|
type error += Invalid_signature (* `Permanent *)
|
|
|
|
type error += Missing_signature (* `Permanent *)
|
|
|
|
let () =
|
|
register_error_kind
|
|
`Permanent
|
|
~id:"operation.invalid_signature"
|
|
~title:"Invalid operation signature"
|
|
~description:
|
|
"The operation signature is ill-formed or has been made with the wrong \
|
|
public key"
|
|
~pp:(fun ppf () -> Format.fprintf ppf "The operation signature is invalid")
|
|
Data_encoding.unit
|
|
(function Invalid_signature -> Some () | _ -> None)
|
|
(fun () -> Invalid_signature) ;
|
|
register_error_kind
|
|
`Permanent
|
|
~id:"operation.missing_signature"
|
|
~title:"Missing operation signature"
|
|
~description:
|
|
"The operation is of a kind that must be signed, but the signature is \
|
|
missing"
|
|
~pp:(fun ppf () -> Format.fprintf ppf "The operation requires a signature")
|
|
Data_encoding.unit
|
|
(function Missing_signature -> Some () | _ -> None)
|
|
(fun () -> Missing_signature)
|
|
|
|
let check_signature_sync (type kind) key chain_id
|
|
({shell; protocol_data} : kind operation) =
|
|
let check ~watermark contents signature =
|
|
let unsigned_operation =
|
|
Data_encoding.Binary.to_bytes_exn
|
|
unsigned_operation_encoding
|
|
(shell, contents)
|
|
in
|
|
if Signature.check ~watermark key signature unsigned_operation then Ok ()
|
|
else error Invalid_signature
|
|
in
|
|
match (protocol_data.contents, protocol_data.signature) with
|
|
| (Single _, None) ->
|
|
error Missing_signature
|
|
| (Cons _, None) ->
|
|
error Missing_signature
|
|
| ((Single (Endorsement _) as contents), Some signature) ->
|
|
check
|
|
~watermark:(Endorsement chain_id)
|
|
(Contents_list contents)
|
|
signature
|
|
| ((Single _ as contents), Some signature) ->
|
|
check ~watermark:Generic_operation (Contents_list contents) signature
|
|
| ((Cons _ as contents), Some signature) ->
|
|
check ~watermark:Generic_operation (Contents_list contents) signature
|
|
|
|
let check_signature pk chain_id op =
|
|
Lwt.return (check_signature_sync pk chain_id op)
|
|
|
|
let hash_raw = Operation.hash
|
|
|
|
let hash (o : _ operation) =
|
|
let proto =
|
|
Data_encoding.Binary.to_bytes_exn
|
|
protocol_data_encoding
|
|
(Operation_data o.protocol_data)
|
|
in
|
|
Operation.hash {shell = o.shell; proto}
|
|
|
|
let hash_packed (o : packed_operation) =
|
|
let proto =
|
|
Data_encoding.Binary.to_bytes_exn protocol_data_encoding o.protocol_data
|
|
in
|
|
Operation.hash {shell = o.shell; proto}
|
|
|
|
type ('a, 'b) eq = Eq : ('a, 'a) eq
|
|
|
|
let equal_manager_operation_kind :
|
|
type a b. a manager_operation -> b manager_operation -> (a, b) eq option =
|
|
fun op1 op2 ->
|
|
match (op1, op2) with
|
|
| (Reveal _, Reveal _) ->
|
|
Some Eq
|
|
| (Reveal _, _) ->
|
|
None
|
|
| (Transaction _, Transaction _) ->
|
|
Some Eq
|
|
| (Transaction _, _) ->
|
|
None
|
|
| (Origination _, Origination _) ->
|
|
Some Eq
|
|
| (Origination _, _) ->
|
|
None
|
|
| (Delegation _, Delegation _) ->
|
|
Some Eq
|
|
| (Delegation _, _) ->
|
|
None
|
|
|
|
let equal_contents_kind :
|
|
type a b. a contents -> b contents -> (a, b) eq option =
|
|
fun op1 op2 ->
|
|
match (op1, op2) with
|
|
| (Endorsement _, Endorsement _) ->
|
|
Some Eq
|
|
| (Endorsement _, _) ->
|
|
None
|
|
| (Seed_nonce_revelation _, Seed_nonce_revelation _) ->
|
|
Some Eq
|
|
| (Seed_nonce_revelation _, _) ->
|
|
None
|
|
| (Double_endorsement_evidence _, Double_endorsement_evidence _) ->
|
|
Some Eq
|
|
| (Double_endorsement_evidence _, _) ->
|
|
None
|
|
| (Double_baking_evidence _, Double_baking_evidence _) ->
|
|
Some Eq
|
|
| (Double_baking_evidence _, _) ->
|
|
None
|
|
| (Activate_account _, Activate_account _) ->
|
|
Some Eq
|
|
| (Activate_account _, _) ->
|
|
None
|
|
| (Proposals _, Proposals _) ->
|
|
Some Eq
|
|
| (Proposals _, _) ->
|
|
None
|
|
| (Ballot _, Ballot _) ->
|
|
Some Eq
|
|
| (Ballot _, _) ->
|
|
None
|
|
| (Manager_operation op1, Manager_operation op2) -> (
|
|
match equal_manager_operation_kind op1.operation op2.operation with
|
|
| None ->
|
|
None
|
|
| Some Eq ->
|
|
Some Eq )
|
|
| (Manager_operation _, _) ->
|
|
None
|
|
|
|
let rec equal_contents_kind_list :
|
|
type a b. a contents_list -> b contents_list -> (a, b) eq option =
|
|
fun op1 op2 ->
|
|
match (op1, op2) with
|
|
| (Single op1, Single op2) ->
|
|
equal_contents_kind op1 op2
|
|
| (Single _, Cons _) ->
|
|
None
|
|
| (Cons _, Single _) ->
|
|
None
|
|
| (Cons (op1, ops1), Cons (op2, ops2)) -> (
|
|
match equal_contents_kind op1 op2 with
|
|
| None ->
|
|
None
|
|
| Some Eq -> (
|
|
match equal_contents_kind_list ops1 ops2 with
|
|
| None ->
|
|
None
|
|
| Some Eq ->
|
|
Some Eq ) )
|
|
|
|
let equal : type a b. a operation -> b operation -> (a, b) eq option =
|
|
fun op1 op2 ->
|
|
if not (Operation_hash.equal (hash op1) (hash op2)) then None
|
|
else
|
|
equal_contents_kind_list
|
|
op1.protocol_data.contents
|
|
op2.protocol_data.contents
|