hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve error handling in download

Browse Source 
When download fails, delete the partial file, so it
doesn't corrupt the cache.
This commit is contained in:
Julian Ospald 2020-03-17 23:21:38 +01:00
parent e77ed1a26c
commit c7a831a280
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lib/GHCup/Download.hs
View File

@ -135,10 +135,9 @@ getDownloads urlSource = do
L.ByteString L.ByteString
smartDl uri' = do smartDl uri' = do
let path = view pathL' uri' let path = view pathL' uri'
cacheDir <- liftIO $ ghcupCacheDir cacheDir <- liftIO $ ghcupCacheDir
json_file <- (cacheDir </>) <$> urlBaseName path json_file <- (cacheDir </>) <$> urlBaseName path
e <- e <- liftIO $ doesFileExist json_file
liftIO $ doesFileExist json_file
if e if e
then do then do
accessTime <- accessTime <-
@ -300,8 +299,14 @@ download dli dest mfn
-- download -- download
fd <- liftIO $ createRegularFileFd newFilePerms destFile fd <- liftIO $ createRegularFileFd newFilePerms destFile
let stepper = fdWrite fd let stepper = fdWrite fd
flip finally (liftIO $ closeFd fd) flip onException
$ reThrowAll DownloadFailed (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
$ flip finally (liftIO $ closeFd fd)
$ catchAllE
(\e ->
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
>> (throwE . DownloadFailed $ e)
)
$ downloadInternal True https host fullPath port stepper $ downloadInternal True https host fullPath port stepper
liftE $ checkDigest dli destFile liftE $ checkDigest dli destFile