Teamwork: Prevent leaks with never_ending

Lwt_utils.never_ending is a global variable, hence a GC root. A promise
created by binding it cannot ever be garbage collected. This fixes the
known leak in the baker an endorser by allocating a fresh one for each
use (by turning it into a function). This porbably fix other slower
leaks.

High five Klakplok and Vincent.

src/lib_error_monad/error_monad.ml

@@ -623,7 +623,7 @@ type error += Canceled
 let protect ?on_error ?canceler t =
   let cancelation =
     match canceler with
-    | None -> Lwt_utils.never_ending
+    | None -> Lwt_utils.never_ending ()
     | Some canceler ->
         (Lwt_canceler.cancelation canceler >>= fun () ->
          fail Canceled ) in

src/lib_p2p/p2p.ml

@@ -234,7 +234,7 @@ module Real = struct
         ~f:begin fun _peer_id conn acc ->
           (P2p_pool.is_readable conn >>= function
             | Ok () -> Lwt.return (Some conn)
-            | Error _ -> Lwt_utils.never_ending) :: acc
+            | Error _ -> Lwt_utils.never_ending ()) :: acc
         end in
     Lwt.pick (
       ( P2p_pool.Pool_event.wait_new_connection net.pool >>= fun () ->
@@ -448,8 +448,8 @@ let faked_network peer_cfg faked_metadata = {
   global_stat = (fun () -> Fake.empty_stat) ;
   get_peer_metadata = (fun _ -> peer_cfg.peer_meta_initial) ;
   set_peer_metadata = (fun _ _ -> ()) ;
-  recv = (fun _ -> Lwt_utils.never_ending) ;
+  recv = (fun _ -> Lwt_utils.never_ending ()) ;
-  recv_any = (fun () -> Lwt_utils.never_ending) ;
+  recv_any = (fun () -> Lwt_utils.never_ending ()) ;
   send = (fun _ _ -> fail P2p_errors.Connection_closed) ;
   try_send = (fun _ _ -> false) ;
   fold_connections = (fun ~init ~f:_ -> init) ;

src/lib_stdlib/lwt_dropbox.ml

@@ -70,7 +70,7 @@ let rec take dropbox =
       if dropbox.closed then
         Lwt.fail Closed
       else
-        wait_put ~timeout:Lwt_utils.never_ending dropbox >>= fun () ->
+        wait_put ~timeout:(Lwt_utils.never_ending ()) dropbox >>= fun () ->
         take dropbox
 
 let rec take_with_timeout timeout dropbox =

src/lib_stdlib/lwt_utils.ml

@@ -16,7 +16,7 @@ let may ~f = function
   | None -> Lwt.return_unit
   | Some x -> f x
 
-let never_ending = fst (Lwt.wait ())
+let never_ending () = fst (Lwt.wait ())
 
 type trigger =
   | Absent

src/lib_stdlib/lwt_utils.mli

@@ -9,7 +9,7 @@
 
 val may: f:('a -> unit Lwt.t) -> 'a option -> unit Lwt.t
 
-val never_ending: 'a Lwt.t
+val never_ending: unit -> 'a Lwt.t
 
 val worker:
   string ->

src/proto_alpha/lib_delegate/client_baking_endorsement.ml

@@ -220,7 +220,7 @@ let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi
 
 let compute_timeout state =
   match state.to_endorse with
-  | [] -> Lwt_utils.never_ending
+  | [] -> Lwt_utils.never_ending ()
   | to_ends ->
       Lwt.choose (List.map (fun to_end -> to_end.timeout) to_ends)
 

src/proto_alpha/lib_delegate/client_baking_forge.ml

@@ -403,7 +403,7 @@ let compute_timeout { future_slots } =
   match future_slots with
   | [] ->
       (* No slots, just wait for new blocks which will give more info *)
-      Lwt_utils.never_ending
+      Lwt_utils.never_ending ()
   | (timestamp, _) :: _ ->
       match Client_baking_scheduling.sleep_until timestamp with
       | None ->