Add listObjects, listIncompleteUploads and listIncompleteParts

high-level APIs

src/Network/Minio.hs

@@ -31,6 +31,9 @@ module Network.Minio
   , fPutObject
   , ObjectData(..)
   , putObject
+  , listObjects
+  , listIncompleteUploads
+  , listIncompleteParts
   ) where
 
 {-
@@ -40,6 +43,7 @@ This module exports the high-level Minio API for object storage.
 -- import qualified Control.Monad.Trans.Resource as R
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.List as CL
 
 import           Lib.Prelude
 
@@ -60,3 +64,46 @@ fGetObject bucket object fp = do
 fPutObject :: Bucket -> Object -> FilePath -> Minio ()
 fPutObject bucket object f = void $ putObject bucket object $
                              ODFile f Nothing
+
+-- | List objects in a bucket matching the given prefix. If recurse is
+-- set to True objects matching prefix are recursively listed.
+listObjects :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo
+listObjects bucket prefix recurse = loop Nothing
+  where
+    loop :: Maybe Text -> C.Producer Minio ObjectInfo
+    loop nextToken = do
+      let
+        delimiter = bool (Just "/") Nothing recurse
+
+      res <- lift $ listObjects' bucket prefix nextToken delimiter
+      CL.sourceList $ lorObjects res
+      when (lorHasMore res) $
+        loop (lorNextToken res)
+
+-- | List incomplete uploads in a bucket matching the given prefix. If
+-- recurse is set to True incomplete uploads for the given prefix are
+-- recursively listed.
+listIncompleteUploads :: Bucket -> Maybe Text -> Bool -> C.Producer Minio UploadInfo
+listIncompleteUploads bucket prefix recurse = loop Nothing Nothing
+  where
+    loop :: Maybe Text -> Maybe Text -> C.Producer Minio UploadInfo
+    loop nextKeyMarker nextUploadIdMarker = do
+      let
+        delimiter = bool (Just "/") Nothing recurse
+
+      res <- lift $ listIncompleteUploads' bucket prefix delimiter nextKeyMarker nextUploadIdMarker
+      CL.sourceList $ lurUploads res
+      when (lurHasMore res) $
+        loop nextKeyMarker nextUploadIdMarker
+
+-- | List object parts of an ongoing multipart upload for given
+-- bucket, object and uploadId.
+listIncompleteParts :: Bucket -> Object -> UploadId -> C.Producer Minio ListPartInfo
+listIncompleteParts bucket object uploadId = loop Nothing
+  where
+    loop :: Maybe Text -> C.Producer Minio ListPartInfo
+    loop nextPartMarker = do
+      res <- lift $ listIncompleteParts' bucket object uploadId Nothing nextPartMarker
+      CL.sourceList $ lprParts res
+      when (lprHasMore res) $
+        loop (show <$> lprNextPart res)

src/Network/Minio/S3API.hs

@@ -8,7 +8,7 @@ module Network.Minio.S3API
 
   -- * Listing objects
   --------------------
-  , listObjects
+  , listObjects'
 
   -- * Retrieving objects
   -----------------------
@@ -25,8 +25,8 @@ module Network.Minio.S3API
   , putObjectPart
   , completeMultipartUpload
   , abortMultipartUpload
-  , listIncompleteUploads
+  , listIncompleteUploads'
-  , listIncompleteParts
+  , listIncompleteParts'
 
   -- * Deletion APIs
   --------------------------
@@ -117,9 +117,9 @@ putObjectSingle bucket object headers h offset size = do
 
 -- | List objects in a bucket matching prefix up to delimiter,
 -- starting from nextToken.
-listObjects :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text
+listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text
             -> Minio ListObjectsResult
-listObjects bucket prefix nextToken delimiter = do
+listObjects' bucket prefix nextToken delimiter = do
   resp <- executeRequest $ def { riMethod = HT.methodGet
                                , riBucket = Just bucket
                                , riQueryParams = mkOptionalParams params
@@ -212,9 +212,9 @@ abortMultipartUpload bucket object uploadId = do
     params = [("uploadId", Just uploadId)]
 
 -- | List incomplete multipart uploads.
-listIncompleteUploads :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text
+listIncompleteUploads' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text
                       -> Maybe Text -> Minio ListUploadsResult
-listIncompleteUploads bucket prefix delimiter keyMarker uploadIdMarker = do
+listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker = do
   resp <- executeRequest $ def { riMethod = HT.methodGet
                                , riBucket = Just bucket
                                , riQueryParams = ("uploads", Nothing): mkOptionalParams params
@@ -231,9 +231,9 @@ listIncompleteUploads bucket prefix delimiter keyMarker uploadIdMarker = do
 
 
 -- | List parts of an ongoing multipart upload.
-listIncompleteParts :: Bucket -> Object -> UploadId -> Maybe Text
+listIncompleteParts' :: Bucket -> Object -> UploadId -> Maybe Text
                       -> Maybe Text -> Minio ListPartsResult
-listIncompleteParts bucket object uploadId maxParts partNumMarker = do
+listIncompleteParts' bucket object uploadId maxParts partNumMarker = do
   resp <- executeRequest $ def { riMethod = HT.methodGet
                                , riBucket = Just bucket
                                , riObject = Just object

test/Spec.hs

@@ -6,8 +6,10 @@ import           Lib.Prelude
 import qualified System.IO as SIO
 
 import           Control.Monad.Trans.Resource (runResourceT)
-import qualified Data.Text as T
+import           Data.Conduit (($$))
+import           Data.Conduit.Combinators (sinkList)
 import           Data.Default (Default(..))
+import qualified Data.Text as T
 
 import           Network.Minio
 import           Network.Minio.Data
@@ -118,7 +120,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
         fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release"
 
       step "Simple list"
-      res <- listObjects bucket Nothing Nothing Nothing
+      res <- listObjects' bucket Nothing Nothing Nothing
       let expected = sort $ map (T.concat .
                           ("lsb-release":) .
                           (\x -> [x]) .
@@ -138,7 +140,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
         liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
 
       step "list incomplete multipart uploads"
-      incompleteUploads <- listIncompleteUploads bucket Nothing Nothing Nothing Nothing
+      incompleteUploads <- listIncompleteUploads' bucket Nothing Nothing Nothing Nothing
       liftIO $ (length $ lurUploads incompleteUploads) @?= 10
 
   , funTestWithBucket "multipart" "testbucket5" $ \step bucket -> do
@@ -167,8 +169,59 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
         putObjectPart bucket object uid pnum [] $ PayloadH h 0 mb15
 
       step "fetch list parts"
-      listPartsResult <- listIncompleteParts bucket object uid Nothing Nothing
+      listPartsResult <- listIncompleteParts' bucket object uid Nothing Nothing
       liftIO $ (length $ lprParts listPartsResult) @?= 10
+
+  , funTestWithBucket "High-level listObjects Test" "testbucket7" $ \step bucket -> do
+      step "put 3 objects"
+      let expected = [
+              "dir/o1"
+            , "dir/dir1/o2"
+            , "dir/dir2/o3"
+            ]
+      forM_ expected $
+        \obj -> fPutObject bucket obj "/etc/lsb-release"
+
+      step "High-level listing of objects"
+      objects <- (listObjects bucket Nothing True) $$ sinkList
+
+      liftIO $ assertEqual "Objects match failed!" (sort expected)
+        (map oiObject objects)
+
+      step "Cleanup actions"
+      forM_ expected $
+        \obj -> deleteObject bucket obj
+
+  , funTestWithBucket "High-level listIncompleteUploads Test" "testbucket8" $ \step bucket -> do
+      let object = "newmpupload"
+      step "create 10 multipart uploads"
+      forM_ [1..10::Int] $ \_ -> do
+        uid <- newMultipartUpload bucket object []
+        liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
+
+      step "High-level listing of incomplete multipart uploads"
+      uploads <- (listIncompleteUploads bucket Nothing True) $$ sinkList
+
+      liftIO $ (length uploads) @?= 10
+
+  , funTestWithBucket "High-level listIncompleteParts Test" "testbucket9" $ \step bucket -> do
+      let
+        object = "newmpupload"
+        mb15 = 15 * 1024 * 1024
+
+      step "create a multipart upload"
+      uid <- newMultipartUpload bucket object []
+      liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
+
+      step "put object parts 1..10"
+      h <- liftIO $ SIO.openBinaryFile "/tmp/inputfile" SIO.ReadMode
+      forM [1..10] $ \pnum ->
+        putObjectPart bucket object uid pnum [] $ PayloadH h 0 mb15
+
+      step "fetch list parts"
+      incompleteParts <- (listIncompleteParts bucket object uid) $$ sinkList
+      liftIO $ (length incompleteParts) @?= 10
+
   ]
 
 unitTests :: TestTree