From aa66ba291e8d2fc4272fe4c1fd3278bedace4ca0 Mon Sep 17 00:00:00 2001 From: Krishnan Parthasarathi Date: Tue, 31 Jan 2017 13:13:35 +0530 Subject: [PATCH] Add listObjects, listIncompleteUploads and listIncompleteParts high-level APIs --- src/Network/Minio.hs | 47 +++++++++++++++++++++++++++++ src/Network/Minio/S3API.hs | 18 +++++------ test/Spec.hs | 61 +++++++++++++++++++++++++++++++++++--- 3 files changed, 113 insertions(+), 13 deletions(-) diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 2431182..cd3d3bf 100644 --- a/src/Network/Minio.hs +++ b/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) diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index f71708c..e7b4e42 100644 --- a/src/Network/Minio/S3API.hs +++ b/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 - , listIncompleteParts + , listIncompleteUploads' + , 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 diff --git a/test/Spec.hs b/test/Spec.hs index 60d49e2..7d8c8af 100644 --- a/test/Spec.hs +++ b/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