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

Alpha/RPC: regroups /context/helpers/scripts

Browse Source
This commit is contained in:
Grégoire Henry 2018-04-21 15:45:11 +02:00 committed by Benjamin Canou
parent 32e40ec19a
commit 7e8f4341d7
7 changed files with 249 additions and 219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -104,7 +104,7 @@ let run
~(input : Michelson_v1_parser.parsed)
() =
get_contract cctxt ~chain block contract >>=? fun contract ->
Alpha_services.Helpers.run_code cctxt
Alpha_services.Helpers.Scripts.run_code cctxt
(chain, block)
program.expanded (storage.expanded, input.expanded, amount, contract)
@ -119,7 +119,7 @@ let trace
~(input : Michelson_v1_parser.parsed)
() =
get_contract cctxt ~chain block contract >>=? fun contract ->
Alpha_services.Helpers.trace_code cctxt
Alpha_services.Helpers.Scripts.trace_code cctxt
(chain, block)
program.expanded (storage.expanded, input.expanded, amount, contract)
@ -131,7 +131,7 @@ let hash_and_sign
(data : Michelson_v1_parser.parsed)
(typ : Michelson_v1_parser.parsed)
sk =
Alpha_services.Helpers.hash_data
Alpha_services.Helpers.Scripts.hash_data
cctxt (chain, block) (data.expanded, typ.expanded, gas) >>=? fun (hash, gas) ->
Client_keys.sign sk (MBytes.of_string hash) >>=? fun signature ->
return (hash, Signature.to_b58check signature, gas)
@ -144,7 +144,7 @@ let typecheck_data
~(data : Michelson_v1_parser.parsed)
~(ty : Michelson_v1_parser.parsed)
() =
Alpha_services.Helpers.typecheck_data
Alpha_services.Helpers.Scripts.typecheck_data
cctxt (chain, block)
(data.expanded, ty.expanded, gas)
@ -154,7 +154,7 @@ let typecheck_program
block
?gas
(program : Michelson_v1_parser.parsed) =
Alpha_services.Helpers.typecheck_code cctxt (chain, block) (program.expanded, gas)
Alpha_services.Helpers.Scripts.typecheck_code cctxt (chain, block) (program.expanded, gas)
let print_typecheck_result
~emacs ~show_types ~print_source_on_error

2
src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
View File

@ -199,7 +199,7 @@ let commands () =
@@ stop)
(fun custom_gas data typ cctxt ->
resolve_max_gas cctxt cctxt#block custom_gas >>=? fun original_gas ->
Alpha_services.Helpers.hash_data cctxt (`Main, cctxt#block)
Alpha_services.Helpers.Scripts.hash_data cctxt (`Main, cctxt#block)
(data.expanded, typ.expanded, Some original_gas) >>= function
| Ok (hash, remaining_gas) ->
cctxt#message "%S@,Gas remaining: %a" hash

1
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -418,6 +418,7 @@ module Level : sig
val last_level_in_cycle: context -> Cycle.t -> level
val levels_in_cycle: context -> Cycle.t -> level list
val levels_in_current_cycle: context -> ?offset:int32 -> unit -> level list
val last_allowed_fork_level: context -> Raw_level.t

139
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -34,36 +34,15 @@ let parse_operation (op: Operation.raw) =
ok { shell = op.shell ; protocol_data }
| None -> error Cannot_parse_operation
let custom_root = RPC_path.(open_root / "context" / "helpers")
let path = RPC_path.(open_root / "context" / "helpers")
module S = struct
module Scripts = struct
module S = struct
open Data_encoding
type level_query = {
offset: int32 ;
}
let level_query : level_query RPC_query.t =
let open RPC_query in
query (fun offset -> { offset })
|+ field "offset" RPC_arg.int32 0l (fun t -> t.offset)
|> seal
let level =
RPC_service.get_service
~description: "..."
~query: level_query
~output: Level.encoding
RPC_path.(custom_root / "level")
let levels =
RPC_service.get_service
~description: "Levels of a cycle"
~query: RPC_query.empty
~output: (obj2
(req "first" Raw_level.encoding)
(req "last" Raw_level.encoding))
RPC_path.(custom_root / "levels_in_cycle" /: Cycle.arg)
let path = RPC_path.(path / "scripts")
let run_code_input_encoding =
(obj5
@ -82,7 +61,7 @@ module S = struct
(req "storage" Script.expr_encoding)
(req "operations" (list Operation.internal_operation_encoding))
(opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
RPC_path.(custom_root / "run_code")
RPC_path.(path / "run_code")
let trace_code =
RPC_service.post_service
@ -99,7 +78,7 @@ module S = struct
(req "gas" Gas.encoding)
(req "stack" (list (Script.expr_encoding)))))
(opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
RPC_path.(custom_root / "trace_code")
RPC_path.(path / "trace_code")
let typecheck_code =
RPC_service.post_service
@ -111,7 +90,7 @@ module S = struct
~output: (obj2
(req "type_map" Script_tc_errors_registration.type_map_enc)
(req "gas" Gas.encoding))
RPC_path.(custom_root / "typecheck_code")
RPC_path.(path / "typecheck_code")
let typecheck_data =
RPC_service.post_service
@ -123,7 +102,7 @@ module S = struct
(req "type" Script.expr_encoding)
(opt "gas" z))
~output: (obj1 (req "gas" Gas.encoding))
RPC_path.(custom_root / "typecheck_data")
RPC_path.(path / "typecheck_data")
let hash_data =
RPC_service.post_service
@ -138,22 +117,12 @@ module S = struct
(req "hash" string)
(req "gas" Gas.encoding))
~query: RPC_query.empty
RPC_path.(custom_root / "hash_data")
RPC_path.(path / "hash_data")
end
end
let () =
let () =
let open Services_registration in
register0 S.level begin fun ctxt q () ->
let level = Level.current ctxt in
return (Level.from_raw ctxt ~offset:q.offset level.level)
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 ;
register0 S.run_code begin fun ctxt ()
(code, storage, parameter, amount, contract) ->
Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt ->
@ -209,46 +178,40 @@ let () =
return (hash, Gas.level ctxt)
end
let level ctxt ?(offset = 0l) block =
RPC_context.make_call0 S.level ctxt block { offset } ()
let levels ctxt block cycle =
RPC_context.make_call1 S.levels ctxt block cycle () ()
let run_code ctxt block code (storage, input, amount, contract) =
let run_code ctxt block code (storage, input, amount, contract) =
RPC_context.make_call0 S.run_code ctxt
block () (code, storage, input, amount, contract)
let trace_code ctxt block code (storage, input, amount, contract) =
let trace_code ctxt block code (storage, input, amount, contract) =
RPC_context.make_call0 S.trace_code ctxt
block () (code, storage, input, amount, contract)
let typecheck_code ctxt block =
let typecheck_code ctxt block =
RPC_context.make_call0 S.typecheck_code ctxt block ()
let typecheck_data ctxt block =
let typecheck_data ctxt block =
RPC_context.make_call0 S.typecheck_data ctxt block ()
let hash_data ctxt block =
let hash_data ctxt block =
RPC_context.make_call0 S.hash_data ctxt block ()
end
module Forge = struct
module S = struct
open Data_encoding
let custom_root = RPC_path.(custom_root / "forge")
let path = RPC_path.(path / "forge")
let operations =
RPC_service.post_service
~description:"Forge an operation"
~query: RPC_query.empty
~input: Operation.unsigned_encoding
~output:
(obj1
(req "operation" bytes))
RPC_path.(custom_root / "operations" )
~output: bytes
RPC_path.(path / "operations" )
let empty_proof_of_work_nonce =
MBytes.of_string
@ -267,7 +230,7 @@ module Forge = struct
Alpha_context.Constants.proof_of_work_nonce_size)
empty_proof_of_work_nonce))
~output: (obj1 (req "protocol_data" bytes))
RPC_path.(custom_root / "protocol_data")
RPC_path.(path / "protocol_data")
end
@ -434,7 +397,7 @@ module Parse = struct
open Data_encoding
let custom_root = RPC_path.(custom_root / "parse")
let path = RPC_path.(path / "parse")
let operations =
RPC_service.post_service
@ -445,7 +408,7 @@ module Parse = struct
(req "operations" (list (dynamic_size Operation.raw_encoding)))
(opt "check_signature" bool))
~output: (list (dynamic_size Operation.encoding))
RPC_path.(custom_root / "operations" )
RPC_path.(path / "operations" )
let block =
RPC_service.post_service
@ -453,7 +416,7 @@ module Parse = struct
~query: RPC_query.empty
~input: Block_header.raw_encoding
~output: Block_header.protocol_data_encoding
RPC_path.(custom_root / "block" )
RPC_path.(path / "block" )
end
@ -527,3 +490,53 @@ module Parse = struct
S.block ctxt block () ({ shell ; protocol_data } : Block_header.raw)
end
module S = struct
open Data_encoding
type level_query = {
offset: int32 ;
}
let level_query : level_query RPC_query.t =
let open RPC_query in
query (fun offset -> { offset })
|+ field "offset" RPC_arg.int32 0l (fun t -> t.offset)
|> seal
let level =
RPC_service.get_service
~description: "..."
~query: level_query
~output: Level.encoding
RPC_path.(path / "level")
let levels =
RPC_service.get_service
~description: "Levels of a cycle"
~query: level_query
~output: (obj2
(req "first" Raw_level.encoding)
(req "last" Raw_level.encoding))
RPC_path.(path / "levels_in_current_cycle")
end
let () =
let open Services_registration in
register0 S.level begin fun ctxt q () ->
let level = Level.current ctxt in
return (Level.from_raw ctxt ~offset:q.offset level.level)
end ;
register0 S.levels begin fun ctxt q () ->
let levels = Level.levels_in_current_cycle ctxt ~offset:q.offset () in
let first = List.hd (List.rev levels) in
let last = List.hd levels in
return (first.level, last.level)
end
let level ctxt ?(offset = 0l) block =
RPC_context.make_call0 S.level ctxt block { offset } ()
let levels ctxt block cycle =
RPC_context.make_call1 S.levels ctxt block cycle () ()

15
src/proto_alpha/lib_protocol/src/helpers_services.mli
View File

@ -21,7 +21,9 @@ val levels:
'a #RPC_context.simple ->
'a -> Cycle.t -> (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
val run_code:
module Scripts : sig
val run_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t * Contract.t) ->
@ -29,7 +31,7 @@ val run_code:
internal_operation list *
Contract.big_map_diff option) shell_tzresult Lwt.t
val trace_code:
val trace_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t * Contract.t) ->
@ -38,19 +40,22 @@ val trace_code:
Script_interpreter.execution_trace *
Contract.big_map_diff option) shell_tzresult Lwt.t
val typecheck_code:
val typecheck_code:
'a #RPC_context.simple ->
'a -> (Script.expr * Z.t option) ->
(Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t
val typecheck_data:
val typecheck_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr * Z.t option -> Gas.t shell_tzresult Lwt.t
val hash_data:
val hash_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr * Z.t option -> (string * Gas.t) shell_tzresult Lwt.t
end
module Forge : sig
module Manager : sig

13
src/proto_alpha/lib_protocol/src/level_storage.ml
View File

@ -56,8 +56,8 @@ let last_level_in_cycle ctxt c =
| None -> assert false
| Some x -> x
let levels_in_cycle ctxt c =
let first = first_level_in_cycle ctxt c in
let levels_in_cycle ctxt cycle =
let first = first_level_in_cycle ctxt cycle in
let rec loop n acc =
if Cycle_repr.(n.cycle = first.cycle)
then loop (succ ctxt n) (n :: acc)
@ -65,6 +65,15 @@ let levels_in_cycle ctxt c =
in
loop first []
let levels_in_current_cycle ctxt ?(offset = 0l) () =
let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in
let cycle = Int32.add current_cycle offset in
if Compare.Int32.(cycle < 0l) then
[]
else
let cycle = Cycle_repr.of_int32_exn cycle in
levels_in_cycle ctxt cycle
let levels_with_commitments_in_cycle ctxt c =
let first = first_level_in_cycle ctxt c in
let rec loop n acc =

2
src/proto_alpha/lib_protocol/src/level_storage.mli
View File

@ -19,6 +19,8 @@ val succ: Raw_context.t -> Level_repr.t -> Level_repr.t
val first_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
val last_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
val levels_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t list
val levels_in_current_cycle:
Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list
val levels_with_commitments_in_cycle:
Raw_context.t -> Cycle_repr.t -> Level_repr.t list