Add ListObjectsV1 API support (#66)

This is added for legacy requirements

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)|
+|[`listObjectsV1`](#listObjectsV1)|[`copyObject`](#copyObject)|
-|[`bucketExists`](#bucketExists)|[`removeObject`](#removeObject)|
+|[`listIncompleteUploads`](#listIncompleteUploads)|[`removeObject`](#removeObject)|
+|[`bucketExists`](#bucketExists)||
 
 ## 1. Connecting and running operations on the storage service
 
@@ -226,7 +227,7 @@ main = do
 <a name="listObjects"></a>
 ### 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
 
 ```
 
+<a name="listObjectsV1"></a>
+### 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
+
+```
+
 <a name="listIncompleteUploads"></a>
 ### listIncompleteUploads :: Bucket -> Maybe Prefix -> Bool -> C.Producer Minio UploadInfo
 

src/Network/Minio.hs

@@ -61,6 +61,7 @@ module Network.Minio
   , removeBucket
 
   , listObjects
+  , listObjectsV1
   , listIncompleteUploads
 
   -- * Object Operations

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

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.

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

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

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
 

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
               \<ListBucketResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
               \<Name>bucket</Name>\
               \<Prefix/>\
-              \<KeyCount>205</KeyCount>\
+              \<NextContinuationToken>opaque</NextContinuationToken>\
+              \<KeyCount>1000</KeyCount>\
               \<MaxKeys>1000</MaxKeys>\
-              \<IsTruncated>false</IsTruncated>\
+              \<IsTruncated>true</IsTruncated>\
               \<Contents>\
               \<Key>my-image.jpg</Key>\
               \<LastModified>2009-10-12T17:50:30.000Z</LastModified>\
@@ -120,13 +122,40 @@ testParseListObjectsResult = do
               \</Contents>\
               \</ListBucketResult>"
 
-    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 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
+              \<ListBucketResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
+              \<Name>bucket</Name>\
+              \<Prefix/>\
+              \<NextMarker>my-image1.jpg</NextMarker>\
+              \<KeyCount>1000</KeyCount>\
+              \<MaxKeys>1000</MaxKeys>\
+              \<IsTruncated>true</IsTruncated>\
+              \<Contents>\
+              \<Key>my-image.jpg</Key>\
+              \<LastModified>2009-10-12T17:50:30.000Z</LastModified>\
+              \<ETag>&quot;fba9dede5f27731c9771645a39863328&quot;</ETag>\
+              \<Size>434234</Size>\
+              \<StorageClass>STANDARD</StorageClass>\
+              \</Contents>\
+              \</ListBucketResult>"
+
+    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