Shell: export fitness of the current mempool

src/lib_shell/prevalidator.ml

@@ -82,6 +82,8 @@ module type T = sig
     Operation.t Operation_hash.Map.t ->
     (Operation.t Operation_hash.Map.t * Block_hash.Set.t * Operation_hash.Set.t) Lwt.t
   val validation_result: types_state -> error Preapply_result.t
+
+  val fitness: unit -> Fitness.t Lwt.t
   val worker: worker Lwt.t
 
 end
@@ -691,6 +693,18 @@ module Make(Proto: Registered_protocol.T)(Arg: ARG): T = struct
       (Arg.limits, Arg.chain_db)
       (module Handlers)
 
+  let fitness () =
+    worker >>= fun w ->
+    let pv = Worker.state w in
+    begin
+      Lwt.return pv.validation_state >>=? fun state ->
+      Prevalidation.status state >>=? fun status ->
+      return status.block_result.fitness
+    end >>= function
+    | Ok fitness -> Lwt.return fitness
+    | Error _ ->
+        Lwt.return (State.Block.fitness pv.predecessor)
+
 end
 
 module ChainProto_registry =
@@ -769,6 +783,10 @@ let timestamp (t:t) =
   let pv = Prevalidator.Worker.state w in
   Lwt.return pv.timestamp
 
+let fitness (t:t) =
+  let module Prevalidator: T = (val t) in
+  Prevalidator.fitness ()
+
 let inject_operation (t:t) op =
   let module Prevalidator: T = (val t) in
   Prevalidator.worker >>= fun w ->

src/lib_shell/prevalidator.mli

@@ -78,6 +78,9 @@ val flush: t -> Block_hash.t -> unit tzresult Lwt.t
     reset of the prevalidation context *)
 val timestamp: t -> Time.t Lwt.t
 
+(** Returns the fitness of the current prevalidation context *)
+val fitness: t -> Fitness.t Lwt.t
+
 (** Returns the list of valid operations known to this prevalidation worker *)
 val operations: t -> error Preapply_result.t * Operation.t Operation_hash.Map.t