haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add listObjects, listIncompleteUploads and listIncompleteParts

Browse Source 
high-level APIs
This commit is contained in:
Krishnan Parthasarathi 2017-01-31 13:13:35 +05:30 committed by Aditya Manthramurthy
parent 0f3676b6d7
commit aa66ba291e
3 changed files with 113 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/Network/Minio.hs
View File

@ -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)

18
src/Network/Minio/S3API.hs
View File

@ -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

61
test/Spec.hs
View File

@ -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