diff --git a/mismi-s3/src/Mismi/S3/Commands.hs b/mismi-s3/src/Mismi/S3/Commands.hs index 7eb448c..e434306 100644 --- a/mismi-s3/src/Mismi/S3/Commands.hs +++ b/mismi-s3/src/Mismi/S3/Commands.hs @@ -619,6 +619,12 @@ hoistDownloadError e = throwM $ DestinationNotDirectory f DownloadInvariant a b -> throwM $ Invariant (renderDownloadError $ DownloadInvariant a b) + DownloadAws a -> + throwM a + DownloadRunError (WorkerError a) -> + throwM a + DownloadRunError (BlowUpError a) -> + throwM a MultipartError (WorkerError a) -> throwM a MultipartError (BlowUpError a) -> @@ -700,15 +706,17 @@ downloadRecursiveWithMode mode src dest = do Left _ -> pure () Right st -> unless (isDirectory st) . left $ DownloadDestinationNotDirectory dest -- Real business starts here. - addrs <- lift $ listRecursively src - mapM_ drWorker addrs + e <- ask + bimapEitherT DownloadRunError id . void . newEitherT . liftIO $ + (consume (sinkQueue e (listRecursively' src)) 1 (drWorker e)) where - drWorker :: Address -> EitherT DownloadError AWS () - drWorker addr = do + drWorker :: Env -> Address -> IO (Either DownloadError ()) + drWorker env addr = runEitherT . runAWST env DownloadAws $ do fpdest <- hoistMaybe (DownloadInvariant addr src) $ (() dest) . T.unpack . unKey <$> removeCommonPrefix src addr downloadWithMode mode addr fpdest + downloadRecursive :: Address -> FilePath -> EitherT DownloadError AWS () downloadRecursive = downloadRecursiveWithMode Fail diff --git a/mismi-s3/src/Mismi/S3/Data.hs b/mismi-s3/src/Mismi/S3/Data.hs index 51e0842..7e95e1f 100644 --- a/mismi-s3/src/Mismi/S3/Data.hs +++ b/mismi-s3/src/Mismi/S3/Data.hs @@ -129,9 +129,13 @@ data DownloadError = | DownloadDestinationExists FilePath | DownloadDestinationNotDirectory FilePath | DownloadInvariant Address Address + | DownloadAws Error + | DownloadRunError (RunError DownloadError) | MultipartError (RunError Error) deriving Show +instance Exception DownloadError + renderDownloadError :: DownloadError -> Text renderDownloadError d = case d of @@ -145,6 +149,10 @@ renderDownloadError d = "Remove common prefix invariant: " <> "[" <> addressToText b <> "] is not a common prefix of " <> "[" <> addressToText a <> "]" + DownloadAws e -> + "AWS failure during 'download': " <> renderError e + DownloadRunError r -> + "Download error: " <> renderRunError r renderDownloadError MultipartError r -> "Multipart download error: " <> renderRunError r renderError