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

Add ListObjectsV1 API support (#66)

Browse Source 
This is added for legacy requirements
This commit is contained in:
Harshavardhana 2017-10-15 22:38:06 -07:00 committed by Krishnan Parthasarathi
parent 2b816b7092
commit c26af265ec
8 changed files with 176 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
docs/API.md
View File

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

1
src/Network/Minio.hs
View File

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

8
src/Network/Minio/Data.hs
View File

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

15
src/Network/Minio/ListOps.hs
View File

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

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

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

29
src/Network/Minio/XmlParser.hs
View File

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

13
test/LiveServer.hs
View File

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

35
test/Network/Minio/XmlParser/Test.hs
View File

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