ligo/src/proto/alpha/operation_repr.ml
2017-05-31 16:36:12 +02:00

417 lines
13 KiB
OCaml

(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(* Tezos Protocol Implementation - Low level Repr. of Operations *)
type operation = {
hash: Operation_hash.t ;
shell: Updater.shell_operation ;
contents: proto_operation ;
signature: Ed25519.Signature.t option ;
}
and proto_operation =
| Anonymous_operations of anonymous_operation list
| Sourced_operations of sourced_operations
and anonymous_operation =
| Seed_nonce_revelation of {
level: Raw_level_repr.t ;
nonce: Seed_repr.nonce ;
}
| Faucet of {
id: Ed25519.Public_key_hash.t ;
counter: counter ;
nonce: MBytes.t ;
}
and sourced_operations =
| Manager_operations of {
source: Contract_repr.contract ;
public_key: Ed25519.Public_key.t option ;
fee: Tez_repr.tez ;
counter: counter ;
operations: manager_operation list ;
}
| Delegate_operations of {
source: Ed25519.Public_key.t ;
operations: delegate_operation list ;
}
| Dictator_operation of dictator_operation
and manager_operation =
| Transaction of {
amount: Tez_repr.tez ;
parameters: Script_repr.expr option ;
destination: Contract_repr.contract ;
}
| Origination of {
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
script: Script_repr.t option ;
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;
}
| Delegation of Ed25519.Public_key_hash.t option
and delegate_operation =
| Endorsement of {
block: Block_hash.t ;
slot: int ;
}
| Proposals of {
period: Voting_period_repr.t ;
proposals: Protocol_hash.t list ;
}
| Ballot of {
period: Voting_period_repr.t ;
proposal: Protocol_hash.t ;
ballot: Vote_repr.ballot ;
}
and dictator_operation =
| Activate of Protocol_hash.t
| Activate_testnet of Protocol_hash.t
and counter = Int32.t
module Encoding = struct
open Data_encoding
let transaction_encoding =
(obj4
(req "kind" (constant "transaction"))
(req "amount" Tez_repr.encoding)
(req "destination" Contract_repr.encoding)
(opt "parameters" Script_repr.expr_encoding))
let transaction_case tag =
case ~tag transaction_encoding
(function
| Transaction { amount ; destination ; parameters } ->
Some ((), amount, destination, parameters)
| _ -> None)
(fun ((), amount, destination, parameters) ->
Transaction { amount ; destination ; parameters })
let origination_encoding =
(obj7
(req "kind" (constant "origination"))
(req "managerPubkey" Ed25519.Public_key_hash.encoding)
(req "balance" Tez_repr.encoding)
(opt "spendable" bool)
(opt "delegatable" bool)
(opt "delegate" Ed25519.Public_key_hash.encoding)
(opt "script" Script_repr.encoding))
let origination_case tag =
case ~tag origination_encoding
(function
| Origination { manager ; credit ; spendable ;
delegatable ; delegate ; script } ->
Some ((), manager, credit, Some spendable,
Some delegatable, delegate, script)
| _ -> None)
(fun ((), manager, credit, spendable, delegatable, delegate, script) ->
let delegatable =
match delegatable with None -> true | Some b -> b in
let spendable =
match spendable with None -> true | Some b -> b in
Origination
{manager ; credit ; spendable ; delegatable ; delegate ; script })
let delegation_encoding =
(obj2
(req "kind" (constant "delegation"))
(opt "delegate" Ed25519.Public_key_hash.encoding))
let delegation_case tag =
case ~tag delegation_encoding
(function Delegation key -> Some ((), key) | _ -> None)
(fun ((), key) -> Delegation key)
let manager_kind_encoding =
(obj5
(req "source" Contract_repr.encoding)
(opt "public_key" Ed25519.Public_key.encoding)
(req "fee" Tez_repr.encoding)
(req "counter" int32)
(req "operations"
(list (union ~tag_size:`Uint8 [
transaction_case 0 ;
origination_case 1 ;
delegation_case 2 ;
]))))
let manager_kind_case tag =
case ~tag manager_kind_encoding
(function
| Manager_operations { source; public_key ; fee ; counter ;operations } ->
Some (source, public_key, fee, counter, operations)
| _ -> None)
(fun (source, public_key, fee, counter, operations) ->
Manager_operations { source; public_key ; fee ; counter ; operations })
let endorsement_encoding =
(obj3
(req "kind" (constant "endorsement"))
(req "block" Block_hash.encoding)
(req "slot" int31))
let endorsement_case tag =
case ~tag endorsement_encoding
(function
| Endorsement { block ; slot } ->
Some ((), block, slot)
| _ -> None)
(fun ((), block, slot) ->
Endorsement { block ; slot })
let proposal_encoding =
(obj3
(req "kind" (constant "proposal"))
(req "period" Voting_period_repr.encoding)
(req "proposals" (list Protocol_hash.encoding)))
let proposal_case tag =
case ~tag proposal_encoding
(function
| Proposals { period ; proposals } ->
Some ((), period, proposals)
| _ -> None)
(fun ((), period, proposals) ->
Proposals { period ; proposals })
let ballot_encoding =
(obj4
(req "kind" (constant "ballot"))
(req "period" Voting_period_repr.encoding)
(req "proposal" Protocol_hash.encoding)
(req "ballot" Vote_repr.ballot_encoding))
let ballot_case tag =
case ~tag ballot_encoding
(function
| Ballot { period ; proposal ; ballot } ->
Some ((), period, proposal, ballot)
| _ -> None)
(fun ((), period, proposal, ballot) ->
Ballot { period ; proposal ; ballot })
let delegate_kind_encoding =
(obj2
(req "source" Ed25519.Public_key.encoding)
(req "operations"
(list (union [
endorsement_case 0 ;
proposal_case 1 ;
ballot_case 2 ;
]))))
let delegate_kind_case tag =
case ~tag delegate_kind_encoding
(function
| Delegate_operations { source ; operations } ->
Some (source, operations)
| _ -> None)
(fun (source, operations) -> Delegate_operations { source ; operations })
let dictator_kind_encoding =
let mk_case name args =
let open Data_encoding in
conv
(fun o -> ((), o))
(fun ((), o) -> o)
(merge_objs
(obj1 (req "network" (constant name)))
args) in
let open Data_encoding in
union ~tag_size:`Uint8 [
case ~tag:0
(mk_case "activate"
(obj1 (req "hash" Protocol_hash.encoding)))
(function (Activate hash) -> Some hash | _ -> None)
(fun hash -> Activate hash) ;
case ~tag:1
(mk_case "activate_testnet"
(obj1 (req "hash" Protocol_hash.encoding)))
(function (Activate_testnet hash) -> Some hash | _ -> None)
(fun hash -> Activate_testnet hash) ;
]
let dictator_kind_case tag =
case ~tag dictator_kind_encoding
(function Dictator_operation op -> Some op | _ -> None)
(fun op -> Dictator_operation op)
let signed_operations_case tag =
case ~tag
(union [
manager_kind_case 0 ;
delegate_kind_case 1 ;
dictator_kind_case 2 ;
])
(function Sourced_operations ops -> Some ops | _ -> None)
(fun ops -> Sourced_operations ops)
let seed_nonce_revelation_encoding =
(obj3
(req "kind" (constant "seed_nonce_revelation"))
(req "level" Raw_level_repr.encoding)
(req "nonce" Seed_repr.nonce_encoding))
let seed_nonce_revelation_case tag =
case ~tag seed_nonce_revelation_encoding
(function
| Seed_nonce_revelation { level ; nonce } -> Some ((), level, nonce)
| _ -> None
)
(fun ((), level, nonce) -> Seed_nonce_revelation { level ; nonce })
let faucet_encoding =
(obj4
(req "kind" (constant "faucet"))
(req "id" Ed25519.Public_key_hash.encoding)
(req "counter" int32)
(req "nonce" (Fixed.bytes 16)))
let faucet_case tag =
case ~tag faucet_encoding
(function
| Faucet { id ; counter ; nonce } -> Some ((), id, counter, nonce)
| _ -> None
)
(fun ((), id, counter, nonce) -> Faucet { id ; counter ; nonce })
let unsigned_operation_case tag =
case ~tag
(obj1
(req "operations"
(list
(union [
seed_nonce_revelation_case 0 ;
faucet_case 1 ;
]))))
(function Anonymous_operations ops -> Some ops | _ -> None)
(fun ops -> Anonymous_operations ops)
let proto_operation_encoding =
union [
signed_operations_case 0 ;
unsigned_operation_case 1 ;
]
let unsigned_operation_encoding =
merge_objs
Updater.shell_operation_encoding
proto_operation_encoding
let signed_proto_operation_encoding =
merge_objs
proto_operation_encoding
(obj1 (varopt "signature" Ed25519.Signature.encoding))
end
type error += Cannot_parse_operation
let encoding =
let open Data_encoding in
conv
(fun { hash ; shell ; contents ; signature } ->
(hash, (shell, (contents, signature))))
(fun (hash, (shell, (contents, signature))) ->
{ hash ; shell ; contents ; signature })
(merge_objs
(obj1 (req "hash" Operation_hash.encoding))
(merge_objs
Updater.shell_operation_encoding
Encoding.signed_proto_operation_encoding))
let () =
register_error_kind
`Branch
~id:"operation.cannot_parse"
~title:"Cannot parse operation"
~description:"The operation is ill-formed \
or for another protocol version"
~pp:(fun ppf () ->
Format.fprintf ppf "The operation cannot be parsed")
Data_encoding.unit
(function Cannot_parse_operation -> Some () | _ -> None)
(fun () -> Cannot_parse_operation)
let parse hash (op: Updater.raw_operation) =
if not (Compare.Int.(MBytes.length op.proto <= Constants_repr.max_operation_data_length)) then
error Cannot_parse_operation
else
match Data_encoding.Binary.of_bytes
Encoding.signed_proto_operation_encoding
op.proto with
| Some (contents, signature) ->
let shell = { Updater.net_id = op.shell.net_id } in
ok { hash ; shell ; contents ; signature }
| None -> error Cannot_parse_operation
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 forge shell proto =
Data_encoding.Binary.to_bytes
Encoding.unsigned_operation_encoding (shell, proto)
let check_signature key { shell ; contents ; signature } =
match contents, signature with
| Anonymous_operations _, _ -> return ()
| Sourced_operations _, None ->
fail Missing_signature
| Sourced_operations _, Some signature ->
let unsigned_operation = forge shell contents in
if Ed25519.Signature.check key signature unsigned_operation then
return ()
else
fail Invalid_signature
let parse_proto bytes =
match Data_encoding.Binary.of_bytes
Encoding.signed_proto_operation_encoding
bytes with
| Some (proto, signature) -> return (proto, signature)
| None -> fail Cannot_parse_operation
include Encoding
let max_operation_data_length = Constants_repr.max_operation_data_length