Retry few times if curl fails

input-output-hk · Sep 11, 2023 · e6de3b2 · e6de3b2
1 parent d265965
commit e6de3b2
Showing 1 changed file with 53 additions and 47 deletions.
diff --git a/app/Foliage/RemoteAsset.hs b/app/Foliage/RemoteAsset.hs
@@ -58,58 +58,64 @@ addFetchRemoteAssetRule cacheDir = addBuiltinRule noLint noIdentity run
 
       newETag <-
         withTempFile $ \etagFile -> do
-          liftIO $ BS.writeFile etagFile oldETag
           liftIO $ createDirectoryIfMissing True (takeDirectory path)
-          (Exit exitCode, Stdout out) <-
-            traced "curl" $
-              cmd
-                Shell
-                [ "curl",
-                  -- Silent or quiet mode. Do not show progress meter or error messages. Makes Curl mute.
-                  "--silent",
-                  -- Fail fast with no output at all on server errors.
-                  "--fail",
-                  -- If the server reports that the requested page has moved to a different location this
-                  -- option will make curl redo the request on the new place.
-                  -- NOTE: This is needed because github always replies with a redirect
-                  "--location",
-                  -- This  option  makes  a conditional HTTP request for the specific ETag read from the
-                  -- given file by sending a custom If-None-Match header using the stored ETag.
-                  -- For correct results, make sure that the specified file contains only a single line
-                  -- with the desired ETag. An empty file is parsed as an empty ETag.
-                  "--etag-compare",
-                  etagFile,
-                  -- This option saves an HTTP ETag to the specified file. If no ETag is sent by the server,
-                  -- an empty file is created.
-                  "--etag-save",
-                  etagFile,
-                  -- Write output to <file> instead of stdout.
-                  "--output",
-                  path,
-                  "--write-out",
-                  "%{json}",
-                  -- URL to fetch
-                  show uri
-                ]
-          case exitCode of
-            ExitSuccess -> liftIO $ BS.readFile etagFile
-            ExitFailure c -> do
-              -- We show the curl exit code only if we cannot parse curl's write-out.
-              -- If we can parse it, we can craft a better error message.
-              case Aeson.eitherDecode out :: Either String CurlWriteOut of
-                Left err ->
-                  error $
-                    unlines
-                      [ "curl failed with return code " ++ show c ++ " while fetching " ++ show uri,
-                        "Error while reading curl diagnostic: " ++ err
-                      ]
-                -- We can consider displaying different messages based on some fields (e.g. response_code)
-                Right CurlWriteOut {errormsg} ->
-                  error errormsg
+          liftIO $ BS.writeFile etagFile oldETag
+          actionRetry 5 $ runCurl uri path etagFile
 
       let changed = if newETag == oldETag then ChangedRecomputeSame else ChangedRecomputeDiff
       return $ RunResult {runChanged = changed, runStore = newETag, runValue = path}
 
+runCurl :: URI -> String -> String -> Action ETag
+runCurl uri path etagFile = do
+  (Exit exitCode, Stdout out) <-
+    traced "curl" $
+      cmd
+        Shell
+        [ "curl",
+          -- Silent or quiet mode. Do not show progress meter or error messages. Makes Curl mute.
+          "--silent",
+          -- Fail fast with no output at all on server errors.
+          "--fail",
+          -- If the server reports that the requested page has moved to a different location this
+          -- option will make curl redo the request on the new place.
+          -- NOTE: This is needed because github always replies with a redirect
+          "--location",
+          -- This  option  makes  a conditional HTTP request for the specific ETag read from the
+          -- given file by sending a custom If-None-Match header using the stored ETag.
+          -- For correct results, make sure that the specified file contains only a single line
+          -- with the desired ETag. An empty file is parsed as an empty ETag.
+          "--etag-compare",
+          etagFile,
+          -- This option saves an HTTP ETag to the specified file. If no ETag is sent by the server,
+          -- an empty file is created.
+          "--etag-save",
+          etagFile,
+          -- Write output to <file> instead of stdout.
+          "--output",
+          path,
+          "--write-out",
+          "%{json}",
+          -- URL to fetch
+          show uri
+        ]
+  case exitCode of
+    ExitSuccess -> liftIO $ BS.readFile etagFile
+    ExitFailure c -> do
+      -- We show the curl exit code only if we cannot parse curl's write-out.
+      -- If we can parse it, we can craft a better error message.
+      case Aeson.eitherDecode out :: Either String CurlWriteOut of
+        Left err ->
+          error $
+            unlines
+              [ "curl failed with return code " ++ show c ++ " while fetching " ++ show uri,
+                "Error while reading curl diagnostic: " ++ err
+              ]
+        -- We can consider displaying different messages based on some fields (e.g. response_code)
+        Right CurlWriteOut {errormsg} ->
+          error errormsg
+
+type ETag = BS.ByteString
+
 -- Add what you need. See https://everything.curl.dev/usingcurl/verbose/writeout.
 newtype CurlWriteOut = CurlWriteOut
   {errormsg :: String}