balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: split Services/Services_registration and Client_proto_rpcs

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-11 19:17:40 +01:00
parent e4cde4c196
commit 7643fa9b15
29 changed files with 2024 additions and 1230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/proto_alpha/lib_client/client_baking_blocks.ml
View File

@ -23,7 +23,7 @@ type block_info = {
let convert_block_info cctxt let convert_block_info cctxt
( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol } ( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) = : Block_services.block_info ) =
Client_proto_rpcs.Context.level cctxt (`Hash hash) >>= function Alpha_services.Context.level cctxt (`Hash hash) >>= function
| Ok level -> | Ok level ->
Lwt.return Lwt.return
(Some { hash ; net_id ; predecessor ; (Some { hash ; net_id ; predecessor ;
@ -35,7 +35,7 @@ let convert_block_info cctxt
let convert_block_info_err cctxt let convert_block_info_err cctxt
( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol } ( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) = : Block_services.block_info ) =
Client_proto_rpcs.Context.level cctxt (`Hash hash) >>=? fun level -> Alpha_services.Context.level cctxt (`Hash hash) >>=? fun level ->
return { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol ; level } return { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol ; level }
let info cctxt ?include_ops block = let info cctxt ?include_ops block =
@ -71,8 +71,8 @@ let monitor cctxt
let blocks_from_cycle cctxt block cycle = let blocks_from_cycle cctxt block cycle =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
Client_proto_rpcs.Context.level cctxt block >>=? fun level -> Alpha_services.Context.level cctxt block >>=? fun level ->
Client_proto_rpcs.Helpers.levels cctxt block cycle >>=? fun (first, last) -> Alpha_services.Helpers.levels cctxt block cycle >>=? fun (first, last) ->
let length = Int32.to_int (Raw_level.diff level.level first) in let length = Int32.to_int (Raw_level.diff level.level first) in
Block_services.predecessors cctxt block length >>=? fun blocks -> Block_services.predecessors cctxt block length >>=? fun blocks ->
let blocks = let blocks =

8
src/proto_alpha/lib_client/client_baking_endorsement.ml
View File

@ -83,9 +83,9 @@ end = struct
end end
let get_signing_slots cctxt ?max_priority block delegate level = let get_signing_slots cctxt ?max_priority block delegate level =
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate cctxt Alpha_services.Delegate.Endorser.rights_for_delegate cctxt
?max_priority ~first_level:level ~last_level:level ?max_priority ~first_level:level ~last_level:level
block delegate () >>=? fun possibilities -> block delegate >>=? fun possibilities ->
let slots = let slots =
List.map (fun (_,slot) -> slot) List.map (fun (_,slot) -> slot)
@@ List.filter (fun (l, _) -> l = level) possibilities in @@ List.filter (fun (l, _) -> l = level) possibilities in
@ -96,7 +96,7 @@ let inject_endorsement (cctxt : #Proto_alpha.full_context)
src_sk source slot = src_sk source slot =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
Block_services.info cctxt block >>=? fun bi -> Block_services.info cctxt block >>=? fun bi ->
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt Alpha_services.Forge.Delegate.endorsement cctxt
block block
~branch:bi.hash ~branch:bi.hash
~source ~source
@ -128,7 +128,7 @@ let forge_endorsement (cctxt : #Proto_alpha.full_context)
~src_sk ?slot ?max_priority src_pk = ~src_sk ?slot ?max_priority src_pk =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
let src_pkh = Ed25519.Public_key.hash src_pk in let src_pkh = Ed25519.Public_key.hash src_pk in
Client_proto_rpcs.Context.next_level cctxt block >>=? fun { level } -> Alpha_services.Context.next_level cctxt block >>=? fun { level } ->
begin begin
match slot with match slot with
| Some slot -> return slot | Some slot -> return slot

28
src/proto_alpha/lib_client/client_baking_forge.ml
View File

@ -23,7 +23,7 @@ let generate_seed_nonce () =
let forge_block_header let forge_block_header
cctxt block delegate_sk shell priority seed_nonce_hash = cctxt block delegate_sk shell priority seed_nonce_hash =
Client_proto_rpcs.Constants.stamp_threshold Alpha_services.Constants.proof_of_work_threshold
cctxt block >>=? fun stamp_threshold -> cctxt block >>=? fun stamp_threshold ->
let rec loop () = let rec loop () =
let proof_of_work_nonce = generate_proof_of_work_nonce () in let proof_of_work_nonce = generate_proof_of_work_nonce () in
@ -133,22 +133,22 @@ let forge_block cctxt block
end >>=? fun operations -> end >>=? fun operations ->
begin begin
match priority with match priority with
| `Set prio -> begin | `Set priority -> begin
Client_proto_rpcs.Helpers.minimal_time Alpha_services.Helpers.minimal_time
cctxt block ~prio () >>=? fun time -> cctxt block ~priority >>=? fun time ->
return (prio, time) return (priority, time)
end end
| `Auto (src_pkh, max_priority, free_baking) -> | `Auto (src_pkh, max_priority, free_baking) ->
Client_proto_rpcs.Context.next_level cctxt block >>=? fun { level } -> Alpha_services.Context.next_level cctxt block >>=? fun { level } ->
Client_proto_rpcs.Helpers.Rights.baking_rights_for_delegate cctxt Alpha_services.Delegate.Baker.rights_for_delegate cctxt
?max_priority ?max_priority
~first_level:level ~first_level:level
~last_level:level ~last_level:level
block src_pkh () >>=? fun possibilities -> block src_pkh >>=? fun possibilities ->
try try
begin begin
if free_baking then if free_baking then
Client_proto_rpcs.Constants.first_free_baking_slot cctxt block Alpha_services.Constants.first_free_baking_slot cctxt block
else else
return 0 return 0
end >>=? fun min_prio -> end >>=? fun min_prio ->
@ -304,11 +304,11 @@ let get_baking_slot cctxt
let level = Raw_level.succ bi.level.level in let level = Raw_level.succ bi.level.level in
Lwt_list.filter_map_p Lwt_list.filter_map_p
(fun delegate -> (fun delegate ->
Client_proto_rpcs.Helpers.Rights.baking_rights_for_delegate cctxt Alpha_services.Delegate.Baker.rights_for_delegate cctxt
?max_priority ?max_priority
~first_level:level ~first_level:level
~last_level:level ~last_level:level
block delegate () >>= function block delegate >>= function
| Error errs -> | Error errs ->
log_error "Error while fetching baking possibilities:\n%a" log_error "Error while fetching baking possibilities:\n%a"
pp_print_error errs ; pp_print_error errs ;
@ -369,7 +369,7 @@ let compute_timeout { future_slots } =
Lwt_unix.sleep (Int64.to_float delay) Lwt_unix.sleep (Int64.to_float delay)
let get_unrevealed_nonces (cctxt : #Proto_alpha.full_context) ?(force = false) block = let get_unrevealed_nonces (cctxt : #Proto_alpha.full_context) ?(force = false) block =
Client_proto_rpcs.Context.next_level cctxt block >>=? fun level -> Alpha_services.Context.next_level cctxt block >>=? fun level ->
let cur_cycle = level.cycle in let cur_cycle = level.cycle in
match Cycle.pred cur_cycle with match Cycle.pred cur_cycle with
| None -> return [] | None -> return []
@ -380,12 +380,12 @@ let get_unrevealed_nonces (cctxt : #Proto_alpha.full_context) ?(force = false) b
Client_proto_nonces.find cctxt hash >>=? function Client_proto_nonces.find cctxt hash >>=? function
| None -> return None | None -> return None
| Some nonce -> | Some nonce ->
Client_proto_rpcs.Context.level Alpha_services.Context.level
cctxt (`Hash hash) >>=? fun level -> cctxt (`Hash hash) >>=? fun level ->
if force then if force then
return (Some (hash, (level.level, nonce))) return (Some (hash, (level.level, nonce)))
else else
Client_proto_rpcs.Context.Nonce.get Alpha_services.Nonce.get
cctxt block level.level >>=? function cctxt block level.level >>=? function
| Missing nonce_hash | Missing nonce_hash
when Nonce.check_hash nonce nonce_hash -> when Nonce.check_hash nonce nonce_hash ->

2
src/proto_alpha/lib_client/client_baking_lib.ml
View File

@ -19,7 +19,7 @@ let bake_block (cctxt : #Proto_alpha.full_context) block
return src_sk return src_sk
| Some sk -> return sk | Some sk -> return sk
end >>=? fun src_sk -> end >>=? fun src_sk ->
Client_proto_rpcs.Context.level cctxt block >>=? fun level -> Alpha_services.Context.level cctxt block >>=? fun level ->
let level = Raw_level.succ level.level in let level = Raw_level.succ level.level in
let seed_nonce = Client_baking_forge.generate_seed_nonce () in let seed_nonce = Client_baking_forge.generate_seed_nonce () in
let seed_nonce_hash = Nonce.hash seed_nonce in let seed_nonce_hash = Nonce.hash seed_nonce in

2
src/proto_alpha/lib_client/client_baking_operations.ml
View File

@ -24,7 +24,7 @@ let monitor cctxt ?contents ?check () =
match op with match op with
| None -> return { hash; content = None } | None -> return { hash; content = None }
| Some (op : Operation.raw) -> | Some (op : Operation.raw) ->
Client_proto_rpcs.Helpers.Parse.operations cctxt Alpha_services.Parse.operations cctxt
`Prevalidation ?check [op] >>=? function `Prevalidation ?check [op] >>=? function
| [proto] -> | [proto] ->
return { hash ; content = Some proto } return { hash ; content = Some proto }

2
src/proto_alpha/lib_client/client_baking_revelation.ml
View File

@ -17,7 +17,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
Seed_nonce_revelation { level ; nonce }) nonces in Seed_nonce_revelation { level ; nonce }) nonces in
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
Block_services.info rpc_config block >>=? fun bi -> Block_services.info rpc_config block >>=? fun bi ->
Client_proto_rpcs.Helpers.Forge.Anonymous.operations rpc_config Alpha_services.Forge.Anonymous.operations rpc_config
block ~branch:bi.hash operations >>=? fun bytes -> block ~branch:bi.hash operations >>=? fun bytes ->
Shell_services.inject_operation Shell_services.inject_operation
rpc_config ?async ~net_id:bi.net_id rpc_config ?async ~net_id:bi.net_id

39
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -14,10 +14,10 @@ open Client_proto_contracts
open Client_keys open Client_keys
let get_balance (rpc : #Proto_alpha.rpc_context) block contract = let get_balance (rpc : #Proto_alpha.rpc_context) block contract =
Client_proto_rpcs.Context.Contract.balance rpc block contract Alpha_services.Contract.balance rpc block contract
let get_storage (rpc : #Proto_alpha.rpc_context) block contract = let get_storage (rpc : #Proto_alpha.rpc_context) block contract =
Client_proto_rpcs.Context.Contract.storage rpc block contract Alpha_services.Contract.storage_opt rpc block contract
let rec find_predecessor rpc_config h n = let rec find_predecessor rpc_config h n =
if n <= 0 then if n <= 0 then
@ -54,10 +54,10 @@ let transfer rpc_config
return (Some arg) return (Some arg)
| None -> return None | None -> return None
end >>=? fun parameters -> end >>=? fun parameters ->
Client_proto_rpcs.Context.Contract.counter Alpha_services.Contract.counter
rpc_config block source >>=? fun pcounter -> rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Manager.transaction Alpha_services.Forge.Manager.transaction
rpc_config block rpc_config block
~branch ~source ~sourcePubKey:src_pk ~counter ~amount ~branch ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes -> ~destination ?parameters ~fee () >>=? fun bytes ->
@ -66,7 +66,7 @@ let transfer rpc_config
let signed_bytes = let signed_bytes =
MBytes.concat bytes (Ed25519.Signature.to_bytes signature) in MBytes.concat bytes (Ed25519.Signature.to_bytes signature) in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation rpc_config block Alpha_services.Helpers.apply_operation rpc_config block
predecessor oph bytes (Some signature) >>=? fun contracts -> predecessor oph bytes (Some signature) >>=? fun contracts ->
Shell_services.inject_operation Shell_services.inject_operation
rpc_config ~net_id signed_bytes >>=? fun injected_oph -> rpc_config ~net_id signed_bytes >>=? fun injected_oph ->
@ -80,7 +80,7 @@ let originate rpc_config ?net_id ~block ?signature bytes =
| Some signature -> Ed25519.Signature.concat bytes signature in | Some signature -> Ed25519.Signature.concat bytes signature in
Block_services.predecessor rpc_config block >>=? fun predecessor -> Block_services.predecessor rpc_config block >>=? fun predecessor ->
let oph = Operation_hash.hash_bytes [ signed_bytes ] in let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation rpc_config block Alpha_services.Helpers.apply_operation rpc_config block
predecessor oph bytes signature >>=? function predecessor oph bytes signature >>=? function
| [ contract ] -> | [ contract ] ->
Shell_services.inject_operation Shell_services.inject_operation
@ -106,10 +106,10 @@ let originate_account ?branch
~source ~src_pk ~src_sk ~manager_pkh ~source ~src_pk ~src_sk ~manager_pkh
?delegatable ?delegate ~balance ~fee block rpc_config () = ?delegatable ?delegate ~balance ~fee block rpc_config () =
get_branch rpc_config block branch >>=? fun (net_id, branch) -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Context.Contract.counter Alpha_services.Contract.counter
rpc_config block source >>=? fun pcounter -> rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block Alpha_services.Forge.Manager.origination rpc_config block
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ~spendable:true ~counter ~balance ~spendable:true
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes -> ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
@ -118,8 +118,9 @@ let originate_account ?branch
let faucet ?branch ~manager_pkh block rpc_config () = let faucet ?branch ~manager_pkh block rpc_config () =
get_branch rpc_config block branch >>=? fun (net_id, branch) -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Helpers.Forge.Anonymous.faucet let nonce = Rand.generate Constants_repr.nonce_length in
rpc_config block ~branch ~id:manager_pkh () >>=? fun bytes -> Alpha_services.Forge.Anonymous.faucet
rpc_config block ~branch ~id:manager_pkh ~nonce () >>=? fun bytes ->
originate rpc_config ~net_id ~block bytes originate rpc_config ~net_id ~block bytes
let delegate_contract rpc_config let delegate_contract rpc_config
@ -127,10 +128,10 @@ let delegate_contract rpc_config
~source ?src_pk ~manager_sk ~source ?src_pk ~manager_sk
~fee delegate_opt = ~fee delegate_opt =
get_branch rpc_config block branch >>=? fun (net_id, branch) -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Context.Contract.counter Alpha_services.Contract.counter
rpc_config block source >>=? fun pcounter -> rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Manager.delegation rpc_config block Alpha_services.Forge.Manager.delegation rpc_config block
~branch ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt ~branch ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
>>=? fun bytes -> >>=? fun bytes ->
Client_keys.sign manager_sk bytes >>=? fun signature -> Client_keys.sign manager_sk bytes >>=? fun signature ->
@ -141,8 +142,8 @@ let delegate_contract rpc_config
assert (Operation_hash.equal oph injected_oph) ; assert (Operation_hash.equal oph injected_oph) ;
return oph return oph
let list_contract_labels (cctxt : #Client_commands.full_context) block = let list_contract_labels (cctxt : #Proto_alpha.full_context) block =
Client_proto_rpcs.Context.Contract.list Alpha_services.Contract.list
cctxt block >>=? fun contracts -> cctxt block >>=? fun contracts ->
map_s (fun h -> map_s (fun h ->
begin match Contract.is_default h with begin match Contract.is_default h with
@ -167,10 +168,10 @@ let list_contract_labels (cctxt : #Client_commands.full_context) block =
return (nm, h_b58, kind)) return (nm, h_b58, kind))
contracts contracts
let message_added_contract (cctxt : #Client_commands.full_context) name = let message_added_contract (cctxt : #Proto_alpha.full_context) name =
cctxt#message "Contract memorized as %s." name cctxt#message "Contract memorized as %s." name
let get_manager (cctxt : #Client_commands.full_context) block source = let get_manager (cctxt : #Proto_alpha.full_context) block source =
Client_proto_contracts.get_manager Client_proto_contracts.get_manager
cctxt block source >>=? fun src_pkh -> cctxt block source >>=? fun src_pkh ->
Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) -> Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
@ -180,7 +181,7 @@ let dictate rpc_config block command seckey =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
Block_services.info Block_services.info
rpc_config block >>=? fun { net_id ; hash = branch } -> rpc_config block >>=? fun { net_id ; hash = branch } ->
Client_proto_rpcs.Helpers.Forge.Dictator.operation Alpha_services.Forge.Dictator.operation
rpc_config block ~branch command >>=? fun bytes -> rpc_config block ~branch command >>=? fun bytes ->
let signature = Ed25519.sign seckey bytes in let signature = Ed25519.sign seckey bytes in
let signed_bytes = Ed25519.Signature.concat bytes signature in let signed_bytes = Ed25519.Signature.concat bytes signature in
@ -221,11 +222,11 @@ let originate_contract
Lwt.return (Micheline_parser.no_parsing_error result) >>=? Lwt.return (Micheline_parser.no_parsing_error result) >>=?
fun { Michelson_v1_parser.expanded = storage } -> fun { Michelson_v1_parser.expanded = storage } ->
let block = cctxt#block in let block = cctxt#block in
Client_proto_rpcs.Context.Contract.counter Alpha_services.Contract.counter
cctxt block source >>=? fun pcounter -> cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
get_branch cctxt block None >>=? fun (_net_id, branch) -> get_branch cctxt block None >>=? fun (_net_id, branch) ->
Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block Alpha_services.Forge.Manager.origination cctxt block
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager
~counter ~balance ~spendable:spendable ~counter ~balance ~spendable:spendable
~delegatable ?delegatePubKey:delegate ~delegatable ?delegatePubKey:delegate

8
src/proto_alpha/lib_client/client_proto_contracts.ml
View File

@ -132,18 +132,18 @@ let list_contracts cctxt =
let get_manager cctxt block source = let get_manager cctxt block source =
match Contract.is_default source with match Contract.is_default source with
| Some hash -> return hash | Some hash -> return hash
| None -> Client_proto_rpcs.Context.Contract.manager cctxt block source | None -> Alpha_services.Contract.manager cctxt block source
let get_delegate cctxt block source = let get_delegate cctxt block source =
match Contract.is_default source with match Contract.is_default source with
| Some hash -> return hash | Some hash -> return hash
| None -> | None ->
Client_proto_rpcs.Context.Contract.delegate cctxt Alpha_services.Contract.delegate_opt cctxt
block source >>=? function block source >>=? function
| Some delegate -> | Some delegate ->
return delegate return delegate
| None -> | None ->
Client_proto_rpcs.Context.Contract.manager cctxt block source Alpha_services.Contract.manager cctxt block source
let may_check_key sourcePubKey sourcePubKeyHash = let may_check_key sourcePubKey sourcePubKeyHash =
match sourcePubKey with match sourcePubKey with
@ -156,7 +156,7 @@ let may_check_key sourcePubKey sourcePubKeyHash =
return () return ()
let check_public_key cctxt block ?src_pk src_pk_hash = let check_public_key cctxt block ?src_pk src_pk_hash =
Client_proto_rpcs.Context.Key.get cctxt block src_pk_hash >>= function Alpha_services.Delegate.Key.get cctxt block src_pk_hash >>= function
| Error errors -> | Error errors ->
begin begin
match src_pk with match src_pk with

10
src/proto_alpha/lib_client/client_proto_programs.ml
View File

@ -93,7 +93,7 @@ let run
~(input : Michelson_v1_parser.parsed) ~(input : Michelson_v1_parser.parsed)
block block
(cctxt : #RPC_context.simple) = (cctxt : #RPC_context.simple) =
Client_proto_rpcs.Helpers.run_code cctxt Alpha_services.Helpers.run_code cctxt
block program.expanded (storage.expanded, input.expanded, amount) block program.expanded (storage.expanded, input.expanded, amount)
let trace let trace
@ -103,11 +103,11 @@ let trace
~(input : Michelson_v1_parser.parsed) ~(input : Michelson_v1_parser.parsed)
block block
(cctxt : #RPC_context.simple) = (cctxt : #RPC_context.simple) =
Client_proto_rpcs.Helpers.trace_code cctxt Alpha_services.Helpers.trace_code cctxt
block program.expanded (storage.expanded, input.expanded, amount) block program.expanded (storage.expanded, input.expanded, amount)
let hash_and_sign (data : Michelson_v1_parser.parsed) (typ : Michelson_v1_parser.parsed) sk block cctxt = let hash_and_sign (data : Michelson_v1_parser.parsed) (typ : Michelson_v1_parser.parsed) sk block cctxt =
Client_proto_rpcs.Helpers.hash_data cctxt block (data.expanded, typ.expanded) >>=? fun hash -> Alpha_services.Helpers.hash_data cctxt block (data.expanded, typ.expanded) >>=? fun hash ->
Client_keys.sign sk (MBytes.of_string hash) >>=? fun signature -> Client_keys.sign sk (MBytes.of_string hash) >>=? fun signature ->
return (hash, return (hash,
signature |> signature |>
@ -119,10 +119,10 @@ let typecheck_data
~(data : Michelson_v1_parser.parsed) ~(data : Michelson_v1_parser.parsed)
~(ty : Michelson_v1_parser.parsed) ~(ty : Michelson_v1_parser.parsed)
block cctxt = block cctxt =
Client_proto_rpcs.Helpers.typecheck_data cctxt block (data.expanded, ty.expanded) Alpha_services.Helpers.typecheck_data cctxt block (data.expanded, ty.expanded)
let typecheck_program (program : Michelson_v1_parser.parsed) block cctxt = let typecheck_program (program : Michelson_v1_parser.parsed) block cctxt =
Client_proto_rpcs.Helpers.typecheck_code cctxt block program.expanded Alpha_services.Helpers.typecheck_code cctxt block program.expanded
let print_typecheck_result let print_typecheck_result
~emacs ~show_types ~print_source_on_error ~emacs ~show_types ~print_source_on_error

4
src/proto_alpha/lib_client/client_proto_programs_commands.ml
View File

@ -7,6 +7,8 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
open Proto_alpha
let group = let group =
{ Cli_entries.name = "programs" ; { Cli_entries.name = "programs" ;
title = "Commands for managing the library of known programs" } title = "Commands for managing the library of known programs" }
@ -153,7 +155,7 @@ let commands () =
data_parameter data_parameter
@@ stop) @@ stop)
(fun () data typ cctxt -> (fun () data typ cctxt ->
Client_proto_rpcs.Helpers.hash_data cctxt Alpha_services.Helpers.hash_data cctxt
cctxt#block (data.expanded, typ.expanded) >>= function cctxt#block (data.expanded, typ.expanded) >>= function
| Ok hash -> | Ok hash ->
cctxt#message "%S" hash >>= fun () -> cctxt#message "%S" hash >>= fun () ->

283
src/proto_alpha/lib_client/client_proto_rpcs.ml
View File

@ -1,283 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Proto_alpha
open Alpha_context
let make_call1 cctxt s=
RPC_context.make_call1 (s (Block_services.S.proto_path ())) cctxt
let make_call2 cctxt s =
RPC_context.make_call2 (s (Block_services.S.proto_path ())) cctxt
let make_call3 cctxt s =
RPC_context.make_call3 (s (Block_services.S.proto_path ())) cctxt
let make_opt_call2 cctxt s block a1 q i =
make_call2 cctxt s block a1 q i >>= function
| Ok v -> return (Some v)
| Error [RPC_context.Not_found _] -> return None
| Error _ as err -> Lwt.return err
type block = Block_services.block
let header cctxt block =
make_call1 cctxt Services.header block () ()
module Header = struct
let priority cctxt block =
make_call1 cctxt Services.Header.priority block () ()
let seed_nonce_hash cctxt block =
make_call1 cctxt Services.Header.seed_nonce_hash block () ()
end
module Constants = struct
let errors cctxt block =
make_call1 cctxt Services.Constants.errors block () ()
let cycle_length cctxt block =
make_call1 cctxt Services.Constants.cycle_length block () ()
let voting_period_length cctxt block =
make_call1 cctxt Services.Constants.voting_period_length block () ()
let time_before_reward cctxt block =
make_call1 cctxt Services.Constants.time_before_reward block () ()
let slot_durations cctxt block =
make_call1 cctxt Services.Constants.slot_durations block () ()
let first_free_baking_slot cctxt block =
make_call1 cctxt Services.Constants.first_free_baking_slot block () ()
let max_signing_slot cctxt block =
make_call1 cctxt Services.Constants.max_signing_slot block () ()
let instructions_per_transaction cctxt block =
make_call1 cctxt Services.Constants.max_gas block () ()
let stamp_threshold cctxt block =
make_call1 cctxt Services.Constants.proof_of_work_threshold block () ()
end
module Context = struct
let level cctxt block =
make_call1 cctxt Services.Context.level block () ()
let next_level cctxt block =
make_call1 cctxt Services.Context.next_level block () ()
let voting_period_kind cctxt block =
make_call1 cctxt Services.Context.voting_period_kind block () ()
module Nonce = struct
type nonce_info = Services.Context.Nonce.nonce_info =
| Revealed of Nonce.t
| Missing of Nonce_hash.t
| Forgotten
let get cctxt block level =
make_call2 cctxt Services.Context.Nonce.get block level () ()
let hash cctxt block =
make_call1 cctxt Services.Context.Nonce.hash block () ()
end
module Key = struct
let get cctxt block pk_h =
make_call2 cctxt Services.Context.Key.get block pk_h () ()
let list cctxt block =
make_call1 cctxt Services.Context.Key.list block () ()
end
module Contract = struct
let list cctxt b =
make_call1 cctxt Services.Context.Contract.list b () ()
type info = Services.Context.Contract.info = {
manager: public_key_hash ;
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
script: Script.t option ;
counter: int32 ;
}
let get cctxt b c =
make_call2 cctxt Services.Context.Contract.get b c () ()
let balance cctxt b c =
make_call2 cctxt Services.Context.Contract.balance b c () ()
let manager cctxt b c =
make_call2 cctxt Services.Context.Contract.manager b c () ()
let delegate cctxt b c =
make_opt_call2 cctxt Services.Context.Contract.delegate b c () ()
let counter cctxt b c =
make_call2 cctxt Services.Context.Contract.counter b c () ()
let spendable cctxt b c =
make_call2 cctxt Services.Context.Contract.spendable b c () ()
let delegatable cctxt b c =
make_call2 cctxt Services.Context.Contract.delegatable b c () ()
let script cctxt b c =
make_opt_call2 cctxt Services.Context.Contract.script b c () ()
let storage cctxt b c =
make_opt_call2 cctxt Services.Context.Contract.storage b c () ()
end
end
module Helpers = struct
let minimal_time cctxt block ?prio () =
make_call1 cctxt Services.Helpers.minimal_timestamp block () prio
let typecheck_code cctxt block =
make_call1 cctxt Services.Helpers.typecheck_code block ()
let apply_operation cctxt block pred_block hash forged_operation signature =
make_call1 cctxt Services.Helpers.apply_operation
block () (pred_block, hash, forged_operation, signature)
let run_code cctxt block code (storage, input, amount) =
make_call1 cctxt Services.Helpers.run_code
block () (code, storage, input, amount, None, None)
let trace_code cctxt block code (storage, input, amount) =
make_call1 cctxt Services.Helpers.trace_code
block () (code, storage, input, amount, None, None)
let typecheck_data cctxt block =
make_call1 cctxt Services.Helpers.typecheck_data block ()
let hash_data cctxt block =
make_call1 cctxt Services.Helpers.hash_data block ()
let level cctxt block ?offset lvl =
make_call2 cctxt Services.Helpers.level block lvl () offset
let levels cctxt block cycle =
make_call2 cctxt Services.Helpers.levels block cycle () ()
module Rights = struct
type baking_slot = Raw_level.t * int * Time.t
type endorsement_slot = Raw_level.t * int
let baking_rights_for_delegate cctxt
b c ?max_priority ?first_level ?last_level () =
make_call2 cctxt Services.Helpers.Rights.baking_rights_for_delegate
b c () (max_priority, first_level, last_level)
let endorsement_rights_for_delegate cctxt
b c ?max_priority ?first_level ?last_level () =
make_call2 cctxt Services.Helpers.Rights.endorsement_rights_for_delegate
b c () (max_priority, first_level, last_level)
end
module Forge = struct
module Manager = struct
let operations cctxt
block ~branch ~source ?sourcePubKey ~counter ~fee operations =
let ops =
Manager_operations { source ; public_key = sourcePubKey ;
counter ; operations ; fee } in
(make_call1 cctxt Services.Helpers.Forge.operations block
() ({ branch }, Sourced_operations ops))
let transaction cctxt
block ~branch ~source ?sourcePubKey ~counter
~amount ~destination ?parameters ~fee ()=
operations cctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[Transaction { amount ; parameters ; destination }]
let origination cctxt
block ~branch
~source ?sourcePubKey ~counter
~managerPubKey ~balance
?(spendable = true)
?(delegatable = true)
?delegatePubKey ?script ~fee () =
operations cctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[
Origination { manager = managerPubKey ;
delegate = delegatePubKey ;
script ;
spendable ;
delegatable ;
credit = balance }
]
let delegation cctxt
block ~branch ~source ?sourcePubKey ~counter ~fee delegate =
operations cctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[Delegation delegate]
end
module Delegate = struct
let operations cctxt
block ~branch ~source operations =
let ops = Delegate_operations { source ; operations } in
(make_call1 cctxt Services.Helpers.Forge.operations block
() ({ branch }, Sourced_operations ops))
let endorsement cctxt
b ~branch ~source ~block ~slot () =
operations cctxt b ~branch ~source
Alpha_context.[Endorsement { block ; slot }]
let proposals cctxt
b ~branch ~source ~period ~proposals () =
operations cctxt b ~branch ~source
Alpha_context.[Proposals { period ; proposals }]
let ballot cctxt
b ~branch ~source ~period ~proposal ~ballot () =
operations cctxt b ~branch ~source
Alpha_context.[Ballot { period ; proposal ; ballot }]
end
module Dictator = struct
let operation cctxt
block ~branch operation =
let op = Dictator_operation operation in
(make_call1 cctxt Services.Helpers.Forge.operations block
() ({ branch }, Sourced_operations op))
let activate cctxt
b ~branch hash =
operation cctxt b ~branch (Activate hash)
let activate_testnet cctxt
b ~branch hash =
operation cctxt b ~branch (Activate_testnet hash)
end
module Anonymous = struct
let operations cctxt block ~branch operations =
(make_call1 cctxt Services.Helpers.Forge.operations block
() ({ branch }, Anonymous_operations operations))
let seed_nonce_revelation cctxt
block ~branch ~level ~nonce () =
operations cctxt block ~branch [Seed_nonce_revelation { level ; nonce }]
let faucet cctxt
block ~branch ~id () =
let nonce = Rand.generate 16 in
operations cctxt block ~branch [Faucet { id ; nonce }]
end
let empty_proof_of_work_nonce =
MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000')
let block_proto_header cctxt
block
~priority ~seed_nonce_hash
?(proof_of_work_nonce = empty_proof_of_work_nonce) () =
make_call1 cctxt Services.Helpers.Forge.block_proto_header
block () (priority, seed_nonce_hash, proof_of_work_nonce)
end
module Parse = struct
let operations cctxt block ?check operations =
make_call1 cctxt
Services.Helpers.Parse.operations block () (operations, check)
let block cctxt block shell proto =
make_call1 cctxt
Services.Helpers.Parse.block block
() ({ shell ; proto } : Block_header.raw)
end
end
(* type slot = *)
(* raw_level * int * timestamp option *)
(* let baking_possibilities *)
(* b c ?max_priority ?first_level ?last_level () = *)
(* make_call2 Services.Helpers.Context.Contract.baking_possibilities *)
(* b c (max_priority, first_level, last_level) *)
(* (\* let endorsement_possibilities b c ?max_priority ?first_level ?last_level () = *\) *)
(* make_call2 Services.Helpers.Context.Contract.endorsement_possibilities *)
(* b c (max_priority, first_level, last_level) *)

346
src/proto_alpha/lib_client/client_proto_rpcs.mli
View File

@ -1,346 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Proto_alpha
open Alpha_context
type block = Block_services.block
val header:
#RPC_context.simple -> block -> Block_header.t tzresult Lwt.t
module Header : sig
val priority:
#RPC_context.simple -> block -> int tzresult Lwt.t
val seed_nonce_hash:
#RPC_context.simple -> block -> Nonce_hash.t tzresult Lwt.t
end
module Constants : sig
val errors:
#RPC_context.simple ->
block -> Json_schema.schema tzresult Lwt.t
val cycle_length:
#RPC_context.simple ->
block -> int32 tzresult Lwt.t
val voting_period_length:
#RPC_context.simple ->
block -> int32 tzresult Lwt.t
val time_before_reward:
#RPC_context.simple ->
block -> Period.t tzresult Lwt.t
val slot_durations:
#RPC_context.simple ->
block -> (Period.t list) tzresult Lwt.t
val first_free_baking_slot:
#RPC_context.simple ->
block -> int tzresult Lwt.t
val max_signing_slot:
#RPC_context.simple ->
block -> int tzresult Lwt.t
val instructions_per_transaction:
#RPC_context.simple ->
block -> int tzresult Lwt.t
val stamp_threshold:
#RPC_context.simple ->
block -> int64 tzresult Lwt.t
end
module Context : sig
val level:
#RPC_context.simple ->
block -> Level.t tzresult Lwt.t
(** [level cctxt blk] returns the (protocol view of the) level of
[blk]. *)
val next_level:
#RPC_context.simple ->
block -> Level.t tzresult Lwt.t
(** [next_level cctxt blk] returns the (protocol view of the) level
of the successor of [blk]. *)
val voting_period_kind:
#RPC_context.simple ->
block -> Voting_period.kind tzresult Lwt.t
(** [voting_period_kind cctxt blk] returns the voting period kind
of [blk]. *)
module Nonce : sig
val hash:
#RPC_context.simple ->
block -> Nonce_hash.t tzresult Lwt.t
type nonce_info =
| Revealed of Nonce.t
| Missing of Nonce_hash.t
| Forgotten
val get:
#RPC_context.simple ->
block -> Raw_level.t -> nonce_info tzresult Lwt.t
end
module Key : sig
val get :
#RPC_context.simple ->
block ->
public_key_hash -> (public_key_hash * public_key) tzresult Lwt.t
val list :
#RPC_context.simple ->
block ->
((public_key_hash * public_key) list) tzresult Lwt.t
end
module Contract : sig
val list:
#RPC_context.simple ->
block -> Contract.t list tzresult Lwt.t
type info = {
manager: public_key_hash ;
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
script: Script.t option ;
counter: int32 ;
}
val get:
#RPC_context.simple ->
block -> Contract.t -> info tzresult Lwt.t
val balance:
#RPC_context.simple ->
block -> Contract.t ->
Tez.t tzresult Lwt.t
val manager:
#RPC_context.simple ->
block -> Contract.t ->
public_key_hash tzresult Lwt.t
val delegate:
#RPC_context.simple ->
block -> Contract.t ->
public_key_hash option tzresult Lwt.t
val counter:
#RPC_context.simple ->
block -> Contract.t ->
int32 tzresult Lwt.t
val spendable:
#RPC_context.simple ->
block -> Contract.t ->
bool tzresult Lwt.t
val delegatable:
#RPC_context.simple ->
block -> Contract.t ->
bool tzresult Lwt.t
val script:
#RPC_context.simple ->
block -> Contract.t -> Script.t option tzresult Lwt.t
val storage:
#RPC_context.simple ->
block -> Contract.t -> Script.expr option tzresult Lwt.t
end
end
module Helpers : sig
val minimal_time:
#RPC_context.simple ->
block -> ?prio:int -> unit -> Time.t tzresult Lwt.t
(** [minimal_time cctxt blk ?prio ()] is the minimal acceptable
timestamp for the successor of [blk]. [?prio] defaults to
[0]. *)
val apply_operation:
#RPC_context.simple ->
block -> Block_hash.t -> Operation_hash.t -> MBytes.t -> Ed25519.Signature.t option ->
(Contract.t list) tzresult Lwt.t
val run_code:
#RPC_context.simple ->
block -> Script.expr ->
(Script.expr * Script.expr * Tez.t) ->
(Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t
val trace_code:
#RPC_context.simple ->
block -> Script.expr ->
(Script.expr * Script.expr * Tez.t) ->
(Script.expr * Script.expr *
(Script.location * Gas.t * Script.expr list) list *
(Script.expr * Script.expr option) list option) tzresult Lwt.t
val typecheck_code:
#RPC_context.simple ->
block -> Script.expr -> Script_tc_errors.type_map tzresult Lwt.t
val typecheck_data:
#RPC_context.simple ->
block -> Script.expr * Script.expr -> unit tzresult Lwt.t
val hash_data:
#RPC_context.simple ->
block -> Script.expr * Script.expr -> string tzresult Lwt.t
val level:
#RPC_context.simple ->
block -> ?offset:int32 -> Raw_level.t -> Level.t tzresult Lwt.t
val levels:
#RPC_context.simple ->
block -> Cycle.t -> (Raw_level.t * Raw_level.t) tzresult Lwt.t
module Rights : sig
type baking_slot = Raw_level.t * int * Time.t
type endorsement_slot = Raw_level.t * int
val baking_rights_for_delegate:
#RPC_context.simple ->
block -> public_key_hash ->
?max_priority:int -> ?first_level:Raw_level.t ->
?last_level:Raw_level.t -> unit ->
(baking_slot list) tzresult Lwt.t
val endorsement_rights_for_delegate:
#RPC_context.simple ->
block -> public_key_hash ->
?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> unit ->
(endorsement_slot list) tzresult Lwt.t
end
module Forge : sig
module Manager : sig
val operations:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
fee:Tez.t ->
manager_operation list ->
MBytes.t tzresult Lwt.t
val transaction:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
amount:Tez.t ->
destination:Contract.t ->
?parameters:Script.expr ->
fee:Tez.t ->
unit -> MBytes.t tzresult Lwt.t
val origination:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
managerPubKey:public_key_hash ->
balance:Tez.t ->
?spendable:bool ->
?delegatable:bool ->
?delegatePubKey: public_key_hash ->
?script:Script.t ->
fee:Tez.t->
unit ->
MBytes.t tzresult Lwt.t
val delegation:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
fee:Tez.t ->
public_key_hash option ->
MBytes.t tzresult Lwt.t
end
module Dictator : sig
val operation:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
dictator_operation ->
MBytes.t tzresult Lwt.t
val activate:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
Protocol_hash.t ->
MBytes.t tzresult Lwt.t
val activate_testnet:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
Protocol_hash.t ->
MBytes.t tzresult Lwt.t
end
module Delegate : sig
val operations:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:public_key ->
delegate_operation list ->
MBytes.t tzresult Lwt.t
val endorsement:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:public_key ->
block:Block_hash.t ->
slot:int ->
unit -> MBytes.t tzresult Lwt.t
val proposals:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:public_key ->
period:Voting_period.t ->
proposals:Protocol_hash.t list ->
unit -> MBytes.t tzresult Lwt.t
val ballot:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
source:public_key ->
period:Voting_period.t ->
proposal:Protocol_hash.t ->
ballot:Vote.ballot ->
unit -> MBytes.t tzresult Lwt.t
end
module Anonymous : sig
val operations:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
anonymous_operation list ->
MBytes.t tzresult Lwt.t
val seed_nonce_revelation:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
level:Raw_level.t ->
nonce:Nonce.t ->
unit -> MBytes.t tzresult Lwt.t
val faucet:
#RPC_context.simple ->
block ->
branch:Block_hash.t ->
id:public_key_hash ->
unit -> MBytes.t tzresult Lwt.t
end
val block_proto_header:
#RPC_context.simple ->
block ->
priority: int ->
seed_nonce_hash: Nonce_hash.t ->
?proof_of_work_nonce: MBytes.t ->
unit -> MBytes.t tzresult Lwt.t
end
module Parse : sig
val operations:
#RPC_context.simple ->
block -> ?check:bool -> Operation.raw list ->
Operation.t list tzresult Lwt.t
val block:
#RPC_context.simple ->
block -> Block_header.shell_header -> MBytes.t ->
Block_header.proto_header tzresult Lwt.t
end
end

45
src/proto_alpha/lib_client/test/proto_alpha_helpers.ml
View File

@ -28,7 +28,7 @@ let build_rpc_context config =
let rpc_ctxt = ref (build_rpc_context !rpc_config) let rpc_ctxt = ref (build_rpc_context !rpc_config)
(* Context that does not write to alias files *) (* Context that does not write to alias files *)
let no_write_context config block : Client_commands.full_context = object let no_write_context config block : #Client_commands.full_context = object
inherit RPC_client.http_ctxt config Media_type.all_media_types inherit RPC_client.http_ctxt config Media_type.all_media_types
inherit Client_commands.logger (fun _ _ -> Lwt.return_unit) inherit Client_commands.logger (fun _ _ -> Lwt.return_unit)
method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t = method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t =
@ -69,7 +69,7 @@ let init ?exe ?(sandbox = "sandbox.json") ?rpc_port () =
return (pid, hash) return (pid, hash)
let level block = let level block =
Client_proto_rpcs.Context.level !rpc_ctxt block Alpha_services.Context.level !rpc_ctxt block
module Account = struct module Account = struct
@ -225,13 +225,12 @@ module Account = struct
delegate_opt delegate_opt
let balance ?(block = `Prevalidation) (account : t) = let balance ?(block = `Prevalidation) (account : t) =
Client_proto_rpcs.Context.Contract.balance !rpc_ctxt Alpha_services.Contract.balance !rpc_ctxt
block account.contract block account.contract
(* TODO: gather contract related functions in a Contract module? *) (* TODO: gather contract related functions in a Contract module? *)
let delegate ?(block = `Prevalidation) (contract : Contract.t) = let delegate ?(block = `Prevalidation) (contract : Contract.t) =
Client_proto_rpcs.Context.Contract.delegate !rpc_ctxt Alpha_services.Contract.delegate_opt !rpc_ctxt block contract
block contract
end end
@ -240,12 +239,12 @@ module Protocol = struct
open Account open Account
let voting_period_kind ?(block = `Prevalidation) () = let voting_period_kind ?(block = `Prevalidation) () =
Client_proto_rpcs.Context.voting_period_kind !rpc_ctxt block Alpha_services.Context.voting_period_kind !rpc_ctxt block
let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals = let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals =
Block_services.info !rpc_ctxt block >>=? fun block_info -> Block_services.info !rpc_ctxt block >>=? fun block_info ->
Client_proto_rpcs.Context.next_level !rpc_ctxt block >>=? fun next_level -> Alpha_services.Context.next_level !rpc_ctxt block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.proposals !rpc_ctxt block Alpha_services.Forge.Delegate.proposals !rpc_ctxt block
~branch:block_info.hash ~branch:block_info.hash
~source:pk ~source:pk
~period:next_level.voting_period ~period:next_level.voting_period
@ -256,8 +255,8 @@ module Protocol = struct
let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot = let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot =
Block_services.info !rpc_ctxt block >>=? fun block_info -> Block_services.info !rpc_ctxt block >>=? fun block_info ->
Client_proto_rpcs.Context.next_level !rpc_ctxt block >>=? fun next_level -> Alpha_services.Context.next_level !rpc_ctxt block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.ballot !rpc_ctxt block Alpha_services.Forge.Delegate.ballot !rpc_ctxt block
~branch:block_info.hash ~branch:block_info.hash
~source:pk ~source:pk
~period:next_level.voting_period ~period:next_level.voting_period
@ -412,7 +411,7 @@ module Assert = struct
block_proto h block_proto h
let check_voting_period_kind ?msg ~block kind = let check_voting_period_kind ?msg ~block kind =
Client_proto_rpcs.Context.voting_period_kind !rpc_ctxt block Alpha_services.Context.voting_period_kind !rpc_ctxt block
>>=? fun current_kind -> >>=? fun current_kind ->
return @@ equal return @@ equal
?msg ?msg
@ -450,7 +449,7 @@ module Baking = struct
() ()
let endorsement_reward block = let endorsement_reward block =
Client_proto_rpcs.Header.priority !rpc_ctxt block >>=? fun prio -> Alpha_services.priority !rpc_ctxt block >>=? fun prio ->
Baking.endorsement_reward ~block_priority:prio >|= Baking.endorsement_reward ~block_priority:prio >|=
Alpha_environment.wrap_error >>|? Alpha_environment.wrap_error >>|?
Tez.to_mutez Tez.to_mutez
@ -466,7 +465,7 @@ module Endorse = struct
slot = slot =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
Block_services.info !rpc_ctxt block >>=? fun { hash ; _ } -> Block_services.info !rpc_ctxt block >>=? fun { hash ; _ } ->
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement !rpc_ctxt Alpha_services.Forge.Delegate.endorsement !rpc_ctxt
block block
~branch:hash ~branch:hash
~source ~source
@ -481,9 +480,9 @@ module Endorse = struct
block block
delegate delegate
level = level =
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate Alpha_services.Delegate.Endorser.rights_for_delegate
!rpc_ctxt ~max_priority ~first_level:level ~last_level:level !rpc_ctxt ~max_priority ~first_level:level ~last_level:level
block delegate () >>=? fun possibilities -> block delegate >>=? fun possibilities ->
let slots = let slots =
List.map (fun (_,slot) -> slot) List.map (fun (_,slot) -> slot)
@@ List.filter (fun (l, _) -> l = level) possibilities in @@ List.filter (fun (l, _) -> l = level) possibilities in
@ -493,7 +492,7 @@ module Endorse = struct
?slot ?slot
(contract : Account.t) (contract : Account.t)
block = block =
Client_proto_rpcs.Context.next_level !rpc_ctxt block >>=? fun { level } -> Alpha_services.Context.next_level !rpc_ctxt block >>=? fun { level } ->
begin begin
match slot with match slot with
| Some slot -> return slot | Some slot -> return slot
@ -511,16 +510,16 @@ module Endorse = struct
(* FIXME @vb: I don't understand this function, copied from @cago. *) (* FIXME @vb: I don't understand this function, copied from @cago. *)
let endorsers_list block = let endorsers_list block =
let get_endorser_list result (account : Account.t) level block = let get_endorser_list result (account : Account.t) level block =
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate Alpha_services.Delegate.Endorser.rights_for_delegate
!rpc_ctxt block account.pkh !rpc_ctxt block account.pkh
~max_priority:16 ~max_priority:16
~first_level:level ~first_level:level
~last_level:level () >>|? fun slots -> ~last_level:level >>|? fun slots ->
List.iter (fun (_,slot) -> result.(slot) <- account) slots List.iter (fun (_,slot) -> result.(slot) <- account) slots
in in
let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in
let result = Array.make 16 b1 in let result = Array.make 16 b1 in
Client_proto_rpcs.Context.level !rpc_ctxt block >>=? fun level -> Alpha_services.Context.level !rpc_ctxt block >>=? fun level ->
let level = Raw_level.succ @@ level.level in let level = Raw_level.succ @@ level.level in
get_endorser_list result b1 level block >>=? fun () -> get_endorser_list result b1 level block >>=? fun () ->
get_endorser_list result b2 level block >>=? fun () -> get_endorser_list result b2 level block >>=? fun () ->
@ -532,19 +531,19 @@ module Endorse = struct
let endorsement_rights let endorsement_rights
?(max_priority = 1024) ?(max_priority = 1024)
(contract : Account.t) block = (contract : Account.t) block =
Client_proto_rpcs.Context.level !rpc_ctxt block >>=? fun level -> Alpha_services.Context.level !rpc_ctxt block >>=? fun level ->
let delegate = contract.pkh in let delegate = contract.pkh in
let level = level.level in let level = level.level in
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate Alpha_services.Delegate.Endorser.rights_for_delegate
!rpc_ctxt !rpc_ctxt
~max_priority ~max_priority
~first_level:level ~first_level:level
~last_level:level ~last_level:level
block delegate () block delegate
end end
let display_level block = let display_level block =
Client_proto_rpcs.Context.level !rpc_ctxt block >>=? fun lvl -> Alpha_services.Context.level !rpc_ctxt block >>=? fun lvl ->
Format.eprintf "Level: %a@." Level.pp_full lvl ; Format.eprintf "Level: %a@." Level.pp_full lvl ;
return () return ()

2
src/proto_alpha/lib_client/test/proto_alpha_helpers.mli
View File

@ -123,7 +123,7 @@ module Endorse : sig
?max_priority:int -> ?max_priority:int ->
Account.t -> Account.t ->
Block_services.block -> Block_services.block ->
Client_proto_rpcs.Helpers.Rights.endorsement_slot list tzresult Lwt.t (Raw_level.t * int) list tzresult Lwt.t
end end

6
src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
View File

@ -59,8 +59,12 @@
"Amendment", "Amendment",
"Apply", "Apply",
"Services",
"Services_registration", "Services_registration",
"Constants_services",
"Contract_services",
"Delegate_services",
"Helpers_services",
"Alpha_services",
"Main" "Main"
] ]

249
src/proto_alpha/lib_protocol/src/alpha_services.ml Normal file
View File

@ -0,0 +1,249 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
let custom_root = RPC_path.open_root
module S = struct
open Data_encoding
let operations =
RPC_service.post_service
~description: "All the operations of the block (fully decoded)."
~query: RPC_query.empty
~input: empty
~output: (list (list (dynamic_size Operation.encoding)))
RPC_path.(custom_root / "operations")
let header =
RPC_service.post_service
~description: "The header of the block (fully decoded)."
~query: RPC_query.empty
~input: empty
~output: Block_header.encoding
RPC_path.(custom_root / "header")
let priority =
RPC_service.post_service
~description: "Baking priority of the block."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "priority" uint16))
RPC_path.(custom_root / "header" / "priority")
let seed_nonce_hash =
RPC_service.post_service
~description: "Hash of the seed nonce of the block."
~query: RPC_query.empty
~input: empty
~output: Nonce_hash.encoding
RPC_path.(custom_root / "header" / "seed_nonce_hash")
end
let () =
let open Services_registration in
register0_fullctxt S.operations begin fun ctxt () () ->
ctxt.operation_hashes () >>= fun operation_hashes ->
ctxt.operations () >>= fun operations ->
map2_s
(map2_s (fun x y -> Lwt.return (Operation.parse x y)))
operation_hashes operations
end ;
register0_fullctxt S.header begin fun { block_header ; _ } () () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header
end ;
register0_fullctxt S.priority begin fun { block_header ; _ } () () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.priority
end ;
register0_fullctxt S.seed_nonce_hash begin fun { block_header ; _ } () ( )->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.seed_nonce_hash
end
let operations ctxt block =
RPC_context.make_call0 S.operations ctxt block () ()
let header ctxt block =
RPC_context.make_call0 S.header ctxt block () ()
let priority ctxt block =
RPC_context.make_call0 S.priority ctxt block () ()
let seed_nonce_hash ctxt block =
RPC_context.make_call0 S.seed_nonce_hash ctxt block () ()
module Context = struct
module S = struct
open Data_encoding
let level =
RPC_service.post_service
~description: "Detailled level information for the current block"
~query: RPC_query.empty
~input: empty
~output: Level.encoding
RPC_path.(custom_root / "context" / "level")
let next_level =
RPC_service.post_service
~description: "Detailled level information for the next block"
~query: RPC_query.empty
~input: empty
~output: Level.encoding
RPC_path.(custom_root / "context" / "next_level")
let roll_value =
RPC_service.post_service
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "roll_value" Tez.encoding))
RPC_path.(custom_root / "context" / "roll_value")
let next_roll =
RPC_service.post_service
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "next_roll" int32))
RPC_path.(custom_root / "context" / "next_roll")
let voting_period_kind =
RPC_service.post_service
~description: "Voting period kind for the current block"
~query: RPC_query.empty
~input: empty
~output:
(obj1 (req "voting_period_kind" Voting_period.kind_encoding))
RPC_path.(custom_root / "context" / "voting_period_kind")
end
type error += Unexpected_level_in_context
let () =
let open Services_registration in
register0 S.level begin fun ctxt () () ->
let level = Level.current ctxt in
match Level.pred ctxt level with
| None -> fail Unexpected_level_in_context
| Some level -> return level
end ;
register0 S.next_level begin fun ctxt () () ->
return (Level.current ctxt)
end ;
register0 S.roll_value begin fun ctxt () () ->
return (Roll.value ctxt)
end;
register0 S.next_roll begin fun ctxt () () ->
Roll.next ctxt
end ;
register0 S.voting_period_kind begin fun ctxt () () ->
Vote.get_current_period_kind ctxt
end
let level ctxt block =
RPC_context.make_call0 S.level ctxt block () ()
let next_level ctxt block =
RPC_context.make_call0 S.next_level ctxt block () ()
let roll_value ctxt block =
RPC_context.make_call0 S.roll_value ctxt block () ()
let next_roll ctxt block =
RPC_context.make_call0 S.next_roll ctxt block () ()
let voting_period_kind ctxt block =
RPC_context.make_call0 S.voting_period_kind ctxt block () ()
end
module Nonce = struct
type info =
| Revealed of Nonce.t
| Missing of Nonce_hash.t
| Forgotten
let info_encoding =
let open Data_encoding in
union [
case (Tag 0)
(obj1 (req "nonce" Nonce.encoding))
(function Revealed nonce -> Some nonce | _ -> None)
(fun nonce -> Revealed nonce) ;
case (Tag 1)
(obj1 (req "hash" Nonce_hash.encoding))
(function Missing nonce -> Some nonce | _ -> None)
(fun nonce -> Missing nonce) ;
case (Tag 2)
empty
(function Forgotten -> Some () | _ -> None)
(fun () -> Forgotten) ;
]
module S = struct
open Data_encoding
let get =
RPC_service.post_service
~description: "Info about the nonce of a previous block."
~query: RPC_query.empty
~input: empty
~output: info_encoding
RPC_path.(custom_root / "context" / "nonce" /: Raw_level.arg)
let hash =
RPC_service.post_service
~description: "Hash of the current block's nonce."
~query: RPC_query.empty
~input: empty
~output: Nonce_hash.encoding
RPC_path.(custom_root / "context" / "nonce")
end
let () =
let open Services_registration in
register1 S.get begin fun ctxt raw_level () () ->
let level = Level.from_raw ctxt raw_level in
Nonce.get ctxt level >>= function
| Ok (Revealed nonce) -> return (Revealed nonce)
| Ok (Unrevealed { nonce_hash ; _ }) ->
return (Missing nonce_hash)
| Error _ -> return Forgotten
end ;
register0 S.hash begin fun ctxt () () ->
let level = Level.current ctxt in
match Level.pred ctxt level with
| None -> fail Context.Unexpected_level_in_context
| Some level ->
Nonce.get ctxt level >>=? function
| Unrevealed { nonce_hash ; _ } -> return nonce_hash
| _ -> assert false
end
let get ctxt block level =
RPC_context.make_call1 S.get ctxt block level () ()
let hash ctxt block =
RPC_context.make_call0 S.hash ctxt block () ()
end
module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse

68
src/proto_alpha/lib_protocol/src/alpha_services.mli Normal file
View File

@ -0,0 +1,68 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
val operations:
'a #RPC_context.simple -> 'a -> Operation.t list list shell_tzresult Lwt.t
val header:
'a #RPC_context.simple -> 'a -> Block_header.t shell_tzresult Lwt.t
val priority:
'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t
val seed_nonce_hash:
'a #RPC_context.simple -> 'a -> Nonce_hash.t shell_tzresult Lwt.t
module Context : sig
val level:
'a #RPC_context.simple -> 'a -> Level.t shell_tzresult Lwt.t
(** [level cctxt blk] returns the (protocol view of the) level of
[blk]. *)
val next_level:
'a #RPC_context.simple -> 'a -> Level.t shell_tzresult Lwt.t
(** [next_level cctxt blk] returns the (protocol view of the) level
of the successor of [blk]. *)
val next_roll:
'a #RPC_context.simple -> 'a -> int32 shell_tzresult Lwt.t
val roll_value:
'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t
val voting_period_kind:
'a #RPC_context.simple -> 'a -> Voting_period.kind shell_tzresult Lwt.t
(** [voting_period_kind cctxt blk] returns the voting period kind
of [blk]. *)
end
module Nonce : sig
val hash:
'a #RPC_context.simple ->
'a -> Nonce_hash.t shell_tzresult Lwt.t
type info =
| Revealed of Nonce.t
| Missing of Nonce_hash.t
| Forgotten
val get:
'a #RPC_context.simple ->
'a -> Raw_level.t -> info shell_tzresult Lwt.t
end
module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse

141
src/proto_alpha/lib_protocol/src/constants_services.ml Normal file
View File

@ -0,0 +1,141 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
let custom_root =
(RPC_path.(open_root / "constants") : RPC_context.t RPC_path.context)
module S = struct
open Data_encoding
let cycle_length =
RPC_service.post_service
~description: "Cycle length"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "cycle_length" int32))
RPC_path.(custom_root / "cycle_length")
let voting_period_length =
RPC_service.post_service
~description: "Length of the voting period"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "voting_period_length" int32))
RPC_path.(custom_root / "voting_period_length")
let time_before_reward =
RPC_service.post_service
~description: "Time before reward"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "time_before_reward" Period.encoding))
RPC_path.(custom_root / "time_before_reward")
let slot_durations =
RPC_service.post_service
~description: "Slot durations"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "time_between_slots" (list Period.encoding)))
RPC_path.(custom_root / "time_between_slots")
let first_free_baking_slot =
RPC_service.post_service
~description: "First free baking slot"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "first_free_baking_slot" uint16))
RPC_path.(custom_root / "first_free_baking_slot")
let max_signing_slot =
RPC_service.post_service
~description: "Max signing slot"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "max_signing_slot" uint16))
RPC_path.(custom_root / "max_signing_slot")
let max_gas =
RPC_service.post_service
~description: "Instructions per transaction"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "instructions_per_transaction" int31))
RPC_path.(custom_root / "max_gas")
let proof_of_work_threshold =
RPC_service.post_service
~description: "Stamp threshold"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "proof_of_work_threshold" int64))
RPC_path.(custom_root / "proof_of_work_threshold")
let errors =
RPC_service.post_service
~description: "Schema for all the RPC errors from this protocol version"
~query: RPC_query.empty
~input: empty
~output: json_schema
RPC_path.(custom_root / "errors")
end
let () =
let open Services_registration in
register0 S.cycle_length begin fun ctxt () () ->
return (Constants.cycle_length ctxt)
end ;
register0 S.voting_period_length begin fun ctxt () () ->
return (Constants.voting_period_length ctxt)
end ;
register0 S.time_before_reward begin fun ctxt () () ->
return (Constants.time_before_reward ctxt)
end ;
register0 S.slot_durations begin fun ctxt () () ->
return (Constants.slot_durations ctxt)
end ;
register0 S.first_free_baking_slot begin fun ctxt () () ->
return (Constants.first_free_baking_slot ctxt)
end ;
register0 S.max_signing_slot begin fun ctxt () () ->
return (Constants.max_signing_slot ctxt)
end ;
register0 S.max_gas begin fun ctxt () () ->
return (Constants.max_gas ctxt)
end ;
register0 S.proof_of_work_threshold begin fun ctxt () () ->
return (Constants.proof_of_work_threshold ctxt)
end ;
register0_noctxt S.errors begin fun () () ->
return (Data_encoding.Json.(schema error_encoding))
end
let cycle_length ctxt block =
RPC_context.make_call0 S.cycle_length ctxt block () ()
let voting_period_length ctxt block =
RPC_context.make_call0 S.voting_period_length ctxt block () ()
let time_before_reward ctxt block =
RPC_context.make_call0 S.time_before_reward ctxt block () ()
let slot_durations ctxt block =
RPC_context.make_call0 S.slot_durations ctxt block () ()
let first_free_baking_slot ctxt block =
RPC_context.make_call0 S.first_free_baking_slot ctxt block () ()
let max_signing_slot ctxt block =
RPC_context.make_call0 S.max_signing_slot ctxt block () ()
let max_gas ctxt block =
RPC_context.make_call0 S.max_gas ctxt block () ()
let proof_of_work_threshold ctxt block =
RPC_context.make_call0 S.proof_of_work_threshold ctxt block () ()
let errors ctxt block =
RPC_context.make_call0 S.errors ctxt block () ()

37
src/proto_alpha/lib_protocol/src/constants_services.mli Normal file
View File

@ -0,0 +1,37 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
val cycle_length:
'a #RPC_context.simple -> 'a -> int32 shell_tzresult Lwt.t
val voting_period_length:
'a #RPC_context.simple -> 'a -> int32 shell_tzresult Lwt.t
val time_before_reward:
'a #RPC_context.simple -> 'a -> Period.t shell_tzresult Lwt.t
val slot_durations:
'a #RPC_context.simple -> 'a -> Period.t list shell_tzresult Lwt.t
val first_free_baking_slot:
'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t
val max_signing_slot:
'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t
val max_gas:
'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t
val proof_of_work_threshold:
'a #RPC_context.simple -> 'a -> Int64.t shell_tzresult Lwt.t
val errors:
'a #RPC_context.simple -> 'a -> Data_encoding.json_schema shell_tzresult Lwt.t

208
src/proto_alpha/lib_protocol/src/contract_services.ml Normal file
View File

@ -0,0 +1,208 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
let custom_root =
(RPC_path.(open_root / "context" / "contracts") : RPC_context.t RPC_path.context)
type info = {
manager: public_key_hash ;
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
counter: int32 ;
script: Script.t option ;
storage: Script.expr option ;
}
let info_encoding =
let open Data_encoding in
conv
(fun {manager ; balance ; spendable ; delegate ; script ; counter ; storage } ->
(manager, balance, spendable, delegate, script, storage, counter))
(fun (manager, balance, spendable, delegate, script, storage, counter) ->
{manager ; balance ; spendable ; delegate ; script ; storage ; counter}) @@
obj7
(req "manager" Ed25519.Public_key_hash.encoding)
(req "balance" Tez.encoding)
(req "spendable" bool)
(req "delegate" @@ obj2
(req "setable" bool)
(opt "value" Ed25519.Public_key_hash.encoding))
(opt "script" Script.encoding)
(opt "storage" Script.expr_encoding)
(req "counter" int32)
module S = struct
open Data_encoding
let balance =
RPC_service.post_service
~description: "Access the balance of a contract."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "balance" Tez.encoding))
RPC_path.(custom_root /: Contract.arg / "balance")
let manager =
RPC_service.post_service
~description: "Access the manager of a contract."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "manager" Ed25519.Public_key_hash.encoding))
RPC_path.(custom_root /: Contract.arg / "manager")
let delegate =
RPC_service.post_service
~description: "Access the delegate of a contract, if any."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "delegate" Ed25519.Public_key_hash.encoding))
RPC_path.(custom_root /: Contract.arg / "delegate")
let counter =
RPC_service.post_service
~description: "Access the counter of a contract, if any."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "counter" int32))
RPC_path.(custom_root /: Contract.arg / "counter")
let spendable =
RPC_service.post_service
~description: "Tells if the contract tokens can be spent by the manager."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "spendable" bool))
RPC_path.(custom_root /: Contract.arg / "spendable")
let delegatable =
RPC_service.post_service
~description: "Tells if the contract delegate can be changed."
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "delegatable" bool))
RPC_path.(custom_root /: Contract.arg / "delegatable")
let script =
RPC_service.post_service
~description: "Access the code and data of the contract."
~query: RPC_query.empty
~input: empty
~output: Script.encoding
RPC_path.(custom_root /: Contract.arg / "script")
let storage =
RPC_service.post_service
~description: "Access the data of the contract."
~query: RPC_query.empty
~input: empty
~output: Script.expr_encoding
RPC_path.(custom_root /: Contract.arg / "storage")
let info =
RPC_service.post_service
~description: "Access the complete status of a contract."
~query: RPC_query.empty
~input: empty
~output: info_encoding
RPC_path.(custom_root /: Contract.arg)
let list =
RPC_service.post_service
~description:
"All existing contracts (including non-empty default contracts)."
~query: RPC_query.empty
~input: empty
~output: (list Contract.encoding)
custom_root
end
let () =
let open Services_registration in
register0 S.list begin fun ctxt () () ->
Contract.list ctxt >>= return
end
let () =
let open Services_registration in
let register_field s f =
register1 s (fun ctxt contract () () ->
Contract.exists ctxt contract >>=? function
| true -> f ctxt contract
| false -> raise Not_found) in
let register_opt_field s f =
register_field s
(fun ctxt a1 ->
f ctxt a1 >>=? function
| None -> raise Not_found
| Some v -> return v) in
register_field S.balance Contract.get_balance ;
register_field S.manager Contract.get_manager ;
register_opt_field S.delegate Contract.get_delegate_opt ;
register_field S.counter Contract.get_counter ;
register_field S.spendable Contract.is_spendable ;
register_field S.delegatable Contract.is_delegatable ;
register_opt_field S.script Contract.get_script ;
register_opt_field S.storage Contract.get_storage ;
register_field S.info (fun ctxt contract ->
Contract.get_balance ctxt contract >>=? fun balance ->
Contract.get_manager ctxt contract >>=? fun manager ->
Contract.get_delegate_opt ctxt contract >>=? fun delegate ->
Contract.get_counter ctxt contract >>=? fun counter ->
Contract.is_delegatable ctxt contract >>=? fun delegatable ->
Contract.is_spendable ctxt contract >>=? fun spendable ->
Contract.get_script ctxt contract >>=? fun script ->
Contract.get_storage ctxt contract >>=? fun storage ->
return { manager ; balance ;
spendable ; delegate = (delegatable, delegate) ;
script ; counter ; storage})
let list ctxt block =
RPC_context.make_call0 S.list ctxt block () ()
let info ctxt block contract =
RPC_context.make_call1 S.info ctxt block contract () ()
let balance ctxt block contract =
RPC_context.make_call1 S.balance ctxt block contract () ()
let manager ctxt block contract =
RPC_context.make_call1 S.manager ctxt block contract () ()
let delegate ctxt block contract =
RPC_context.make_call1 S.delegate ctxt block contract () ()
let delegate_opt ctxt block contract =
RPC_context.make_opt_call1 S.delegate ctxt block contract () ()
let counter ctxt block contract =
RPC_context.make_call1 S.counter ctxt block contract () ()
let is_delegatable ctxt block contract =
RPC_context.make_call1 S.delegatable ctxt block contract () ()
let is_spendable ctxt block contract =
RPC_context.make_call1 S.spendable ctxt block contract () ()
let script ctxt block contract =
RPC_context.make_call1 S.script ctxt block contract () ()
let script_opt ctxt block contract =
RPC_context.make_opt_call1 S.script ctxt block contract () ()
let storage ctxt block contract =
RPC_context.make_call1 S.storage ctxt block contract () ()
let storage_opt ctxt block contract =
RPC_context.make_opt_call1 S.storage ctxt block contract () ()

61
src/proto_alpha/lib_protocol/src/contract_services.mli Normal file
View File

@ -0,0 +1,61 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
val list:
'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
type info = {
manager: public_key_hash ;
balance: Tez.t ;
spendable: bool ;
delegate: bool * public_key_hash option ;
counter: int32 ;
script: Script.t option ;
storage: Script.expr option ;
}
val info_encoding: info Data_encoding.t
val info:
'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t
val balance:
'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t
val manager:
'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
val delegate:
'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
val delegate_opt:
'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash option shell_tzresult Lwt.t
val is_delegatable:
'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t
val is_spendable:
'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t
val counter:
'a #RPC_context.simple -> 'a -> Contract.t -> int32 shell_tzresult Lwt.t
val script:
'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t
val script_opt:
'a #RPC_context.simple -> 'a -> Contract.t -> Script.t option shell_tzresult Lwt.t
val storage:
'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr shell_tzresult Lwt.t
val storage_opt:
'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t

375
src/proto_alpha/lib_protocol/src/delegate_services.ml Normal file
View File

@ -0,0 +1,375 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
let slots_range_encoding =
let open Data_encoding in
(obj3
(opt "max_priority" int31)
(opt "first_level" Raw_level.encoding)
(opt "last_level" Raw_level.encoding))
module Baker = struct
module S = struct
open Data_encoding
let custom_root =
RPC_path.(open_root / "helpers" / "rights" / "baking")
let slot_encoding =
(obj3
(req "level" Raw_level.encoding)
(req "priority" int31)
(req "timestamp" Timestamp.encoding))
let rights =
RPC_service.post_service
~description:
"List delegates allowed to bake for the next level, \
ordered by priority."
~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31))
~output: (obj2
(req "level" Raw_level.encoding)
(req "baking_rights"
(list
(obj2
(req "delegate" Ed25519.Public_key_hash.encoding)
(req "timestamp" Timestamp.encoding)))))
custom_root
let rights_for_level =
RPC_service.post_service
~description:
"List delegate allowed to bake for a given level, \
ordered by priority."
~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31))
~output: (obj2
(req "level" Raw_level.encoding)
(req "delegates"
(list Ed25519.Public_key_hash.encoding)))
RPC_path.(custom_root / "level" /: Raw_level.arg)
(* let levels = *)
(* RPC_service.post_service *)
(* ~description: *)
(* "List level for which we might computed baking rights." *)
(* ~query: RPC_query.empty *)
(* ~input: empty *)
(* ~output: (obj1 (req "levels" (list Raw_level.encoding))) *)
(* RPC_path.(custom_root / "level") *)
let rights_for_delegate =
RPC_service.post_service
~description: "Future baking rights for a given delegate."
~query: RPC_query.empty
~input: slots_range_encoding
~output: (Data_encoding.list slot_encoding)
RPC_path.(custom_root / "delegate" /: Ed25519.Public_key_hash.rpc_arg)
(* let delegates = *)
(* RPC_service.post_service *)
(* ~description: *)
(* "List delegates with baking rights." *)
(* ~query: RPC_query.empty *)
(* ~input: empty *)
(* ~output: (obj1 (req "delegates" *)
(* (list Ed25519.Public_key_hash.encoding))) *)
(* RPC_path.(custom_root / "delegate") *)
end
module I = struct
let default_max_baking_priority ctxt arg =
let default = Constants.first_free_baking_slot ctxt in
match arg with
| None -> 2 * default
| Some m -> m
let baking_rights_for_level ctxt level max =
let max = default_max_baking_priority ctxt max in
Baking.baking_priorities ctxt level >>=? fun contract_list ->
let rec loop l n =
match n with
| 0 -> return []
| n ->
let Misc.LCons (h, t) = l in
t () >>=? fun t ->
loop t (pred n) >>=? fun t ->
return (h :: t)
in
loop contract_list max >>=? fun prio ->
return (level.level, prio)
let baking_rights ctxt () max =
let level = Level.current ctxt in
baking_rights_for_level ctxt level max >>=? fun (raw_level, slots) ->
begin
Lwt_list.filter_map_p (fun x -> x) @@
List.mapi
(fun prio c ->
let timestamp = Timestamp.current ctxt in
Baking.minimal_time ctxt prio timestamp >>= function
| Error _ -> Lwt.return None
| Ok minimal_timestamp -> Lwt.return (Some (c, minimal_timestamp)))
slots
end >>= fun timed_slots ->
return (raw_level, timed_slots)
let baking_rights_for_delegate
ctxt contract () (max_priority, min_level, max_level) =
let max_priority = default_max_baking_priority ctxt max_priority in
let current_level = Level.current ctxt in
let min_level = match min_level with
| None -> current_level
| Some l -> Level.from_raw ctxt l in
let max_level =
match max_level with
| Some max_level -> Level.from_raw ctxt max_level
| None ->
Level.last_level_in_cycle ctxt @@
current_level.cycle in
let rec loop level =
if Level.(>) level max_level
then return []
else
loop (Level.succ ctxt level) >>=? fun t ->
Baking.first_baking_priorities
ctxt ~max_priority contract level >>=? fun priorities ->
let raw_level = level.level in
Error_monad.map_s
(fun priority ->
let timestamp = Timestamp.current ctxt in
Baking.minimal_time ctxt priority timestamp >>=? fun time ->
return (raw_level, priority, time))
priorities >>=? fun priorities ->
return (priorities @ t)
in
loop min_level
end
let () =
let open Services_registration in
register0 S.rights I.baking_rights ;
register1 S.rights_for_level begin fun ctxt raw_level () max ->
let level = Level.from_raw ctxt raw_level in
I.baking_rights_for_level ctxt level max
end;
register1 S.rights_for_delegate I.baking_rights_for_delegate
let rights ctxt ?max_priority block =
RPC_context.make_call0 S.rights ctxt block () max_priority
let rights_for_level ctxt ?max_priority block level =
RPC_context.make_call1 S.rights_for_level ctxt block level () max_priority
let rights_for_delegate ctxt ?max_priority ?first_level ?last_level block delegate =
RPC_context.make_call1 S.rights_for_delegate ctxt block delegate ()
(max_priority, first_level, last_level)
end
module Endorser = struct
module S = struct
open Data_encoding
let custom_root =
RPC_path.(open_root / "helpers" / "rights" / "endorsement")
let slot_encoding =
(obj2
(req "level" Raw_level.encoding)
(req "priority" int31))
let rights =
RPC_service.post_service
~description:
"List delegates allowed to endorse for the current block."
~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31))
~output: (obj2
(req "level" Raw_level.encoding)
(req "delegates"
(list Ed25519.Public_key_hash.encoding)))
custom_root
let rights_for_level =
RPC_service.post_service
~description:
"List delegates allowed to endorse blocks for a given level."
~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31))
~output: (obj2
(req "level" Raw_level.encoding)
(req "delegates"
(list Ed25519.Public_key_hash.encoding)))
RPC_path.(custom_root / "level" /: Raw_level.arg)
(* let levels = *)
(* RPC_service.post_service *)
(* ~description: *)
(* "List level for which we might computed endorsement rights." *)
(* ~query: RPC_query.empty *)
(* ~input: empty *)
(* ~output: (obj1 (req "levels" (list Raw_level.encoding))) *)
(* RPC_path.(custom_root / "level") *)
let rights_for_delegate =
RPC_service.post_service
~description: "Compute endorsement rights for a given delegate."
~query: RPC_query.empty
~input: slots_range_encoding
~output: (Data_encoding.list slot_encoding)
RPC_path.(custom_root / "delegate" /: Ed25519.Public_key_hash.rpc_arg)
(* let delegates = *)
(* RPC_service.post_service *)
(* ~description: *)
(* "List delegates with endorsement rights." *)
(* ~query: RPC_query.empty *)
(* ~input: empty *)
(* ~output: (obj1 (req "delegates" *)
(* (list Ed25519.Public_key_hash.encoding))) *)
(* RPC_path.(custom_root / "delegate") *)
end
module I = struct
let default_max_endorsement_priority ctxt arg =
let default = Constants.max_signing_slot ctxt in
match arg with
| None -> default
| Some m -> m
let endorsement_rights ctxt level max =
let max = default_max_endorsement_priority ctxt max in
Baking.endorsement_priorities ctxt level >>=? fun contract_list ->
let rec loop l n =
match n with
| 0 -> return []
| n ->
let Misc.LCons (h, t) = l in
t () >>=? fun t ->
loop t (pred n) >>=? fun t ->
return (h :: t)
in
loop contract_list max >>=? fun prio ->
return (level.level, prio)
let endorsement_rights_for_delegate
ctxt contract () (max_priority, min_level, max_level) =
let current_level = Level.current ctxt in
let max_priority = default_max_endorsement_priority ctxt max_priority in
let min_level = match min_level with
| None -> Level.succ ctxt current_level
| Some l -> Level.from_raw ctxt l in
let max_level =
match max_level with
| None -> min_level
| Some l -> Level.from_raw ctxt l in
let rec loop level =
if Level.(>) level max_level
then return []
else
loop (Level.succ ctxt level) >>=? fun t ->
Baking.first_endorsement_slots
ctxt ~max_priority contract level >>=? fun slots ->
let raw_level = level.level in
let slots = List.rev_map (fun slot -> (raw_level, slot)) slots in
return (List.rev_append slots t)
in
loop min_level
end
let () =
let open Services_registration in
register0 S.rights begin fun ctxt () max ->
let level = Level.current ctxt in
I.endorsement_rights ctxt level max
end ;
register1 S.rights_for_level begin fun ctxt raw_level () max ->
let level = Level.from_raw ctxt raw_level in
I.endorsement_rights ctxt level max
end ;
register1 S.rights_for_delegate I.endorsement_rights_for_delegate
let rights ctxt ?max_priority block =
RPC_context.make_call0 S.rights ctxt block () max_priority
let rights_for_level ctxt ?max_priority block level =
RPC_context.make_call1 S.rights_for_level ctxt block level () max_priority
let rights_for_delegate ctxt ?max_priority ?first_level ?last_level block delegate =
RPC_context.make_call1 S.rights_for_delegate ctxt block delegate ()
(max_priority, first_level, last_level)
end
module Key = struct
module S = struct
open Data_encoding
let custom_root =
RPC_path.(open_root / "context" / "key")
let pk_encoding =
(obj2
(req "hash" Ed25519.Public_key_hash.encoding)
(req "public_key" Ed25519.Public_key.encoding))
let list =
RPC_service.post_service
~description: "List the known public keys"
~query: RPC_query.empty
~input: empty
~output: (list pk_encoding)
custom_root
let get =
RPC_service.post_service
~description: "Fetch the stored public key"
~query: RPC_query.empty
~input: empty
~output: pk_encoding
RPC_path.(custom_root /: Ed25519.Public_key_hash.rpc_arg )
end
let () =
let open Services_registration in
register1 S.get begin fun ctxt hash () () ->
Delegates_pubkey.get ctxt hash >>=? fun pk ->
return (hash, pk)
end ;
register0 S.list begin fun ctxt () () ->
Delegates_pubkey.list ctxt >>= return
end
let list ctxt block =
RPC_context.make_call0 S.list ctxt block () ()
let get ctxt block pkh =
RPC_context.make_call1 S.get ctxt block pkh () ()
end
let baking_rights = Baker.I.baking_rights
let endorsement_rights = Endorser.I.endorsement_rights

71
src/proto_alpha/lib_protocol/src/delegate_services.mli Normal file
View File

@ -0,0 +1,71 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
module Baker : sig
val rights:
'a #RPC_context.simple -> ?max_priority:int -> 'a ->
(Raw_level.t * (Ed25519.Public_key_hash.t * Time.t) list) shell_tzresult Lwt.t
val rights_for_level:
'a #RPC_context.simple -> ?max_priority:int -> 'a -> Raw_level.t ->
(Raw_level.t * Ed25519.Public_key_hash.t list) shell_tzresult Lwt.t
val rights_for_delegate:
'a #RPC_context.simple ->
?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t ->
'a -> Ed25519.Public_key_hash.t ->
(Raw_level.t * int * Time.t) list shell_tzresult Lwt.t
end
module Endorser : sig
val rights:
'a #RPC_context.simple -> ?max_priority:int -> 'a ->
(Raw_level.t * Ed25519.Public_key_hash.t list) shell_tzresult Lwt.t
val rights_for_level:
'a #RPC_context.simple -> ?max_priority:int -> 'a -> Raw_level.t ->
(Raw_level.t * Ed25519.Public_key_hash.t list) shell_tzresult Lwt.t
val rights_for_delegate:
'a #RPC_context.simple ->
?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t ->
'a -> Ed25519.Public_key_hash.t ->
(Raw_level.t * int) list shell_tzresult Lwt.t
end
module Key : sig
val list:
'a #RPC_context.simple -> 'a ->
(Ed25519.Public_key_hash.t * Ed25519.Public_key.t) list shell_tzresult Lwt.t
val get:
'a #RPC_context.simple -> 'a ->
Ed25519.Public_key_hash.t ->
(Ed25519.Public_key_hash.t * Ed25519.Public_key.t) shell_tzresult Lwt.t
end
(* temporary export *)
val endorsement_rights:
Alpha_context.t ->
Level.t ->
int option -> (Raw_level.t * public_key_hash list) tzresult Lwt.t
val baking_rights:
Alpha_context.t ->
unit ->
int option ->
(Raw_level.t * (public_key_hash * Time.t) list) tzresult Lwt.t

493
src/proto_alpha/lib_protocol/src/helpers_services.ml Normal file
View File

@ -0,0 +1,493 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
module S = struct
open Data_encoding
let custom_root = RPC_path.(open_root / "helpers")
let minimal_timestamp =
RPC_service.post_service
~description: "Minimal timestamp for the next block."
~query: RPC_query.empty
~input: (obj1 (opt "priority" int31))
~output: (obj1 (req "timestamp" Timestamp.encoding))
RPC_path.(custom_root / "minimal_timestamp")
let run_code_input_encoding =
(obj6
(req "script" Script.expr_encoding)
(req "storage" Script.expr_encoding)
(req "input" Script.expr_encoding)
(req "amount" Tez.encoding)
(opt "contract" Contract.encoding)
(opt "origination_nonce" Contract.origination_nonce_encoding))
let run_code =
RPC_service.post_service
~description: "Run a piece of code in the current context"
~query: RPC_query.empty
~input: run_code_input_encoding
~output: (obj3
(req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding)
(opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))
RPC_path.(custom_root / "run_code")
let apply_operation =
RPC_service.post_service
~description: "Applies an operation in the current context"
~query: RPC_query.empty
~input: (obj4
(req "pred_block" Block_hash.encoding)
(req "operation_hash" Operation_hash.encoding)
(req "forged_operation" bytes)
(opt "signature" Ed25519.Signature.encoding))
~output: (obj1 (req "contracts" (list Contract.encoding)))
RPC_path.(custom_root / "apply_operation")
let trace_code =
RPC_service.post_service
~description: "Run a piece of code in the current context, \
keeping a trace"
~query: RPC_query.empty
~input: run_code_input_encoding
~output: (obj4
(req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding)
(req "trace"
(list @@ obj3
(req "location" Script.location_encoding)
(req "gas" Gas.encoding)
(req "stack" (list (Script.expr_encoding)))))
(opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))
RPC_path.(custom_root / "trace_code")
let typecheck_code =
RPC_service.post_service
~description: "Typecheck a piece of code in the current context"
~query: RPC_query.empty
~input: Script.expr_encoding
~output: Script_tc_errors_registration.type_map_enc
RPC_path.(custom_root / "typecheck_code")
let typecheck_data =
RPC_service.post_service
~description: "Check that some data expression is well formed \
and of a given type in the current context"
~query: RPC_query.empty
~input: (obj2
(req "data" Script.expr_encoding)
(req "type" Script.expr_encoding))
~output: empty
RPC_path.(custom_root / "typecheck_data")
let hash_data =
RPC_service.post_service
~description: "Computes the hash of some data expression \
using the same algorithm as script instruction H"
~input: (obj2 (req "data" Script.expr_encoding)
(req "type" Script.expr_encoding))
~output: (obj1 (req "hash" string))
~query: RPC_query.empty
RPC_path.(custom_root / "hash_data")
let level =
RPC_service.post_service
~description: "..."
~query: RPC_query.empty
~input: (obj1 (opt "offset" int32))
~output: Level.encoding
RPC_path.(custom_root / "level" /: Raw_level.arg)
let levels =
RPC_service.post_service
~description: "Levels of a cycle"
~query: RPC_query.empty
~input: empty
~output: (describe ~title: "levels of a cycle"
(obj2
(req "first" Raw_level.encoding)
(req "last" Raw_level.encoding)))
RPC_path.(custom_root / "levels" /: Cycle.arg)
end
module I = struct
let apply_operation ctxt () (pred_block, hash, forged_operation, signature) =
(* ctxt accept_failing_script baker_contract pred_block block_prio operation *)
match Data_encoding.Binary.of_bytes
Operation.unsigned_operation_encoding
forged_operation with
| None -> Error_monad.fail Operation.Cannot_parse_operation
| Some (shell, contents) ->
let operation = { hash ; shell ; contents ; signature } in
let level = Alpha_context.Level.current ctxt in
Baking.baking_priorities ctxt level >>=? fun (Misc.LCons (baker_pkh, _)) ->
let baker_contract = Contract.default_contract baker_pkh in
let block_prio = 0 in
Apply.apply_operation
ctxt (Some baker_contract) pred_block block_prio operation
>>=? function
| (_ctxt, _, Some script_err) -> Lwt.return (Error script_err)
| (_ctxt, contracts, None) -> Lwt.return (Ok contracts)
let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
let contract =
match contract with
| Some contract -> contract
| None ->
Contract.default_contract
(List.hd (Bootstrap.accounts ctxt)).Bootstrap.public_key_hash in
let max_gas =
Constants.max_gas ctxt in
let origination_nonce =
match origination_nonce with
| Some origination_nonce -> origination_nonce
| None ->
Contract.initial_origination_nonce
(Operation_hash.hash_string [ "FAKE " ; "FAKE" ; "FAKE" ]) in
(script, storage, input, amount, contract, max_gas, origination_nonce)
end
let () =
let open Services_registration in
register0 S.minimal_timestamp begin fun ctxt () slot ->
let timestamp = Alpha_context.Timestamp.current ctxt in
let slot = match slot with None -> 0 | Some p -> p in
Baking.minimal_time ctxt slot timestamp
end ;
register0 S.apply_operation I.apply_operation ;
register0 S.run_code begin fun ctxt () parameters ->
let (code, storage, input, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
Script_interpreter.execute
origination_nonce
contract (* transaction initiator *)
contract (* script owner *)
ctxt { storage ; code } amount input
(Gas.of_int gas) >>=? fun (sto, ret, _gas, _ctxt, _, maybe_big_map_diff) ->
return (sto, ret,
Option.map maybe_big_map_diff
~f:Script_ir_translator.to_printable_big_map)
end ;
register0 S.trace_code begin fun ctxt () parameters ->
let (code, storage, input, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
Script_interpreter.trace
origination_nonce
contract (* transaction initiator *)
contract (* script owner *)
ctxt { storage ; code } amount input
(Gas.of_int gas) >>=? fun ((sto, ret, _gas, _ctxt, _, maybe_big_map_diff), trace) ->
return (sto, ret, trace,
Option.map maybe_big_map_diff
~f:Script_ir_translator.to_printable_big_map)
end ;
register0 S.typecheck_code begin fun ctxt () ->
Script_ir_translator.typecheck_code ctxt
end ;
register0 S.typecheck_data begin fun ctxt () ->
Script_ir_translator.typecheck_data ctxt
end ;
register0 S.hash_data begin fun ctxt () (expr, typ) ->
let open Script_ir_translator in
Lwt.return @@ parse_ty false (Micheline.root typ) >>=? fun (Ex_ty typ, _) ->
parse_data ctxt typ (Micheline.root expr) >>=? fun data ->
return (Script_ir_translator.hash_data typ data)
end ;
register1 S.level begin fun ctxt raw () offset ->
return (Level.from_raw ctxt ?offset raw)
end ;
register1 S.levels begin fun ctxt cycle () () ->
let levels = Level.levels_in_cycle ctxt cycle in
let first = List.hd (List.rev levels) in
let last = List.hd levels in
return (first.level, last.level)
end
let minimal_time ctxt ?priority block =
RPC_context.make_call0 S.minimal_timestamp ctxt block () priority
let run_code ctxt block code (storage, input, amount) =
RPC_context.make_call0 S.run_code ctxt
block () (code, storage, input, amount, None, None)
let apply_operation ctxt block pred_block hash forged_operation signature =
RPC_context.make_call0 S.apply_operation ctxt
block () (pred_block, hash, forged_operation, signature)
let trace_code ctxt block code (storage, input, amount) =
RPC_context.make_call0 S.trace_code ctxt
block () (code, storage, input, amount, None, None)
let typecheck_code ctxt block =
RPC_context.make_call0 S.typecheck_code ctxt block ()
let typecheck_data ctxt block =
RPC_context.make_call0 S.typecheck_data ctxt block ()
let hash_data ctxt block =
RPC_context.make_call0 S.hash_data ctxt block ()
let level ctxt block ?offset lvl =
RPC_context.make_call1 S.level ctxt block lvl () offset
let levels ctxt block cycle =
RPC_context.make_call1 S.levels ctxt block cycle () ()
module Forge = struct
module S = struct
open Data_encoding
let custom_root = RPC_path.(open_root / "helpers" / "forge")
let operations =
RPC_service.post_service
~description:"Forge an operation"
~query: RPC_query.empty
~input: Operation.unsigned_operation_encoding
~output:
(obj1
(req "operation" @@
describe ~title: "hex encoded operation" bytes))
RPC_path.(custom_root / "forge" / "operations" )
let empty_proof_of_work_nonce =
MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000')
let block_proto_header =
RPC_service.post_service
~description: "Forge the protocol-specific part of a block header"
~query: RPC_query.empty
~input:
(obj3
(req "priority" uint16)
(req "nonce_hash" Nonce_hash.encoding)
(dft "proof_of_work_nonce"
(Fixed.bytes
Alpha_context.Constants.proof_of_work_nonce_size)
empty_proof_of_work_nonce))
~output: (obj1 (req "proto_header" bytes))
RPC_path.(custom_root / "forge" / "block_proto_header")
end
let () =
let open Services_registration in
register0_noctxt S.operations begin fun () (shell, proto) ->
return (Operation.forge shell proto)
end ;
register0_noctxt S.block_proto_header begin fun ()
(priority, seed_nonce_hash, proof_of_work_nonce) ->
return (Block_header.forge_unsigned_proto_header
{ priority ; seed_nonce_hash ; proof_of_work_nonce })
end
module Manager = struct
let operations ctxt
block ~branch ~source ?sourcePubKey ~counter ~fee operations =
let ops =
Manager_operations { source ; public_key = sourcePubKey ;
counter ; operations ; fee } in
(RPC_context.make_call0 S.operations ctxt block
() ({ branch }, Sourced_operations ops))
let transaction ctxt
block ~branch ~source ?sourcePubKey ~counter
~amount ~destination ?parameters ~fee ()=
operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[Transaction { amount ; parameters ; destination }]
let origination ctxt
block ~branch
~source ?sourcePubKey ~counter
~managerPubKey ~balance
?(spendable = true)
?(delegatable = true)
?delegatePubKey ?script ~fee () =
operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[
Origination { manager = managerPubKey ;
delegate = delegatePubKey ;
script ;
spendable ;
delegatable ;
credit = balance }
]
let delegation ctxt
block ~branch ~source ?sourcePubKey ~counter ~fee delegate =
operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[Delegation delegate]
end
module Delegate = struct
let operations ctxt
block ~branch ~source operations =
let ops = Delegate_operations { source ; operations } in
(RPC_context.make_call0 S.operations ctxt block
() ({ branch }, Sourced_operations ops))
let endorsement ctxt
b ~branch ~source ~block ~slot () =
operations ctxt b ~branch ~source
Alpha_context.[Endorsement { block ; slot }]
let proposals ctxt
b ~branch ~source ~period ~proposals () =
operations ctxt b ~branch ~source
Alpha_context.[Proposals { period ; proposals }]
let ballot ctxt
b ~branch ~source ~period ~proposal ~ballot () =
operations ctxt b ~branch ~source
Alpha_context.[Ballot { period ; proposal ; ballot }]
end
module Dictator = struct
let operation ctxt
block ~branch operation =
let op = Dictator_operation operation in
(RPC_context.make_call0 S.operations ctxt block
() ({ branch }, Sourced_operations op))
let activate ctxt
b ~branch hash =
operation ctxt b ~branch (Activate hash)
let activate_testnet ctxt
b ~branch hash =
operation ctxt b ~branch (Activate_testnet hash)
end
module Anonymous = struct
let operations ctxt block ~branch operations =
(RPC_context.make_call0 S.operations ctxt block
() ({ branch }, Anonymous_operations operations))
let seed_nonce_revelation ctxt
block ~branch ~level ~nonce () =
operations ctxt block ~branch [Seed_nonce_revelation { level ; nonce }]
let faucet ctxt
block ~branch ~id ~nonce () =
operations ctxt block ~branch [Faucet { id ; nonce }]
end
let empty_proof_of_work_nonce =
MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000')
let block_proto_header ctxt
block
~priority ~seed_nonce_hash
?(proof_of_work_nonce = empty_proof_of_work_nonce) () =
RPC_context.make_call0 S.block_proto_header
ctxt block () (priority, seed_nonce_hash, proof_of_work_nonce)
end
module Parse = struct
module S = struct
open Data_encoding
let custom_root = RPC_path.(open_root / "helpers" / "parse")
let operations =
RPC_service.post_service
~description:"Parse operations"
~query: RPC_query.empty
~input:
(obj2
(req "operations" (list (dynamic_size Operation.raw_encoding)))
(opt "check_signature" bool))
~output: (list (dynamic_size Operation.encoding))
RPC_path.(custom_root / "parse" / "operations" )
let block =
RPC_service.post_service
~description:"Parse a block"
~query: RPC_query.empty
~input: Block_header.raw_encoding
~output: Block_header.proto_header_encoding
RPC_path.(custom_root / "parse" / "block" )
end
module I = struct
let check_signature ctxt signature shell contents =
match contents with
| Anonymous_operations _ -> return ()
| Sourced_operations (Manager_operations op) ->
begin
match op.public_key with
| Some key -> return key
| None ->
Contract.get_manager ctxt op.source >>=? fun manager ->
Delegates_pubkey.get ctxt manager
end >>=? fun public_key ->
Operation.check_signature public_key
{ signature ; shell ; contents ; hash = Operation_hash.zero }
| Sourced_operations (Delegate_operations { source ; _ }) ->
Operation.check_signature source
{ signature ; shell ; contents ; hash = Operation_hash.zero }
| Sourced_operations (Dictator_operation _) ->
let key = Constants.dictator_pubkey ctxt in
Operation.check_signature key
{ signature ; shell ; contents ; hash = Operation_hash.zero }
end
let () =
let open Services_registration in
register0 S.operations begin fun ctxt () (operations, check) ->
map_s begin fun raw ->
Lwt.return (Operation.parse (Operation.hash_raw raw) raw) >>=? fun op ->
begin match check with
| Some true -> I.check_signature ctxt op.signature op.shell op.contents
| Some false | None -> return ()
end >>|? fun () -> op
end operations
end ;
register0_noctxt S.block begin fun () raw_block ->
Lwt.return (Block_header.parse raw_block) >>=? fun { proto ; _ } ->
return proto
end
let operations ctxt block ?check operations =
RPC_context.make_call0
S.operations ctxt block () (operations, check)
let block ctxt block shell proto =
RPC_context.make_call0
S.block ctxt block () ({ shell ; proto } : Block_header.raw)
end

209
src/proto_alpha/lib_protocol/src/helpers_services.mli Normal file
View File

@ -0,0 +1,209 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
val minimal_time:
'a #RPC_context.simple ->
?priority:int -> 'a -> Time.t shell_tzresult Lwt.t
(** [minimal_time cctxt ?prio blk] is the minimal acceptable
timestamp for the successor of [blk]. [?priority] defaults to
[0]. *)
val apply_operation:
'a #RPC_context.simple ->
'a -> Block_hash.t -> Operation_hash.t -> MBytes.t -> Ed25519.Signature.t option ->
(Contract.t list) shell_tzresult Lwt.t
val run_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t) ->
(Script.expr * Script.expr * (Script.expr * Script.expr option) list option) shell_tzresult Lwt.t
val trace_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t) ->
(Script.expr * Script.expr *
(Script.location * Gas.t * Script.expr list) list *
(Script.expr * Script.expr option) list option) shell_tzresult Lwt.t
val typecheck_code:
'a #RPC_context.simple ->
'a -> Script.expr -> Script_tc_errors.type_map shell_tzresult Lwt.t
val typecheck_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr -> unit shell_tzresult Lwt.t
val hash_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr -> string shell_tzresult Lwt.t
val level:
'a #RPC_context.simple ->
'a -> ?offset:int32 -> Raw_level.t -> Level.t shell_tzresult Lwt.t
val levels:
'a #RPC_context.simple ->
'a -> Cycle.t -> (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
module Forge : sig
module Manager : sig
val operations:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
fee:Tez.t ->
manager_operation list -> MBytes.t shell_tzresult Lwt.t
val transaction:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
amount:Tez.t ->
destination:Contract.t ->
?parameters:Script.expr ->
fee:Tez.t ->
unit -> MBytes.t shell_tzresult Lwt.t
val origination:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
managerPubKey:public_key_hash ->
balance:Tez.t ->
?spendable:bool ->
?delegatable:bool ->
?delegatePubKey: public_key_hash ->
?script:Script.t ->
fee:Tez.t->
unit -> MBytes.t shell_tzresult Lwt.t
val delegation:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:Contract.t ->
?sourcePubKey:public_key ->
counter:int32 ->
fee:Tez.t ->
public_key_hash option ->
MBytes.t shell_tzresult Lwt.t
end
module Dictator : sig
val operation:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
dictator_operation -> MBytes.t shell_tzresult Lwt.t
val activate:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
Protocol_hash.t -> MBytes.t shell_tzresult Lwt.t
val activate_testnet:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
Protocol_hash.t -> MBytes.t shell_tzresult Lwt.t
end
module Delegate : sig
val operations:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:public_key ->
delegate_operation list -> MBytes.t shell_tzresult Lwt.t
val endorsement:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:public_key ->
block:Block_hash.t ->
slot:int ->
unit -> MBytes.t shell_tzresult Lwt.t
val proposals:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:public_key ->
period:Voting_period.t ->
proposals:Protocol_hash.t list ->
unit -> MBytes.t shell_tzresult Lwt.t
val ballot:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
source:public_key ->
period:Voting_period.t ->
proposal:Protocol_hash.t ->
ballot:Vote.ballot ->
unit -> MBytes.t shell_tzresult Lwt.t
end
module Anonymous : sig
val operations:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
anonymous_operation list -> MBytes.t shell_tzresult Lwt.t
val seed_nonce_revelation:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
level:Raw_level.t ->
nonce:Nonce.t ->
unit -> MBytes.t shell_tzresult Lwt.t
val faucet:
'a #RPC_context.simple -> 'a ->
branch:Block_hash.t ->
id:public_key_hash ->
nonce:MBytes.t ->
unit -> MBytes.t shell_tzresult Lwt.t
end
val block_proto_header:
'a #RPC_context.simple -> 'a ->
priority: int ->
seed_nonce_hash: Nonce_hash.t ->
?proof_of_work_nonce: MBytes.t ->
unit -> MBytes.t shell_tzresult Lwt.t
end
module Parse : sig
val operations:
'a #RPC_context.simple -> 'a ->
?check:bool -> Operation.raw list ->
Operation.t list shell_tzresult Lwt.t
val block:
'a #RPC_context.simple -> 'a ->
Block_header.shell_header -> MBytes.t ->
Block_header.proto_header shell_tzresult Lwt.t
end

2
src/proto_alpha/lib_protocol/src/main.ml
View File

@ -21,7 +21,7 @@ let validation_passes =
Updater.[ { max_size = 32 * 1024 ; max_op = None } ; (* 32kB FIXME *) Updater.[ { max_size = 32 * 1024 ; max_op = None } ; (* 32kB FIXME *)
{ max_size = 1024 * 1024 ; max_op = None } ] (* 1MB *) { max_size = 1024 * 1024 ; max_op = None } ] (* 1MB *)
let rpc_services = Services_registration.rpc_services let rpc_services = Services_registration.get_rpc_services ()
type validation_mode = type validation_mode =
| Application of { | Application of {

533
src/proto_alpha/lib_protocol/src/services_registration.ml
View File

@ -30,531 +30,36 @@ let rpc_services = ref (RPC_directory.empty : Updater.rpc_context Lwt.t RPC_dire
let register0_fullctxt s f = let register0_fullctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services s
(fun ctxt q () -> (fun ctxt q i ->
rpc_init ctxt >>=? fun ctxt -> rpc_init ctxt >>=? fun ctxt ->
f ctxt q) f ctxt q i)
let register0 s f = register0_fullctxt s (fun { context ; _ } -> f context) let register0 s f =
register0_fullctxt s (fun { context ; _ } -> f context)
let register0_noctxt s f =
rpc_services :=
RPC_directory.register !rpc_services s
(fun _ q i -> f q i)
let register1_fullctxt s f = let register1_fullctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services s
(fun ctxt q arg -> (fun (ctxt, arg) q i ->
rpc_init ctxt >>=? fun ctxt -> rpc_init ctxt >>=? fun ctxt ->
f ctxt q arg ) f ctxt arg q i)
let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x) let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x)
let register1_noctxt s f = let register1_noctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services s
(fun _ q arg -> f q arg) (fun (_, arg) q i -> f arg q i)
let register2_fullctxt s f = let register2_fullctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services s
(fun (ctxt, arg1) q arg2 -> (fun ((ctxt, arg1), arg2) q i ->
rpc_init ctxt >>=? fun ctxt -> rpc_init ctxt >>=? fun ctxt ->
f ctxt q arg1 arg2) f ctxt arg1 arg2 q i)
let register2 s f = let register2 s f =
register2_fullctxt s (fun { context ; _ } q x y -> f context q x y) register2_fullctxt s (fun { context ; _ } a1 a2 q i -> f context a1 a2 q i)
let get_rpc_services () = !rpc_services
(*-- Operations --------------------------------------------------------------*)
let () =
register0_fullctxt
Services.operations
(fun { operation_hashes ; operations ; _ } () ->
operation_hashes () >>= fun operation_hashes ->
operations () >>= fun operations ->
map2_s
(map2_s (fun x y -> Lwt.return (Operation.parse x y)))
operation_hashes operations)
let () =
register0_fullctxt
Services.header
(fun { block_header ; _ } () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header) ;
register0_fullctxt
Services.Header.priority
(fun { block_header ; _ } () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.priority) ;
register0_fullctxt
Services.Header.seed_nonce_hash
(fun { block_header ; _ } () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.seed_nonce_hash)
(*-- Constants ---------------------------------------------------------------*)
let cycle_length ctxt () =
return @@ Constants.cycle_length ctxt
let () = register0 Services.Constants.cycle_length cycle_length
let voting_period_length ctxt () =
return @@ Constants.voting_period_length ctxt
let () =
register0
Services.Constants.voting_period_length
voting_period_length
let time_before_reward ctxt () =
return @@ Constants.time_before_reward ctxt
let () = register0 Services.Constants.time_before_reward time_before_reward
let slot_durations ctxt () =
return @@ Constants.slot_durations ctxt
let () = register0 Services.Constants.slot_durations slot_durations
let first_free_baking_slot ctxt () =
return @@ Constants.first_free_baking_slot ctxt
let () =
register0 Services.Constants.first_free_baking_slot first_free_baking_slot
let max_signing_slot ctxt () =
return @@ Constants.max_signing_slot ctxt
let () = register0 Services.Constants.max_signing_slot max_signing_slot
let max_gas ctxt () =
return @@ Constants.max_gas ctxt
let () =
register0
Services.Constants.max_gas max_gas
let proof_of_work_threshold ctxt () =
return @@ Constants.proof_of_work_threshold ctxt
let () =
register0 Services.Constants.proof_of_work_threshold
proof_of_work_threshold
let () =
register1_noctxt Services.Constants.errors
(fun () () ->
return (Data_encoding.Json.(schema error_encoding)))
(*-- Context -----------------------------------------------------------------*)
type error += Unexpected_level_in_context
let level ctxt () =
let level = Level.current ctxt in
match Level.pred ctxt level with
| None -> fail Unexpected_level_in_context
| Some level -> return level
let () = register0 Services.Context.level level
let next_level ctxt () =
return (Level.current ctxt)
let () =
register0 Services.Context.next_level next_level
let () =
register0 Services.Context.roll_value
(fun ctxt () -> return (Roll.value ctxt))
let () =
register0 Services.Context.next_roll
(fun ctxt () -> Roll.next ctxt)
let () =
register0 Services.Context.voting_period_kind
(fun ctxt () -> Vote.get_current_period_kind ctxt)
(*-- Context.Nonce -----------------------------------------------------------*)
let nonce ctxt () raw_level () =
let level = Level.from_raw ctxt raw_level in
Nonce.get ctxt level >>= function
| Ok (Revealed nonce) -> return (Services.Context.Nonce.Revealed nonce)
| Ok (Unrevealed { nonce_hash ; _ }) ->
return (Services.Context.Nonce.Missing nonce_hash)
| Error _ -> return Services.Context.Nonce.Forgotten
let () = register2 Services.Context.Nonce.get nonce
let nonce_hash ctxt () =
level ctxt () >>=? fun level ->
Nonce.get ctxt level >>=? function
| Unrevealed { nonce_hash ; _ } -> return nonce_hash
| _ -> assert false
let () = register0 Services.Context.Nonce.hash nonce_hash
(*-- Context.Key -------------------------------------------------------------*)
let get_key ctxt () hash () =
Delegates_pubkey.get ctxt hash >>=? fun pk ->
return (hash, pk)
let () = register2 Services.Context.Key.get get_key
let () =
register0 Services.Context.Key.list
(fun t () -> Delegates_pubkey.list t >>= return)
(*-- Context.Contract --------------------------------------------------------*)
let () =
register0 Services.Context.Contract.list
(fun ctxt () -> Contract.list ctxt >>= return)
let () =
let register2 s f =
rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root)
(fun (ctxt, contract) () arg ->
rpc_init ctxt >>=? fun { context = ctxt ; _ } ->
Contract.exists ctxt contract >>=? function
| true -> f ctxt contract arg
| false -> raise Not_found) in
let register2' s f = register2 s (fun ctxt a1 () -> f ctxt a1) in
let register2'' s f =
register2 s (fun ctxt a1 () -> f ctxt a1 >>=? function
| None -> raise Not_found
| Some v -> return v) in
register2' Services.Context.Contract.balance Contract.get_balance ;
register2' Services.Context.Contract.manager Contract.get_manager ;
register2'' Services.Context.Contract.delegate Contract.get_delegate_opt ;
register2' Services.Context.Contract.counter Contract.get_counter ;
register2' Services.Context.Contract.spendable Contract.is_spendable ;
register2' Services.Context.Contract.delegatable Contract.is_delegatable ;
register2'' Services.Context.Contract.script Contract.get_script ;
register2'' Services.Context.Contract.storage Contract.get_storage ;
register2' Services.Context.Contract.get (fun ctxt contract ->
Contract.get_balance ctxt contract >>=? fun balance ->
Contract.get_manager ctxt contract >>=? fun manager ->
Contract.get_delegate_opt ctxt contract >>=? fun delegate ->
Contract.get_counter ctxt contract >>=? fun counter ->
Contract.is_delegatable ctxt contract >>=? fun delegatable ->
Contract.is_spendable ctxt contract >>=? fun spendable ->
Contract.get_script ctxt contract >>=? fun script ->
return { Services.Context.Contract.manager ; balance ;
spendable ; delegate = (delegatable, delegate) ;
script ; counter }) ;
()
(*-- Helpers -----------------------------------------------------------------*)
let minimal_timestamp ctxt prio =
let prio = match prio with None -> 0 | Some p -> p in
Baking.minimal_time ctxt prio
let () = register1
Services.Helpers.minimal_timestamp
(fun ctxt () slot ->
let timestamp = Alpha_context.Timestamp.current ctxt in
minimal_timestamp ctxt slot timestamp)
let () =
(* ctxt accept_failing_script baker_contract pred_block block_prio operation *)
register1 Services.Helpers.apply_operation
(fun ctxt () (pred_block, hash, forged_operation, signature) ->
match Data_encoding.Binary.of_bytes
Operation.unsigned_operation_encoding
forged_operation with
| None -> Error_monad.fail Operation.Cannot_parse_operation
| Some (shell, contents) ->
let operation = { hash ; shell ; contents ; signature } in
let level = Alpha_context.Level.current ctxt in
Baking.baking_priorities ctxt level >>=? fun (Misc.LCons (baker_pkh, _)) ->
let baker_contract = Contract.default_contract baker_pkh in
let block_prio = 0 in
Apply.apply_operation
ctxt (Some baker_contract) pred_block block_prio operation
>>=? function
| (_ctxt, _, Some script_err) -> Lwt.return (Error script_err)
| (_ctxt, contracts, None) -> Lwt.return (Ok contracts)) ;
let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
let contract =
match contract with
| Some contract -> contract
| None ->
Contract.default_contract
(List.hd (Bootstrap.accounts ctxt)).Bootstrap.public_key_hash in
let max_gas =
Constants.max_gas ctxt in
let origination_nonce =
match origination_nonce with
| Some origination_nonce -> origination_nonce
| None ->
Contract.initial_origination_nonce
(Operation_hash.hash_string [ "FAKE " ; "FAKE" ; "FAKE" ]) in
(script, storage, input, amount, contract, max_gas, origination_nonce) in
register1 Services.Helpers.run_code
(fun ctxt () parameters ->
let (code, storage, input, amount, contract, gas, origination_nonce) =
run_parameters ctxt parameters in
Script_interpreter.execute
origination_nonce
contract (* transaction initiator *)
contract (* script owner *)
ctxt { storage ; code } amount input
(Gas.of_int gas) >>=? fun (sto, ret, _gas, _ctxt, _, maybe_big_map_diff) ->
Error_monad.return (sto, ret, Option.map ~f:Script_ir_translator.to_printable_big_map maybe_big_map_diff)) ;
register1 Services.Helpers.trace_code
(fun ctxt () parameters ->
let (code, storage, input, amount, contract, gas, origination_nonce) =
run_parameters ctxt parameters in
Script_interpreter.trace
origination_nonce
contract (* transaction initiator *)
contract (* script owner *)
ctxt { storage ; code } amount input
(Gas.of_int gas) >>=? fun ((sto, ret, _gas, _ctxt, _, maybe_big_map_diff), trace) ->
Error_monad.return (sto, ret, trace, Option.map ~f:Script_ir_translator.to_printable_big_map maybe_big_map_diff))
let () =
register1 Services.Helpers.typecheck_code
(fun ctxt () -> Script_ir_translator.typecheck_code ctxt)
let () =
register1 Services.Helpers.typecheck_data
(fun ctxt () -> Script_ir_translator.typecheck_data ctxt)
let () =
register1 Services.Helpers.hash_data
(fun ctxt () (expr, typ) ->
let open Script_ir_translator in
Lwt.return @@ parse_ty false (Micheline.root typ) >>=? fun (Ex_ty typ, _) ->
parse_data ctxt typ (Micheline.root expr) >>=? fun data ->
return (Script_ir_translator.hash_data typ data))
let () =
register2 Services.Helpers.level
(fun ctxt () raw offset -> return (Level.from_raw ctxt ?offset raw))
let () =
register2 Services.Helpers.levels
(fun ctxt () cycle () ->
let levels = Level.levels_in_cycle ctxt cycle in
let first = List.hd (List.rev levels) in
let last = List.hd levels in
return (first.level, last.level))
(*-- Helpers.Rights ----------------------------------------------------------*)
let default_max_baking_priority ctxt arg =
let default = Constants.first_free_baking_slot ctxt in
match arg with
| None -> 2 * default
| Some m -> m
let baking_rights ctxt level max =
let max = default_max_baking_priority ctxt max in
Baking.baking_priorities ctxt level >>=? fun contract_list ->
let rec loop l n =
match n with
| 0 -> return []
| n ->
let Misc.LCons (h, t) = l in
t () >>=? fun t ->
loop t (pred n) >>=? fun t ->
return (h :: t)
in
loop contract_list max >>=? fun prio ->
return (level.level, prio)
let () =
register1 Services.Helpers.Rights.baking_rights
(fun ctxt () max ->
let level = Level.current ctxt in
baking_rights ctxt level max >>=? fun (raw_level, slots) ->
begin
Lwt_list.filter_map_p (fun x -> x) @@
List.mapi
(fun prio c ->
let timestamp = Timestamp.current ctxt in
Baking.minimal_time ctxt prio timestamp >>= function
| Error _ -> Lwt.return None
| Ok minimal_timestamp -> Lwt.return (Some (c, minimal_timestamp)))
slots
end >>= fun timed_slots ->
return (raw_level, timed_slots))
let () =
register2 Services.Helpers.Rights.baking_rights_for_level
(fun ctxt () raw_level max ->
let level = Level.from_raw ctxt raw_level in
baking_rights ctxt level max)
let baking_rights_for_delegate
ctxt () contract (max_priority, min_level, max_level) =
let max_priority = default_max_baking_priority ctxt max_priority in
let current_level = Level.current ctxt in
let min_level = match min_level with
| None -> current_level
| Some l -> Level.from_raw ctxt l in
let max_level =
match max_level with
| Some max_level -> Level.from_raw ctxt max_level
| None ->
Level.last_level_in_cycle ctxt @@
current_level.cycle in
let rec loop level =
if Level.(>) level max_level
then return []
else
loop (Level.succ ctxt level) >>=? fun t ->
Baking.first_baking_priorities
ctxt ~max_priority contract level >>=? fun priorities ->
let raw_level = level.level in
Error_monad.map_s
(fun priority ->
let timestamp = Timestamp.current ctxt in
Baking.minimal_time ctxt priority timestamp >>=? fun time ->
return (raw_level, priority, time))
priorities >>=? fun priorities ->
return (priorities @ t)
in
loop min_level
let () =
register2 Services.Helpers.Rights.baking_rights_for_delegate
baking_rights_for_delegate
let default_max_endorsement_priority ctxt arg =
let default = Constants.max_signing_slot ctxt in
match arg with
| None -> default
| Some m -> m
let endorsement_rights ctxt level max =
let max = default_max_endorsement_priority ctxt max in
Baking.endorsement_priorities ctxt level >>=? fun contract_list ->
let rec loop l n =
match n with
| 0 -> return []
| n ->
let Misc.LCons (h, t) = l in
t () >>=? fun t ->
loop t (pred n) >>=? fun t ->
return (h :: t)
in
loop contract_list max >>=? fun prio ->
return (level.level, prio)
let () =
register1 Services.Helpers.Rights.endorsement_rights
(fun ctxt () max ->
let level = Level.current ctxt in
endorsement_rights ctxt (Level.succ ctxt level) max) ;
register2 Services.Helpers.Rights.endorsement_rights_for_level
(fun ctxt () raw_level max ->
let level = Level.from_raw ctxt raw_level in
endorsement_rights ctxt level max)
let endorsement_rights_for_delegate
ctxt () contract (max_priority, min_level, max_level) =
let current_level = Level.current ctxt in
let max_priority = default_max_endorsement_priority ctxt max_priority in
let min_level = match min_level with
| None -> Level.succ ctxt current_level
| Some l -> Level.from_raw ctxt l in
let max_level =
match max_level with
| None -> min_level
| Some l -> Level.from_raw ctxt l in
let rec loop level =
if Level.(>) level max_level
then return []
else
loop (Level.succ ctxt level) >>=? fun t ->
Baking.first_endorsement_slots
ctxt ~max_priority contract level >>=? fun slots ->
let raw_level = level.level in
let slots = List.rev_map (fun slot -> (raw_level, slot)) slots in
return (List.rev_append slots t)
in
loop min_level
let () =
register2 Services.Helpers.Rights.endorsement_rights_for_delegate
endorsement_rights_for_delegate
(*-- Helpers.Forge -----------------------------------------------------------*)
let operation_public_key ctxt = function
| None -> return None
| Some public_key ->
let hash = Ed25519.Public_key.hash public_key in
Delegates_pubkey.get_option ctxt hash >>=? function
| None -> return (Some public_key)
| Some _ -> return None
let forge_operations _ctxt () (shell, proto) =
return (Operation.forge shell proto)
let () = register1 Services.Helpers.Forge.operations forge_operations
let forge_block_proto_header _ctxt
(priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t =
return (Block_header.forge_unsigned_proto_header
{ priority ; seed_nonce_hash ; proof_of_work_nonce })
let () =
register1 Services.Helpers.Forge.block_proto_header
(fun ctxt () -> forge_block_proto_header ctxt)
(*-- Helpers.Parse -----------------------------------------------------------*)
let dummy_hash = Operation_hash.hash_bytes []
let check_signature ctxt signature shell contents =
match contents with
| Anonymous_operations _ -> return ()
| Sourced_operations (Manager_operations op) ->
begin
match op.public_key with
| Some key -> return key
| None ->
Contract.get_manager ctxt op.source >>=? fun manager ->
Delegates_pubkey.get ctxt manager
end >>=? fun public_key ->
Operation.check_signature public_key
{ signature ; shell ; contents ; hash = dummy_hash }
| Sourced_operations (Delegate_operations { source ; _ }) ->
Operation.check_signature source
{ signature ; shell ; contents ; hash = dummy_hash }
| Sourced_operations (Dictator_operation _) ->
let key = Constants.dictator_pubkey ctxt in
Operation.check_signature key
{ signature ; shell ; contents ; hash = dummy_hash }
let parse_operations ctxt () (operations, check) =
map_s begin fun raw ->
begin
Lwt.return
(Operation.parse (Operation.hash_raw raw) raw) >>=? fun op ->
begin match check with
| Some true -> check_signature ctxt op.signature op.shell op.contents
| Some false | None -> return ()
end >>|? fun () -> op
end
end operations
let () =
register1 Services.Helpers.Parse.operations parse_operations
let () =
register1 Services.Helpers.Parse.block
(fun _ctxt () raw_block ->
Lwt.return (Block_header.parse raw_block) >>=? fun { proto ; _ } ->
return proto)
(*****)
let rpc_services = !rpc_services

10
src/proto_alpha/lib_protocol/test/helpers/helpers_services.ml
View File

@ -7,17 +7,17 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
open Proto_alpha.Alpha_context open Proto_alpha
open Alpha_context
open Helpers_assert open Helpers_assert
let endorsement_rights ~tc () = let endorsement_rights ~tc () =
let level = Level.current tc in let level = Level.current tc in
Proto_alpha.Services_registration.endorsement_rights tc level None >>=?? fun (_, endorsers) -> Alpha_services.Delegate.endorsement_rights tc level None >>=?? fun (_, endorsers) ->
return @@ List.mapi (fun x i -> x, i) endorsers return @@ List.mapi (fun x i -> x, i) endorsers
let baking_rights ~tc () = let baking_rights ~tc () =
let level = Level.succ tc @@ Level.current tc in Alpha_services.Delegate.baking_rights tc () None >>=?? fun (_, bakers) ->
Proto_alpha.Services_registration.baking_rights tc level None >>=?? fun (_, bakers) -> return @@ List.mapi (fun x (i,_) -> x, i) bakers
return @@ List.mapi (fun x i -> x, i) bakers

4
src/proto_alpha/lib_protocol/test/test_endorsement.ml
View File

@ -49,7 +49,7 @@ let test_endorsement_payment () =
let open Proto_alpha.Alpha_context in let open Proto_alpha.Alpha_context in
get_tc_full root >>=? fun tc -> get_tc_full root >>=? fun tc ->
let level = Level.succ tc @@ Level.current tc in let level = Level.succ tc @@ Level.current tc in
Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) -> Alpha_services.Delegate.endorsement_rights tc level None >>=? fun (_, endorsers) ->
let aux (endorser_slot, block_priority) = let aux (endorser_slot, block_priority) =
let contract_p = let contract_p =
@ -98,7 +98,7 @@ let test_multiple_endorsement () =
Init.main () >>=? fun pred -> Init.main () >>=? fun pred ->
let tc = pred.tezos_context in let tc = pred.tezos_context in
let level = Level.current tc in let level = Level.current tc in
Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) -> Alpha_services.Delegate.endorsement_rights tc level None >>=? fun (_, endorsers) ->
let endorser = let endorser =
Misc.find_account Account.bootstrap_accounts Misc.find_account Account.bootstrap_accounts
@@ List.nth endorsers 0 in @@ List.nth endorsers 0 in