Merge pull request #376 from ambiata/topic/recursuve-download

Recursive download

Author: erikd-ambiata

lib/x

@@ -69,7 +69,7 @@ data UnitPrefix =
 
 data Command =
     Upload FilePath Address WriteMode
-  | Download Address FilePath
+  | Download Recursive Address FilePath
   | Copy Address Address WriteMode
   | Concat [Address] Address WriteMode Int
   | Move Address Address
@@ -128,8 +128,10 @@ run c = do
   orDie O.renderError . O.runAWS e' $ case c of
     Upload s d m ->
       uploadWithModeOrFail m s d
-    Download s d ->
+    Download NotRecursive s d ->
       renderExit renderDownloadError . download s . optAppendFileName d $ key s
+    Download Recursive s d ->
+      renderExit renderDownloadError $ downloadRecursive s d
     Copy s d m ->
       renderExit renderCopyError $ copyWithMode m s d
     Concat ss d m f ->
@@ -165,6 +167,7 @@ sizeRecursive root d p =
       bytes <- sizeRecursively' root $$ DC.map sizedBytes =$= DC.fold (+) 0
       liftIO . T.putStrLn $ renderSizedAddress p (Sized bytes root)
 
+
 renderSizedAddress :: UnitPrefix -> Sized Address -> Text
 renderSizedAddress p (Sized bytes address) =
   let
@@ -299,7 +302,7 @@ commandP' f = XOA.subparser $
               (Upload <$> filepath' <*> address' <*> writeMode' f)
   <> command' "download"
               "Download a file from s3."
-              (Download <$> address' <*> filepath')
+              (Download <$> recursive' <*> address' <*> filepath')
   <> command' "copy"
               "Copy a file from an S3 address to another S3 address."
               (Copy <$> address' <*> address' <*> writeMode' f)

mismi-cli/main/s3.hs

@@ -41,6 +41,10 @@ module Mismi.S3.Commands (
   , downloadWithModeOrFail
   , downloadSingle
   , downloadWithRange
+  , downloadRecursive
+  , downloadRecursiveOrFail
+  , downloadRecursiveWithMode
+  , downloadRecursiveWithModeOrFail
   , multipartDownload
   , listMultipartParts
   , listMultiparts
@@ -63,12 +67,13 @@ module Mismi.S3.Commands (
 import           Control.Arrow ((***))
 
 import           Control.Exception (ioError)
+import qualified Control.Exception as CE
 import           Control.Lens ((.~), (^.), to, view)
 import           Control.Monad.Catch (throwM, onException)
 import           Control.Monad.Trans.Class (lift)
 import           Control.Monad.Trans.Resource (ResourceT, allocate, runResourceT)
 import           Control.Monad.Reader (ask)
-import           Control.Monad.IO.Class (liftIO)
+import           Control.Monad.IO.Class (MonadIO, liftIO)
 
 import qualified Data.ByteString as BS
 import           Data.Conduit (Conduit, Source, ResumableSource)
@@ -108,9 +113,11 @@ import           P
 
 import           System.IO (IO, IOMode (..), SeekMode (..))
 import           System.IO (hFileSize, hSetFileSize, withFile)
+import           System.IO.Error (IOError)
 import           System.Directory (createDirectoryIfMissing, doesFileExist)
-import           System.FilePath (FilePath, takeDirectory)
+import           System.FilePath (FilePath, (</>), takeDirectory)
 import           System.Posix.IO (OpenMode(..), openFd, closeFd, fdSeek, defaultFileFlags)
+import           System.Posix.Files (getFileStatus, isDirectory)
 import qualified "unix-bytestring" System.Posix.IO.ByteString as UBS
 
 import           System.Timeout.Lifted (timeout)
@@ -119,7 +126,8 @@ import           System.IO.Error (userError)
 import           Twine.Data.Queue (writeQueue)
 import           Twine.Parallel (RunError (..), consume)
 
-import           X.Control.Monad.Trans.Either (EitherT, eitherT, left, right, bimapEitherT, runEitherT, newEitherT)
+import           X.Control.Monad.Trans.Either (EitherT, eitherT, left, right, bimapEitherT, hoistMaybe
+                                                , runEitherT, newEitherT)
 
 import qualified X.Data.Conduit.Binary as XB
 
@@ -549,6 +557,10 @@ hoistDownloadError e =
       throwM $ SourceMissing DownloadError a
     DownloadDestinationExists f ->
       throwM $ DestinationFileExists f
+    DownloadDestinationNotDirectory f ->
+      throwM $ DestinationNotDirectory f
+    DownloadInvariant a b ->
+      throwM $ Invariant (renderDownloadError $ DownloadInvariant a b)
     MultipartError (WorkerError a) ->
       throwM a
     MultipartError (BlowUpError a) ->
@@ -622,6 +634,37 @@ downloadWithRange a start end dest = withRetries 5 $ do
     Just () -> pure ()
     Nothing -> liftIO $ ioError (userError "downloadWithRange timeout")
 
+downloadRecursiveWithMode :: WriteMode -> Address -> FilePath -> EitherT DownloadError AWS ()
+downloadRecursiveWithMode mode src dest = do
+  -- Check if the destination already exists and is not a directory.
+  es <- tryIO $ getFileStatus dest
+  case es of
+    Left _ -> pure ()
+    Right st -> unless (isDirectory st) . left $ DownloadDestinationNotDirectory dest
+  -- Real business starts here.
+  addrs <- lift $ listRecursively src
+  mapM_ drWorker addrs
+  where
+    tryIO :: MonadIO m => IO a -> m (Either IOError a)
+    tryIO = liftIO . CE.try
+
+    drWorker :: Address -> EitherT DownloadError AWS ()
+    drWorker addr = 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
+
+downloadRecursiveOrFail :: Address -> FilePath -> AWS ()
+downloadRecursiveOrFail a f =
+  eitherT hoistDownloadError pure $ downloadRecursive a f
+
+downloadRecursiveWithModeOrFail :: WriteMode -> Address -> FilePath -> AWS ()
+downloadRecursiveWithModeOrFail m a f =
+  eitherT hoistDownloadError pure $ downloadRecursiveWithMode m a f
 
 listMultipartParts :: Address -> Text -> AWS [Part]
 listMultipartParts a uploadId = do

mismi-s3/src/Mismi/S3/Commands.hs

@@ -74,6 +74,8 @@ data S3Error =
   | DestinationAlreadyExists Address
   | DestinationDoesNotExist Address
   | DestinationFileExists FilePath
+  | DestinationNotDirectory FilePath
+  | DestinationMissing FilePath
   | AccessDenied Address
   | Invariant Text
   | Target Address Address
@@ -94,6 +96,10 @@ s3ErrorRender s3err = "[Mismi internal error] - " <> case s3err of
     "Can not upload to an address that already exists [" <> addressToText a <> "]"
   DestinationFileExists f ->
     "Can not download to a target that already exists [" <> T.pack f <> "]"
+  DestinationNotDirectory f ->
+    "Expecting destination " <> T.pack f <> " to be a directory."
+  DestinationMissing f ->
+    "Download destination directory " <> T.pack f <> " does not exist."
   DestinationDoesNotExist a ->
     "This address does not exist [" <> addressToText a <> "]"
   AccessDenied a ->
@@ -118,6 +124,8 @@ renderErrorType e = case e of
 data DownloadError =
     DownloadSourceMissing Address
   | DownloadDestinationExists FilePath
+  | DownloadDestinationNotDirectory FilePath
+  | DownloadInvariant Address Address
   | MultipartError (RunError Error)
   deriving Show
 
@@ -128,6 +136,12 @@ renderDownloadError d =
       "Can not download when the source object does not exist [" <> addressToText a <> "]"
     DownloadDestinationExists f ->
       "Can not download to a target that already exists [" <> T.pack f <> "]"
+    DownloadDestinationNotDirectory f ->
+      "Destination for a recursive download, " <> T.pack f <> " is not a directory."
+    DownloadInvariant a b ->
+      "Remove common prefix invariant: " <>
+      "[" <> addressToText b <> "] is not a common prefix of " <>
+      "[" <> addressToText a <> "]"
     MultipartError r ->
       "Multipart download error: " <> renderRunError r renderError
 

mismi-s3/src/Mismi/S3/Data.hs

@@ -497,6 +497,25 @@ prop_read_empty k = ioProperty $ do
   t <- runAWSDefaultRegion . read $ Address bucket' k
   pure $ t === Nothing
 
+prop_download_recursive :: Property
+prop_download_recursive = once . testAWS $ do
+  let name1 = "first name"
+      name2 = "second name"
+      name3 = "third name"
+  tmpdir <- newFilePath
+  addr <- withKey (// Key "top") <$> newAddress
+  writeOrFail (withKey (// Key "a") addr) name1
+  writeOrFail (withKey (// Key "b/c") addr) name2
+  writeOrFail (withKey (// Key "c/d/e") addr) name3
+
+  eitherT (fail . show) pure $ downloadRecursive addr tmpdir
+
+  a <- liftIO $ T.readFile (tmpdir </> "a")
+  c <- liftIO $ T.readFile (tmpdir </> "b" </> "c")
+  e <- liftIO $ T.readFile (tmpdir </> "c" </> "d" </> "e")
+
+  pure $ a === name1 .&&. c == name2 .&&. e == name3
+
 ----------
 -- HELPERS
 ----------