From b39127778e1d0b1bc2c709f43511b31eb5452c14 Mon Sep 17 00:00:00 2001 From: Aditya Manthramurthy Date: Wed, 24 Jul 2019 13:30:03 -0700 Subject: [PATCH] Add oiUserMetadata to ObjectInfo to return user metadata (#132) --- CHANGELOG.md | 2 ++ src/Network/Minio.hs | 1 + src/Network/Minio/Data.hs | 33 +++++++++++++++++++--------- src/Network/Minio/S3API.hs | 19 +++++++++++----- src/Network/Minio/Utils.hs | 23 ++++++++++++++++--- src/Network/Minio/XmlParser.hs | 12 +++++----- test/Network/Minio/XmlParser/Test.hs | 4 ++-- 7 files changed, 68 insertions(+), 26 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 52f388a..8db1649 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,8 @@ Changelog * Switch to faster map data type - all previous usage of Data.Map.Strict and Data.Set is replaced with Data.HashMap.Strict and Data.HashSet. +* Add `oiUserMetadata` to parse and return user metadata stored with + an object. ## Version 1.4.0 diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 77627fc..d7d3981 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -90,6 +90,7 @@ module Network.Minio , oiModTime , oiETag , oiSize + , oiUserMetadata , oiMetadata -- ** Listing incomplete uploads diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 2bd10f1..cfa8cd3 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -335,14 +335,20 @@ data PutObjectOptions = PutObjectOptions { defaultPutObjectOptions :: PutObjectOptions defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing +isUserMetadataHeaderName :: Text -> Bool +isUserMetadataHeaderName k = + let prefix = T.toCaseFold "X-Amz-Meta-" + n = T.length prefix + in T.toCaseFold (T.take n k) == prefix + addXAmzMetaPrefix :: Text -> Text -addXAmzMetaPrefix s = do - if (T.isPrefixOf "x-amz-meta-" s) +addXAmzMetaPrefix s = + if isUserMetadataHeaderName s then s - else T.concat ["x-amz-meta-", s] + else "X-Amz-Meta-" <> s mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header] -mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y)) +mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ x, encodeUtf8 y)) pooToHeaders :: PutObjectOptions -> [HT.Header] pooToHeaders poo = userMetadata @@ -435,12 +441,19 @@ data ListObjectsV1Result = ListObjectsV1Result { -- | Represents information about an object. data ObjectInfo = ObjectInfo - { oiObject :: Object -- ^ Object key - , oiModTime :: UTCTime -- ^ Mdification time of the object - , oiETag :: ETag -- ^ ETag of the object - , oiSize :: Int64 -- ^ Size of the object in bytes - , oiMetadata :: H.HashMap Text Text -- ^ A map of the metadata - -- key-value pairs + { oiObject :: Object -- ^ Object key + , oiModTime :: UTCTime -- ^ Modification time of the object + , oiETag :: ETag -- ^ ETag of the object + , oiSize :: Int64 -- ^ Size of the object in bytes + , oiUserMetadata :: H.HashMap Text Text -- ^ A map of user-metadata + -- pairs stored with an + -- object (keys will not + -- have the @X-Amz-Meta-@ + -- prefix). + , oiMetadata :: H.HashMap Text Text -- ^ A map of metadata + -- key-value pairs (not + -- including the + -- user-metadata pairs) } deriving (Show, Eq) -- | Represents source object in server-side copy object diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 217d80d..72c9437 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -412,20 +412,27 @@ listIncompleteParts' bucket object uploadId maxParts partNumMarker = do headObject :: Bucket -> Object -> [HT.Header] -> Minio ObjectInfo headObject bucket object reqHeaders = do resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodHead - , riBucket = Just bucket - , riObject = Just object - , riHeaders = reqHeaders - } + , riBucket = Just bucket + , riObject = Just object + , riHeaders = reqHeaders + } let headers = NC.responseHeaders resp modTime = getLastModifiedHeader headers etag = getETagHeader headers size = getContentLength headers - metadata = getMetadataMap headers + metadataPairs = getMetadata headers + userMetadata = getUserMetadataMap metadataPairs + metadata = getNonUserMetadataMap metadataPairs maybe (throwIO MErrVInvalidObjectInfoResponse) return $ - ObjectInfo <$> Just object <*> modTime <*> etag <*> size <*> Just metadata + ObjectInfo <$> Just object + <*> modTime + <*> etag + <*> size + <*> Just userMetadata + <*> Just metadata -- | Query the object store if a given bucket exists. diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index 9b17f9b..21f00aa 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -103,10 +103,27 @@ getETagHeader :: [HT.Header] -> Maybe Text getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs getMetadata :: [HT.Header] -> [(Text, Text)] -getMetadata = map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y))) +getMetadata = + map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y))) -getMetadataMap :: [HT.Header] -> H.HashMap Text Text -getMetadataMap hs = H.fromList (getMetadata hs) +toMaybeMetadataHeader :: (Text, Text) -> Maybe (Text, Text) +toMaybeMetadataHeader (k, v) = + let checkPrefix t = bool Nothing (Just t) $ + isUserMetadataHeaderName t + in (, v) <$> checkPrefix k + +getNonUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text +getNonUserMetadataMap = H.fromList + . filter ( not + . isUserMetadataHeaderName + . fst + ) + +-- | This function collects all headers starting with `x-amz-meta-` +-- and strips off this prefix, and returns a map. +getUserMetadataMap :: [(Text, Text)] -> H.HashMap Text Text +getUserMetadataMap = H.fromList + . mapMaybe toMaybeMetadataHeader getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime getLastModifiedHeader hs = do diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 6217fba..f52ee70 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -31,7 +31,7 @@ module Network.Minio.XmlParser import qualified Data.ByteString.Lazy as LB import qualified Data.HashMap.Strict as H -import Data.List (zip3, zip4, zip5) +import Data.List (zip3, zip4, zip6) import qualified Data.Text as T import Data.Text.Read (decimal) import Data.Time @@ -52,8 +52,8 @@ s3TimeFormat = iso8601DateFormat $ Just "%T%QZ" uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e uncurry4 f (a, b, c, d) = f a b c d -uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f -uncurry5 f (a, b, c, d, e) = f a b c d e +uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g +uncurry6 f (a, b, c, d, e, g) = f a b c d e g -- | Parse time strings from XML parseS3XMLTime :: (MonadIO m) => Text -> m UTCTime @@ -149,7 +149,8 @@ parseListObjectsV1Response xmldata = do sizes <- parseDecimals sizeStr let - objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat H.empty) + objects = map (uncurry6 ObjectInfo) $ + zip6 keys modTimes etags sizes (repeat H.empty) (repeat H.empty) return $ ListObjectsV1Result hasMore nextMarker objects prefixes @@ -178,7 +179,8 @@ parseListObjectsResponse xmldata = do sizes <- parseDecimals sizeStr let - objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat H.empty) + objects = map (uncurry6 ObjectInfo) $ + zip6 keys modTimes etags sizes (repeat H.empty) (repeat H.empty) return $ ListObjectsResult hasMore nextToken objects prefixes diff --git a/test/Network/Minio/XmlParser/Test.hs b/test/Network/Minio/XmlParser/Test.hs index e32b28a..ead6ab9 100644 --- a/test/Network/Minio/XmlParser/Test.hs +++ b/test/Network/Minio/XmlParser/Test.hs @@ -128,7 +128,7 @@ testParseListObjectsResult = do \" expectedListResult = ListObjectsResult True (Just "opaque") [object1] [] - object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty + object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty H.empty modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12 parsedListObjectsResult <- tryValidationErr $ runTestNS $ parseListObjectsResponse xmldata @@ -155,7 +155,7 @@ testParseListObjectsV1Result = do \" expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] [] - object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty + object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty H.empty modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12 parsedListObjectsV1Result <- tryValidationErr $ runTestNS $ parseListObjectsV1Response xmldata