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