Add oiUserMetadata to ObjectInfo to return user metadata (minio#132)

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
 

src/Network/Minio.hs

@@ -90,6 +90,7 @@ module Network.Minio
   , oiModTime
   , oiETag
   , oiSize
+  , oiUserMetadata
   , oiMetadata
 
   -- ** Listing incomplete uploads

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

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.

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)))
-
-getMetadataMap :: [HT.Header] -> H.HashMap Text Text
-getMetadataMap hs = H.fromList (getMetadata hs)
+getMetadata =
+    map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)))
+
+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

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
 

test/Network/Minio/XmlParser/Test.hs

@@ -128,7 +128,7 @@ testParseListObjectsResult = do
               \</ListBucketResult>"
 
     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
               \</ListBucketResult>"
 
     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