Try to publish the release asset again after it failed

CHANGES.md

@@ -4,6 +4,7 @@
 
 - Add a `--token` option to `dune-release publish` and `dune-release opam` commands to specify a github token. This allows dune-release to be called through a Github Actions workflow and use the github token through an environment variable. (#284, @gpetiot)
 - Log curl calls on verbose/debug mode (#281, @gpetiot)
+- Try to publish the release asset again after it failed (#272, @gpetiot)
 
 ### Changed
 

lib/github.ml

@@ -197,14 +197,18 @@ let curl_create_release ~token ~dry_run version msg user repo =
   run_with_auth ~dry_run ~default_body ~auth curl_t
   >>= Github_v3_api.Release_response.release_id
 
-let curl_upload_archive ~token ~dry_run archive user repo release_id =
+let curl_upload_archive ~token ~dry_run ~yes archive user repo release_id =
   let curl_t = Curl.upload_archive ~archive ~user ~repo ~release_id in
   github_auth ~dry_run ~user token >>= fun auth ->
   let default_body =
     `Assoc [ ("browser_download_url", `String D.download_url) ]
   in
-  run_with_auth ~dry_run ~default_body ~auth curl_t
-  >>= Github_v3_api.Upload_response.browser_download_url
+  Prompt.try_again ~yes ~default_answer:Prompt.Yes
+    ~question:(fun l ->
+      l "Uploading %a as release asset failed. Try again?" Text.Pp.path archive)
+    (fun () ->
+      run_with_auth ~dry_run ~default_body ~auth curl_t
+      >>= Github_v3_api.Upload_response.browser_download_url)
 
 let open_pr ~token ~dry_run ~title ~distrib_user ~user ~branch ~opam_repo body =
   let curl_t = Curl.open_pr ~title ~user ~branch ~body ~opam_repo in
@@ -280,7 +284,7 @@ let publish_distrib ?token ?distrib_uri ~dry_run ~msg ~archive ~yes p =
   App_log.status (fun l ->
       l "Uploading %a as a release asset for %a via github's API" Text.Pp.path
         archive Text.Pp.version tag);
-  curl_upload_archive ~token ~dry_run archive user repo id
+  curl_upload_archive ~token ~dry_run ~yes archive user repo id
 
 (*---------------------------------------------------------------------------
    Copyright (c) 2016 Daniel C. Bünzli

lib/prompt.ml

@@ -1,5 +1,7 @@
 type answer = Yes | No
 
+open Bos_setup.R.Infix
+
 let ask f ~default_answer =
   let options : ('a, Format.formatter, unit, unit) format4 =
     match default_answer with Yes -> " [Y/n]" | No -> " [y/N]"
@@ -27,3 +29,12 @@ let confirm ~question ~yes ~default_answer =
 let confirm_or_abort ~question ~yes ~default_answer =
   if confirm ~question ~yes ~default_answer then Ok ()
   else Error (`Msg "Aborting on user demand")
+
+let rec try_again ?(limit = 1) ~question ~yes ~default_answer f =
+  match f () with
+  | Ok x -> Ok x
+  | Error (`Msg err) when limit > 0 ->
+      App_log.unhappy (fun l -> l "%s" err);
+      confirm_or_abort ~yes ~question ~default_answer >>= fun () ->
+      try_again ~limit:(limit - 1) ~question ~yes ~default_answer f
+  | Error x -> Error x

lib/prompt.mli

@@ -17,3 +17,15 @@ val confirm_or_abort :
   (unit, Rresult.R.msg) result
 (** Same as [confirm] but returns [Ok ()] for yes and
     [Error (`Msg "Aborting on user demand")] for no *)
+
+val try_again :
+  ?limit:int ->
+  question:('a, unit) Logs.msgf ->
+  yes:bool ->
+  default_answer:answer ->
+  (unit -> ('b, Rresult.R.msg) result) ->
+  ('b, Rresult.R.msg) result
+(** [try_again ?limit ~question ~yes ~default_answer f] prompts the user to try
+    running [f] again if it failed, until [f] eventually succeeds or the user
+    aborts the process by answering no or the maximum number of retries [limit]
+    is reached (retries only once by default). *)