diff --git a/src/proto/alpha/operation_repr.ml b/src/proto/alpha/operation_repr.ml index 710745ce8..dda246eae 100644 --- a/src/proto/alpha/operation_repr.ml +++ b/src/proto/alpha/operation_repr.ml @@ -321,6 +321,19 @@ end type error += Cannot_parse_operation +let encoding = + let open Data_encoding in + conv + (fun { hash ; shell ; contents ; signature } -> + (hash, (shell, (contents, signature)))) + (fun (hash, (shell, (contents, signature))) -> + { hash ; shell ; contents ; signature }) + (merge_objs + (obj1 (req "hash" Operation_hash.encoding)) + (merge_objs + Updater.shell_operation_encoding + Encoding.signed_proto_operation_encoding)) + let () = register_error_kind `Branch diff --git a/src/proto/alpha/operation_repr.mli b/src/proto/alpha/operation_repr.mli index 1b19522f4..a808d4b70 100644 --- a/src/proto/alpha/operation_repr.mli +++ b/src/proto/alpha/operation_repr.mli @@ -83,6 +83,8 @@ and counter = Int32.t type error += Cannot_parse_operation (* `Branch *) +val encoding: operation Data_encoding.t + val parse: Operation_hash.t -> Updater.raw_operation -> operation tzresult diff --git a/src/proto/alpha/services.ml b/src/proto/alpha/services.ml index 5bfa98c7d..b78165e45 100644 --- a/src/proto/alpha/services.ml +++ b/src/proto/alpha/services.ml @@ -34,6 +34,15 @@ let wrap_tzerror encoding = (fun x -> Error x) ; ] + +let operations custom_root = + RPC.service + ~description: "All the operations of the block (parsed)." + ~input: empty + ~output: (wrap_tzerror @@ + (list (list (dynamic_size Operation.encoding)))) + RPC.Path.(custom_root / "operations") + module Constants = struct let cycle_length custom_root = diff --git a/src/proto/alpha/services_registration.ml b/src/proto/alpha/services_registration.ml index 7c3e3256e..0a1ed73f3 100644 --- a/src/proto/alpha/services_registration.ml +++ b/src/proto/alpha/services_registration.ml @@ -9,35 +9,65 @@ open Tezos_context -let rpc_init rpc_context = - let level = Int32.succ rpc_context.Updater.block_header.shell.level in - let timestamp = rpc_context.block_header.shell.timestamp in - let fitness = rpc_context.block_header.shell.fitness in - Tezos_context.init ~level ~timestamp ~fitness rpc_context.context +type rpc_context = { + block_hash: Block_hash.t ; + block_header: Updater.raw_block_header ; + operation_hashes: unit -> Operation_hash.t list list Lwt.t ; + operations: unit -> Updater.raw_operation list list Lwt.t ; + context: Tezos_context.t ; +} + +let rpc_init + ({ block_hash ; block_header ; + operation_hashes ; operations ; context } : Updater.rpc_context) = + let level = Int32.succ block_header.shell.level in + let timestamp = block_header.shell.timestamp in + let fitness = block_header.shell.fitness in + Tezos_context.init ~level ~timestamp ~fitness context >>=? fun context -> + return { block_hash ; block_header ; operation_hashes ; operations ; context } let rpc_services = ref (RPC.empty : Updater.rpc_context RPC.directory) -let register0 s f = + +let register0_fullctxt s f = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun ctxt () -> ( rpc_init ctxt >>=? fun ctxt -> f ctxt ) >>= RPC.Answer.return) -let register1 s f = +let register0 s f = register0_fullctxt s (fun { context } -> f context) + +let register1_fullctxt s f = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun ctxt arg -> ( rpc_init ctxt >>=? fun ctxt -> f ctxt arg ) >>= RPC.Answer.return) -let register2 s f = +let register1 s f = register1_fullctxt s (fun { context } x -> f context x) +let register1_noctxt s f = + rpc_services := + RPC.register !rpc_services (s RPC.Path.root) + (fun _ arg -> f arg >>= RPC.Answer.return) + +let register2_fullctxt s f = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun (ctxt, arg1) arg2 -> ( rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 ) >>= RPC.Answer.return) -let register1_noctxt s f = - rpc_services := - RPC.register !rpc_services (s RPC.Path.root) - (fun _ arg -> f arg >>= RPC.Answer.return) +let register2 s f = register2_fullctxt s (fun { context } x y -> f context x y) + + +(*-- 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) (*-- Constants ---------------------------------------------------------------*) @@ -149,7 +179,7 @@ let () = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun (ctxt, contract) arg -> - ( rpc_init ctxt >>=? fun ctxt -> + ( rpc_init ctxt >>=? fun { context = ctxt } -> Contract.exists ctxt contract >>=? function | true -> f ctxt contract arg | false -> raise Not_found ) >>= RPC.Answer.return) in diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli index 77f950b83..a374bd0fe 100644 --- a/src/proto/alpha/tezos_context.mli +++ b/src/proto/alpha/tezos_context.mli @@ -491,6 +491,8 @@ and counter = Int32.t module Operation : sig + val encoding: operation Data_encoding.t + type error += Cannot_parse_operation (* `Branch *) val parse: Operation_hash.t -> Updater.raw_operation -> operation tzresult diff --git a/src/proto/environment/error_monad.mli b/src/proto/environment/error_monad.mli index 7cc4e83bc..3e3ba17e8 100644 --- a/src/proto/environment/error_monad.mli +++ b/src/proto/environment/error_monad.mli @@ -88,6 +88,16 @@ val iter_s : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t (** A {!List.map} in the monad *) val map_s : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t +val map_p : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t + +(** A {!List.map2} in the monad *) +val map2 : + ('a -> 'b -> 'c tzresult) -> 'a list -> 'b list -> 'c list tzresult + +(** A {!List.map2} in the monad *) +val map2_s : + ('a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list -> + 'c list tzresult Lwt.t (** A {!List.map_filter} in the monad *) val map_filter_s : ('a -> 'b option tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t