From dc89432aade268e0ec8bd91acfdd01bce4e744fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= <gregoire.henry@tezos.com>
Date: Fri, 23 Feb 2018 15:52:02 -0500
Subject: [PATCH] Proto/env: export `RPC_directory.opt_register`

---
 .../sigs/v1/RPC_directory.mli                 | 42 +++++++++++++++++++
 .../tezos_protocol_environment.ml             | 15 +++++++
 2 files changed, 57 insertions(+)

diff --git a/src/lib_protocol_environment/sigs/v1/RPC_directory.mli b/src/lib_protocol_environment/sigs/v1/RPC_directory.mli
index 763d19291..3049220db 100644
--- a/src/lib_protocol_environment/sigs/v1/RPC_directory.mli
+++ b/src/lib_protocol_environment/sigs/v1/RPC_directory.mli
@@ -39,6 +39,12 @@ val register:
   ('params -> 'query -> 'input -> 'output tzresult Lwt.t) ->
   'prefix directory
 
+val opt_register:
+  'prefix directory ->
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
+  ('params -> 'query -> 'input -> 'output option tzresult Lwt.t) ->
+  'prefix directory
+
 val gen_register:
   'prefix directory ->
   ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
@@ -89,6 +95,42 @@ val register5:
   ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o tzresult Lwt.t) ->
   'prefix directory
 
+val opt_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o option tzresult Lwt.t) ->
+  unit directory
+
+val opt_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
 val gen_register0:
   unit directory ->
   ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml
index 837f1b20f..99aa0c157 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment.ml
+++ b/src/lib_protocol_environment/tezos_protocol_environment.ml
@@ -290,6 +290,14 @@ module Make (Context : CONTEXT) = struct
              | Ok o -> RPC_answer.return o
              | Error e -> RPC_answer.fail e)
 
+      let opt_register dir service handler =
+        gen_register dir service
+          (fun p q i ->
+             handler p q i >>= function
+             | Ok (Some o) -> RPC_answer.return o
+             | Ok None -> RPC_answer.not_found
+             | Error e -> RPC_answer.fail e)
+
       let lwt_register dir service handler =
         gen_register dir service
           (fun p q i ->
@@ -305,6 +313,13 @@ module Make (Context : CONTEXT) = struct
       let register4 root s f = register root s (curry (S (S (S (S Z)))) f)
       let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f)
 
+      let opt_register0 root s f = opt_register root s (curry Z f)
+      let opt_register1 root s f = opt_register root s (curry (S Z) f)
+      let opt_register2 root s f = opt_register root s (curry (S (S Z)) f)
+      let opt_register3 root s f = opt_register root s (curry (S (S (S Z))) f)
+      let opt_register4 root s f = opt_register root s (curry (S (S (S (S Z)))) f)
+      let opt_register5 root s f = opt_register root s (curry (S (S (S (S (S Z))))) f)
+
       let gen_register0 root s f = gen_register root s (curry Z f)
       let gen_register1 root s f = gen_register root s (curry (S Z) f)
       let gen_register2 root s f = gen_register root s (curry (S (S Z)) f)