input-output-hk/foliage
1
1
Fork 0
mirror of https://github.com/input-output-hk/foliage.git synced 2024-10-05 16:37:48 +03:00
Code Issues Packages Projects Releases Wiki Activity

Retry few times if curl fails

Browse Source
This commit is contained in:
Andrea Bedini 2023-09-05 13:31:05 +08:00 committed by Andrea Bedini
parent d265965889
commit e6de3b29bc
1 changed files with 53 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
app/Foliage/RemoteAsset.hs
View File

@ -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}