diff --git a/ocaml/idl/ocaml_backend/gen_api.ml b/ocaml/idl/ocaml_backend/gen_api.ml
index 01c49bdbe88..734e78d6bb6 100644
--- a/ocaml/idl/ocaml_backend/gen_api.ml
+++ b/ocaml/idl/ocaml_backend/gen_api.ml
@@ -72,6 +72,23 @@ let overrides =
     )
   ]
 
+(** Generate enum__all and enum_to_string bindings for all enums *)
+let gen_enum_helpers tys =
+  let gen_string_and_all = function
+    | DT.Set (DT.Enum (_, elist) as e) ->
+        let nlist = List.map fst elist in
+        [
+          Printf.sprintf "let %s__all = %s" (OU.alias_of_ty e)
+            (OU.ocaml_list_of_enum nlist)
+        ; (Printf.sprintf "let %s_to_string = %s")
+            (OU.alias_of_ty e)
+            (OU.ocaml_to_string_of_enum nlist)
+        ]
+    | _ ->
+        []
+  in
+  List.concat_map gen_string_and_all tys
+
 (** Generate a single type declaration for simple types (eg not containing references to record objects) *)
 let gen_non_record_type tys =
   let rec aux accu = function
@@ -382,6 +399,7 @@ let gen_client_types highapi =
        ; gen_non_record_type all_types
        ; gen_record_type ~with_module:true highapi
            (toposort_types highapi all_types)
+       ; gen_enum_helpers all_types
        ; O.Signature.strings_of (Gen_client.gen_signature highapi)
        ]
     )
diff --git a/ocaml/idl/ocaml_backend/ocaml_utils.ml b/ocaml/idl/ocaml_backend/ocaml_utils.ml
index e3ab8ac19dd..a01ae955586 100644
--- a/ocaml/idl/ocaml_backend/ocaml_utils.ml
+++ b/ocaml/idl/ocaml_backend/ocaml_utils.ml
@@ -58,9 +58,15 @@ let ocaml_of_record_field = function
 
 let ocaml_of_module_name x = String.capitalize_ascii x
 
+let ocaml_map_enum_ sep f list = String.concat sep (List.map f list)
+
 (** Convert an IDL enum into a polymorhic variant. *)
 let ocaml_of_enum list =
-  "[ " ^ String.concat " | " (List.map constructor_of list) ^ " ]"
+  Printf.sprintf "[%s]" (ocaml_map_enum_ " | " constructor_of list)
+
+(* Create a to_string function for a polymorphic variant. *)
+let ocaml_list_of_enum list =
+  Printf.sprintf "[%s]" (ocaml_map_enum_ "; " constructor_of list)
 
 (** Convert an IDL type to a function name; we need to generate functions to
     marshal/unmarshal from XML for each unique IDL type *)
@@ -90,6 +96,11 @@ let rec alias_of_ty = function
   | Option x ->
       sprintf "%s_option" (alias_of_ty x)
 
+(** Create the body of a to_string function for an enum *)
+let ocaml_to_string_of_enum list =
+  let single name = Printf.sprintf {|%s -> "%s"|} (constructor_of name) name in
+  Printf.sprintf "function %s" (ocaml_map_enum_ " | " single list)
+
 (** Convert an IDL type into a string containing OCaml code representing the
     type. *)
 let rec ocaml_of_ty = function
diff --git a/ocaml/tests/test_vm_check_operation_error.ml b/ocaml/tests/test_vm_check_operation_error.ml
index a91fdcfa229..0423338e630 100644
--- a/ocaml/tests/test_vm_check_operation_error.ml
+++ b/ocaml/tests/test_vm_check_operation_error.ml
@@ -1,54 +1,6 @@
-let all_vm_operations =
-  [
-    `assert_operation_valid
-  ; `awaiting_memory_live
-  ; `call_plugin
-  ; `changing_VCPUs
-  ; `changing_VCPUs_live
-  ; `changing_dynamic_range
-  ; `changing_memory_limits
-  ; `changing_memory_live
-  ; `changing_shadow_memory
-  ; `changing_shadow_memory_live
-  ; `changing_static_range
-  ; `changing_NVRAM
-  ; `checkpoint
-  ; `clean_reboot
-  ; `clean_shutdown
-  ; `clone
-  ; `copy
-  ; `create_template
-  ; `csvm
-  ; `data_source_op
-  ; `destroy
-  ; `export
-  ; `get_boot_record
-  ; `hard_reboot
-  ; `hard_shutdown
-  ; `import
-  ; `make_into_template
-  ; `metadata_export
-  ; `migrate_send
-  ; `pause
-  ; `pool_migrate
-  ; `power_state_reset
-  ; `provision
-  ; `query_services
-  ; `resume
-  ; `resume_on
-  ; `revert
-  ; `reverting
-  ; `send_sysrq
-  ; `send_trigger
-  ; `shutdown
-  ; `snapshot
-  ; `snapshot_with_quiesce
-  ; `start
-  ; `start_on
-  ; `suspend
-  ; `unpause
-  ; `update_allowed_operations
-  ]
+let vm_op_to_string = API.vm_operations_to_string
+
+let pp_vm_op () = Fmt.(str "%a" (of_to_string vm_op_to_string))
 
 let with_test_vm f =
   let __context = Mock.make_context_with_new_db "Mock context" in
@@ -75,7 +27,7 @@ let test_null_vdi () =
                ~strict:true
             )
         )
-        all_vm_operations
+        API.vm_operations__all
   )
 
 let test_vm_set_nvram_running () =
@@ -155,6 +107,71 @@ let test_sxm_allowed_when_rum () =
         )
   )
 
+let test_is_allowed_concurrently (expected, (op, current_ops)) =
+  let ops_to_str ops =
+    String.concat "," (List.map (fun (_, op) -> vm_op_to_string op) ops)
+  in
+  let name =
+    match current_ops with
+    | [] ->
+        vm_op_to_string op
+    | lst ->
+        Printf.sprintf "%a when %s" pp_vm_op op (ops_to_str lst)
+  in
+
+  let test () =
+    let actual = Xapi_vm_lifecycle.is_allowed_concurrently ~op ~current_ops in
+    let name =
+      Printf.sprintf "%a allowed in [%s]" pp_vm_op op (ops_to_str current_ops)
+    in
+    Alcotest.(check bool) name expected actual
+  in
+  (name, `Quick, test)
+
+let allowed_specs =
+  let current_of op = ((), op) in
+  let allow_hard_shutdown =
+    List.map
+      (fun op ->
+        let allowed = match op with `hard_shutdown -> false | _ -> true in
+        (allowed, (`hard_shutdown, [current_of op]))
+      )
+      API.vm_operations__all
+  in
+  let allow_hard_reboot =
+    List.map
+      (fun op ->
+        let allowed =
+          match op with `hard_shutdown | `hard_reboot -> false | _ -> true
+        in
+        (allowed, (`hard_reboot, [current_of op]))
+      )
+      API.vm_operations__all
+  in
+  let allow_clean_shutdown =
+    List.map
+      (fun op ->
+        let allowed = match op with `migrate_send -> true | _ -> false in
+        (allowed, (`clean_shutdown, [current_of op]))
+      )
+      API.vm_operations__all
+  in
+  List.concat
+    [
+      [
+        (true, (`snapshot, []))
+      ; (true, (`snapshot, [current_of `checkpoint]))
+      ; (false, (`migrate_send, [current_of `clean_reboot]))
+      ; (true, (`clean_reboot, [current_of `migrate_send]))
+      ]
+    ; allow_hard_shutdown
+    ; allow_clean_shutdown
+    ; allow_hard_reboot
+    ]
+
+let test_allow_concurrently =
+  List.map test_is_allowed_concurrently allowed_specs
+
 let test =
   [
     ("test_null_vdi", `Quick, test_null_vdi)
@@ -166,3 +183,7 @@ let test =
   ; ("test_sxm_allowed_when_rum", `Quick, test_sxm_allowed_when_rum)
   ; ("test_vm_set_nvram when VM is running", `Quick, test_vm_set_nvram_running)
   ]
+
+let () =
+  Alcotest.run "Xapi_vm_lifecycle"
+    [("is_allowed_concurrently", test_allow_concurrently)]
diff --git a/ocaml/xapi/xapi_host_helpers.ml b/ocaml/xapi/xapi_host_helpers.ml
index 040f5782273..00f01d83ed2 100644
--- a/ocaml/xapi/xapi_host_helpers.ml
+++ b/ocaml/xapi/xapi_host_helpers.ml
@@ -26,19 +26,7 @@ let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute
 
 let finally = Xapi_stdext_pervasives.Pervasiveext.finally
 
-let all_operations =
-  [
-    `provision
-  ; `evacuate
-  ; `reboot
-  ; `shutdown
-  ; `vm_start
-  ; `vm_resume
-  ; `vm_migrate
-  ; `power_on
-  ; `apply_updates
-  ; `enable
-  ]
+let all_operations = API.host_allowed_operations__all
 
 (** Returns a table of operations -> API error options (None if the operation would be ok) *)
 let valid_operations ~__context record _ref' =
diff --git a/ocaml/xapi/xapi_sr_operations.ml b/ocaml/xapi/xapi_sr_operations.ml
index b44c8bf5916..8f7a7d8012a 100644
--- a/ocaml/xapi/xapi_sr_operations.ml
+++ b/ocaml/xapi/xapi_sr_operations.ml
@@ -26,29 +26,7 @@ open Client
 
 open Record_util
 
-let all_ops : API.storage_operations_set =
-  [
-    `scan
-  ; `destroy
-  ; `forget
-  ; `plug
-  ; `unplug
-  ; `vdi_create
-  ; `vdi_destroy
-  ; `vdi_resize
-  ; `vdi_clone
-  ; `vdi_snapshot
-  ; `vdi_mirror
-  ; `vdi_enable_cbt
-  ; `vdi_disable_cbt
-  ; `vdi_data_destroy
-  ; `vdi_list_changed_blocks
-  ; `vdi_set_on_boot
-  ; `vdi_introduce
-  ; `update
-  ; `pbd_create
-  ; `pbd_destroy
-  ]
+let all_ops = API.storage_operations__all
 
 (* This list comes from https://github.com/xenserver/xen-api/blob/tampa-bugfix/ocaml/xapi/xapi_sr_operations.ml#L36-L38 *)
 let all_rpu_ops : API.storage_operations_set =
diff --git a/ocaml/xapi/xapi_vdi_helpers.ml b/ocaml/xapi/xapi_vdi_helpers.ml
index 2e3355ef1f4..6b4366a80ce 100644
--- a/ocaml/xapi/xapi_vdi_helpers.ml
+++ b/ocaml/xapi/xapi_vdi_helpers.ml
@@ -26,26 +26,7 @@ module D = Debug.Make (struct let name = "xapi_vdi_helpers" end)
 
 open D
 
-let all_ops : API.vdi_operations_set =
-  [
-    `blocked
-  ; `clone
-  ; `copy
-  ; `data_destroy
-  ; `destroy
-  ; `disable_cbt
-  ; `enable_cbt
-  ; `force_unlock
-  ; `forget
-  ; `generate_config
-  ; `list_changed_blocks
-  ; `mirror
-  ; `resize
-  ; `resize_online
-  ; `set_on_boot
-  ; `snapshot
-  ; `update
-  ]
+let all_ops = API.vdi_operations__all
 
 (* CA-26514: Block operations on 'unmanaged' VDIs *)
 let assert_managed ~__context ~vdi =
diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml
index 7d35a12f1d0..ccee66500cd 100644
--- a/ocaml/xapi/xapi_vm_lifecycle.ml
+++ b/ocaml/xapi/xapi_vm_lifecycle.ml
@@ -749,50 +749,41 @@ let vtpm_update_allowed_operations ~__context ~self =
   let allowed = match state with `Halted -> ops | _ -> [] in
   Db.VTPM.set_allowed_operations ~__context ~self ~value:allowed
 
+let ignored_ops =
+  [
+    `create_template
+  ; `power_state_reset
+  ; `csvm
+  ; `get_boot_record
+  ; `send_sysrq
+  ; `send_trigger
+  ; `query_services
+  ; `shutdown
+  ; `call_plugin
+  ; `changing_memory_live
+  ; `awaiting_memory_live
+  ; `changing_memory_limits
+  ; `changing_shadow_memory_live
+  ; `changing_VCPUs
+  ; `assert_operation_valid
+  ; `data_source_op
+  ; `update_allowed_operations
+  ; `import
+  ; `reverting
+  ]
+
+let allowable_ops =
+  List.filter (fun op -> not (List.mem op ignored_ops)) API.vm_operations__all
+
 let update_allowed_operations ~__context ~self =
-  let check_operation_error = check_operation_error ~__context ~ref:self in
   let check accu op =
-    match check_operation_error ~op ~strict:true with
+    match check_operation_error ~__context ~ref:self ~op ~strict:true with
     | None ->
         op :: accu
-    | _ ->
+    | Some _err ->
         accu
   in
-  let allowed =
-    List.fold_left check []
-      [
-        `snapshot
-      ; `copy
-      ; `clone
-      ; `revert
-      ; `checkpoint
-      ; `snapshot_with_quiesce
-      ; `start
-      ; `start_on
-      ; `pause
-      ; `unpause
-      ; `clean_shutdown
-      ; `clean_reboot
-      ; `hard_shutdown
-      ; `hard_reboot
-      ; `suspend
-      ; `resume
-      ; `resume_on
-      ; `export
-      ; `destroy
-      ; `provision
-      ; `changing_VCPUs_live
-      ; `pool_migrate
-      ; `migrate_send
-      ; `make_into_template
-      ; `changing_static_range
-      ; `changing_shadow_memory
-      ; `changing_dynamic_range
-      ; `changing_NVRAM
-      ; `create_vtpm
-      ; `metadata_export
-      ]
-  in
+  let allowed = List.fold_left check [] allowable_ops in
   (* FIXME: need to be able to deal with rolling-upgrade for orlando as well *)
   let allowed =
     if Helpers.rolling_upgrade_in_progress ~__context then