From c26af265eccbcdb4e3dac3dcfc2eaf19781a6018 Mon Sep 17 00:00:00 2001 From: Harshavardhana Date: Sun, 15 Oct 2017 22:38:06 -0700 Subject: [PATCH] Add ListObjectsV1 API support (#66) This is added for legacy requirements --- docs/API.md | 62 ++++++++++++++++++++++++++-- src/Network/Minio.hs | 1 + src/Network/Minio/Data.hs | 8 ++++ src/Network/Minio/ListOps.hs | 15 +++++++ src/Network/Minio/S3API.hs | 20 +++++++++ src/Network/Minio/XmlParser.hs | 29 +++++++++++++ test/LiveServer.hs | 13 ++++++ test/Network/Minio/XmlParser/Test.hs | 35 ++++++++++++++-- 8 files changed, 176 insertions(+), 7 deletions(-) diff --git a/docs/API.md b/docs/API.md index 093f5f0..1deaf19 100644 --- a/docs/API.md +++ b/docs/API.md @@ -26,8 +26,9 @@ awsCI { connectAccesskey = "your-access-key" |[`makeBucket`](#makeBucket)|[`putObject`](#putObject)| |[`removeBucket`](#removeBucket)|[`fGetObject`](#fGetObject)| |[`listObjects`](#listObjects)|[`fPutObject`](#fPutObject)| -|[`listIncompleteUploads`](#listIncompleteUploads)|[`copyObject`](#copyObject)| -|[`bucketExists`](#bucketExists)|[`removeObject`](#removeObject)| +|[`listObjectsV1`](#listObjectsV1)|[`copyObject`](#copyObject)| +|[`listIncompleteUploads`](#listIncompleteUploads)|[`removeObject`](#removeObject)| +|[`bucketExists`](#bucketExists)|| ## 1. Connecting and running operations on the storage service @@ -226,7 +227,7 @@ main = do ### listObjects :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo -List objects in the given bucket. +List objects in the given bucket, implements version 2 of AWS S3 API. __Parameters__ @@ -243,7 +244,7 @@ __Return Value__ |Return type |Description | |:---|:---| -| _C.Producer Minio ObjectInfo_ | A Conduit Producer of `ObjectInfo` values corresponding to each incomplete multipart upload | +| _C.Producer Minio ObjectInfo_ | A Conduit Producer of `ObjectInfo` values corresponding to each object. | __ObjectInfo record type__ @@ -275,6 +276,59 @@ main = do ``` + +### listObjectsV1 :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo + +List objects in the given bucket, implements version 1 of AWS S3 API. This API +is provided for legacy S3 compatible object storage endpoints. + +__Parameters__ + +In the expression `listObjectsV1 bucketName prefix recursive` the +arguments are: + +|Param |Type |Description | +|:---|:---| :---| +| `bucketName` | _Bucket_ (alias for `Text`) | Name of the bucket | +| `prefix` | _Maybe Text_ | Optional prefix that listed objects should have | +| `recursive` | _Bool_ |`True` indicates recursive style listing and `False` indicates directory style listing delimited by '/'. | + +__Return Value__ + +|Return type |Description | +|:---|:---| +| _C.Producer Minio ObjectInfo_ | A Conduit Producer of `ObjectInfo` values corresponding to each object. | + +__ObjectInfo record type__ + +|Field |Type |Description | +|:---|:---| :---| +|`oiObject` | _Object_ (alias for `Text`) | Name of object | +|`oiModTime` | _UTCTime_ | Last modified time of the object | +|`oiETag` | _ETag_ (alias for `Text`) | ETag of the object | +|`oiSize` | _Int64_ | Size of the object in bytes | + +__Example__ + +``` haskell +{-# Language OverloadedStrings #-} + +import Data.Conduit (($$)) +import Conduit.Combinators (sinkList) + +main :: IO () +main = do + let + bucket = "test" + + -- Performs a recursive listing of all objects under bucket "test" + -- on play.minio.io. + res <- runMinio minioPlayCI $ do + listObjectsV1 bucket Nothing True $$ sinkList + print res + +``` + ### listIncompleteUploads :: Bucket -> Maybe Prefix -> Bool -> C.Producer Minio UploadInfo diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 58e2b3d..dfb8374 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -61,6 +61,7 @@ module Network.Minio , removeBucket , listObjects + , listObjectsV1 , listIncompleteUploads -- * Object Operations diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 5181b15..500a776 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -224,6 +224,14 @@ data ListObjectsResult = ListObjectsResult { , lorCPrefixes :: [Text] } deriving (Show, Eq) +-- | Represents result from a listing of objects version 1 in a bucket. +data ListObjectsV1Result = ListObjectsV1Result { + lorHasMore' :: Bool + , lorNextMarker :: Maybe Text + , lorObjects' :: [ObjectInfo] + , lorCPrefixes' :: [Text] + } deriving (Show, Eq) + -- | Represents information about an object. data ObjectInfo = ObjectInfo { oiObject :: Object diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs index 2279135..3e90eb6 100644 --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -40,6 +40,21 @@ listObjects bucket prefix recurse = loop Nothing when (lorHasMore res) $ loop (lorNextToken res) +-- | List objects in a bucket matching the given prefix. If recurse is +-- set to True objects matching prefix are recursively listed. +listObjectsV1 :: Bucket -> Maybe Text -> Bool -> C.Producer Minio ObjectInfo +listObjectsV1 bucket prefix recurse = loop Nothing + where + loop :: Maybe Text -> C.Producer Minio ObjectInfo + loop nextMarker = do + let + delimiter = bool (Just "/") Nothing recurse + + res <- lift $ listObjectsV1' bucket prefix nextMarker delimiter Nothing + CL.sourceList $ lorObjects' res + when (lorHasMore' res) $ + loop (lorNextMarker 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. diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index e8de594..76c998a 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -26,7 +26,9 @@ module Network.Minio.S3API -- * Listing objects -------------------- , ListObjectsResult(..) + , ListObjectsV1Result(..) , listObjects' + , listObjectsV1' -- * Retrieving buckets , headBucket @@ -147,6 +149,24 @@ putObjectSingle bucket object headers h offset size = do (throwM MErrVETagHeaderNotFound) return etag +-- | List objects in a bucket matching prefix up to delimiter, +-- starting from nextMarker. +listObjectsV1' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int + -> Minio ListObjectsV1Result +listObjectsV1' bucket prefix nextMarker delimiter maxKeys = do + resp <- executeRequest $ def { riMethod = HT.methodGet + , riBucket = Just bucket + , riQueryParams = mkOptionalParams params + } + parseListObjectsV1Response $ NC.responseBody resp + where + params = [ + ("marker", nextMarker) + , ("prefix", prefix) + , ("delimiter", delimiter) + , ("max-keys", show <$> maxKeys) + ] + -- | List objects in a bucket matching prefix up to delimiter, -- starting from nextToken. listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 048e1d0..f1bf7c7 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -21,6 +21,7 @@ module Network.Minio.XmlParser , parseCompleteMultipartUploadResponse , parseCopyObjectResponse , parseListObjectsResponse + , parseListObjectsV1Response , parseListUploadsResponse , parseListPartsResponse , parseErrResponse @@ -109,6 +110,34 @@ parseCopyObjectResponse xmldata = do mtime <- parseS3XMLTime mtimeStr return (T.concat $ r $// s3Elem "ETag" &/ content, mtime) +-- | Parse the response XML of a list objects v1 call. +parseListObjectsV1Response :: (MonadThrow m) + => LByteString -> m ListObjectsV1Result +parseListObjectsV1Response xmldata = do + r <- parseRoot xmldata + let + hasMore = ["true"] == (r $/ s3Elem "IsTruncated" &/ content) + + nextMarker = headMay $ r $/ s3Elem "NextMarker" &/ content + + prefixes = r $/ s3Elem "CommonPrefixes" &/ s3Elem "Prefix" &/ content + + keys = r $/ s3Elem "Contents" &/ s3Elem "Key" &/ content + modTimeStr = r $/ s3Elem "Contents" &/ s3Elem "LastModified" &/ content + etagsList = r $/ s3Elem "Contents" &/ s3Elem "ETag" &/ content + -- if response xml contains empty etag response fill them with as + -- many empty Text for the zip4 below to work as intended. + etags = etagsList ++ repeat "" + sizeStr = r $/ s3Elem "Contents" &/ s3Elem "Size" &/ content + + modTimes <- mapM parseS3XMLTime modTimeStr + sizes <- parseDecimals sizeStr + + let + objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes + + return $ ListObjectsV1Result hasMore nextMarker objects prefixes + -- | Parse the response XML of a list objects call. parseListObjectsResponse :: (MonadThrow m) => LByteString -> m ListObjectsResult diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 93bd29e..9426e6d 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -165,6 +165,9 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ liftIO $ assertEqual "Objects match failed!" (sort expectedObjects) (map oiObject objects) + step "High-level listing of objects (version 1)" + objects <- listObjectsV1 bucket Nothing True $$ sinkList + step "Cleanup actions" forM_ expectedObjects $ \obj -> removeObject bucket obj @@ -225,6 +228,16 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do liftIO $ assertEqual "Objects match failed!" expectedObjects (map oiObject $ lorObjects res) + step "Simple list version 1" + res <- listObjectsV1' bucket Nothing Nothing Nothing Nothing + let expected = sort $ map (T.concat . + ("lsb-release":) . + (\x -> [x]) . + T.pack . + show) [1..10::Int] + liftIO $ assertEqual "Objects match failed!" expected + (map oiObject $ lorObjects' res) + step "Cleanup actions" forM_ objects $ \obj -> deleteObject bucket obj diff --git a/test/Network/Minio/XmlParser/Test.hs b/test/Network/Minio/XmlParser/Test.hs index 3e9c7b2..d27f997 100644 --- a/test/Network/Minio/XmlParser/Test.hs +++ b/test/Network/Minio/XmlParser/Test.hs @@ -35,6 +35,7 @@ xmlParserTests = testGroup "XML Parser Tests" [ testCase "Test parseLocation" testParseLocation , testCase "Test parseNewMultipartUpload" testParseNewMultipartUpload , testCase "Test parseListObjectsResponse" testParseListObjectsResult + , testCase "Test parseListObjectsV1Response" testParseListObjectsV1Result , testCase "Test parseListUploadsresponse" testParseListIncompleteUploads , testCase "Test parseCompleteMultipartUploadResponse" testParseCompleteMultipartUploadResponse , testCase "Test parseListPartsResponse" testParseListPartsResponse @@ -108,9 +109,10 @@ testParseListObjectsResult = do \\ \bucket\ \\ - \205\ + \opaque\ + \1000\ \1000\ - \false\ + \true\ \\ \my-image.jpg\ \2009-10-12T17:50:30.000Z\ @@ -120,13 +122,40 @@ testParseListObjectsResult = do \\ \" - expectedListResult = ListObjectsResult False Nothing [object1] [] + expectedListResult = ListObjectsResult True (Just "opaque") [object1] [] object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12 parsedListObjectsResult <- tryValidationErr $ parseListObjectsResponse xmldata eitherValidationErr parsedListObjectsResult (@?= expectedListResult) +testParseListObjectsV1Result :: Assertion +testParseListObjectsV1Result = do + let + xmldata = "\ + \\ + \bucket\ + \\ + \my-image1.jpg\ + \1000\ + \1000\ + \true\ + \\ + \my-image.jpg\ + \2009-10-12T17:50:30.000Z\ + \"fba9dede5f27731c9771645a39863328"\ + \434234\ + \STANDARD\ + \\ + \" + + expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] [] + object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 + modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12 + + parsedListObjectsV1Result <- tryValidationErr $ parseListObjectsV1Response xmldata + eitherValidationErr parsedListObjectsV1Result (@?= expectedListResult) + testParseListIncompleteUploads :: Assertion testParseListIncompleteUploads = do let