diff --git a/CHANGES.rst b/CHANGES.rst
index 04645569593769b28037fc54f27142472bdcc892..10d7cfebb3bc08c59ccb45446da505eb22049d2c 100644
--- a/CHANGES.rst
+++ b/CHANGES.rst
@@ -57,6 +57,9 @@ Node
 - Fixed a issue that may trigger unknown keys errors while reading the
   context on a read-only instance.
 
+- Add query parameter ``protocol`` to RPC ``/monitor/heads/<chain_id>`` in
+  order to monitor new heads of the current protocol (or multiple ones) only.
+
 Client
 ------
 
diff --git a/src/lib_shell/monitor_directory.ml b/src/lib_shell/monitor_directory.ml
index 30a61126c17bbaedb2c29b687463443de614d65f..8bda3712435661742267b7d5dcb8821b37be6fd3 100644
--- a/src/lib_shell/monitor_directory.ml
+++ b/src/lib_shell/monitor_directory.ml
@@ -251,29 +251,61 @@ let build_rpc_directory validator mainchain_validator =
           in
           let* head = Store.Chain.current_head chain_store in
           let shutdown () = Lwt_watcher.shutdown stopper in
-          let in_next_protocols block =
-            match q#next_protocols with
-            | [] -> Lwt.return_true
-            | protocols ->
-                let* context = Store.Block.context_exn chain_store block in
-                let* next_protocol = Context_ops.get_protocol context in
-                Lwt.return
-                  (List.exists (Protocol_hash.equal next_protocol) protocols)
+          let within_protocols header =
+            let find_protocol protocol_level =
+              let+ p = Store.Chain.find_protocol chain_store ~protocol_level in
+              WithExceptions.Option.to_exn
+                ~none:
+                  (Failure
+                     (Format.sprintf "Cannot find protocol %d" protocol_level))
+                p
+            in
+            let next_protocol (header : Block_header.t) =
+              find_protocol header.shell.proto_level
+            in
+            let current_protocol (header : Block_header.t) =
+              let* pred =
+                Store.Block.read_block chain_store header.shell.predecessor
+              in
+              match pred with
+              | Error e ->
+                  Format.kasprintf
+                    Stdlib.failwith
+                    "Cannot find current protocol because missing predecessor: \
+                     %a"
+                    pp_print_trace
+                    e
+              | Ok pred_block ->
+                  let pred_header = Store.Block.header pred_block in
+                  find_protocol pred_header.shell.proto_level
+            in
+            let within protocols get_protocol header =
+              match protocols with
+              | [] -> return_true
+              | _ ->
+                  let+ p = get_protocol header in
+                  List.exists (Protocol_hash.equal p) protocols
+            in
+            let* ok_next = within q#next_protocols next_protocol header in
+            let* ok_current = within q#protocols current_protocol header in
+            return (ok_current && ok_next)
           in
           let stream =
             Lwt_stream.filter_map_s
               (fun block ->
-                let* in_next_protocols = in_next_protocols block in
-                if in_next_protocols then
-                  Lwt.return_some
-                    (Store.Block.hash block, Store.Block.header block)
+                let header = Store.Block.header block in
+                let* within_protocols = within_protocols header in
+                if within_protocols then
+                  Lwt.return_some (Store.Block.hash block, header)
                 else Lwt.return_none)
               block_stream
           in
-          let* first_block_is_among_next_protocols = in_next_protocols head in
+          let* first_block_is_within_protocols =
+            within_protocols (Store.Block.header head)
+          in
           let first_call =
             (* Skip the first block if this is false *)
-            ref first_block_is_among_next_protocols
+            ref first_block_is_within_protocols
           in
           let next () =
             if !first_call then (
diff --git a/src/lib_shell_services/monitor_services.ml b/src/lib_shell_services/monitor_services.ml
index 6a668e87d893a2e2ed9c19fb44cd36f821646d7b..691f2b82a4680b1121a6b578b9d243872af137e4 100644
--- a/src/lib_shell_services/monitor_services.ml
+++ b/src/lib_shell_services/monitor_services.ml
@@ -145,10 +145,13 @@ module S = struct
 
   let heads_query =
     let open Tezos_rpc.Query in
-    query (fun next_protocols ->
+    query (fun protocols next_protocols ->
         object
+          method protocols = protocols
+
           method next_protocols = next_protocols
         end)
+    |+ multi_field "protocol" Protocol_hash.rpc_arg (fun t -> t#protocols)
     |+ multi_field "next_protocol" Protocol_hash.rpc_arg (fun t ->
            t#next_protocols)
     |> seal
@@ -241,12 +244,14 @@ let applied_blocks ctxt ?(chains = [`Main]) ?(protocols = [])
     end)
     ()
 
-let heads ctxt ?(next_protocols = []) chain =
+let heads ctxt ?(protocols = []) ?(next_protocols = []) chain =
   make_streamed_call
     S.heads
     ctxt
     ((), chain)
     (object
+       method protocols = protocols
+
        method next_protocols = next_protocols
     end)
     ()
diff --git a/src/lib_shell_services/monitor_services.mli b/src/lib_shell_services/monitor_services.mli
index a2635743d64ee58acfe48d46aa43316161049e0f..cf3ce8178a7417403396075001dd54b3b1b1aec9 100644
--- a/src/lib_shell_services/monitor_services.mli
+++ b/src/lib_shell_services/monitor_services.mli
@@ -89,6 +89,7 @@ val applied_blocks :
 
 val heads :
   #streamed ->
+  ?protocols:Protocol_hash.t list ->
   ?next_protocols:Protocol_hash.t list ->
   Chain_services.chain ->
   ((Block_hash.t * Block_header.t) Lwt_stream.t * stopper) tzresult Lwt.t
@@ -163,7 +164,8 @@ module S : sig
     ( [`GET],
       unit,
       unit * Chain_services.chain,
-      < next_protocols : Protocol_hash.t list >,
+      < protocols : Protocol_hash.t list
+      ; next_protocols : Protocol_hash.t list >,
       unit,
       Block_hash.t * Block_header.t )
     Tezos_rpc.Service.t