Add GetObjectResponse data type (#134)

This allows retrieving the ObjectInfo of an object during the
getObject call.

CHANGELOG.md

@@ -8,6 +8,9 @@ Changelog
   and Data.HashSet.
 * Add `oiUserMetadata` to parse and return user metadata stored with
   an object.
+* Add `GetObjectResponse` data type for the value returned by
+  `getObject`. It now contains parsed ObjectInfo along with the
+  conduit of object bytes.
 
 ## Version 1.4.0
 

src/Network/Minio.hs

@@ -147,6 +147,9 @@ module Network.Minio
   , gooIfModifiedSince
   , gooIfUnmodifiedSince
   , gooSSECKey
+  , GetObjectResponse
+  , gorObjectInfo
+  , gorObjectStream
 
   -- ** Server-side object copying
   , copyObject
@@ -242,7 +245,7 @@ listBuckets = getService
 fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio ()
 fGetObject bucket object fp opts = do
   src <- getObject bucket object opts
-  C.connect src $ CB.sinkFileCautious fp
+  C.connect (gorObjectStream src) $ CB.sinkFileCautious fp
 
 -- | Upload the given file to the given object.
 fPutObject :: Bucket -> Object -> FilePath
@@ -272,11 +275,11 @@ copyObject dstInfo srcInfo = void $ copyObjectInternal (dstBucket dstInfo)
 removeObject :: Bucket -> Object -> Minio ()
 removeObject = deleteObject
 
--- | Get an object from the object store as a resumable source (conduit).
+-- | Get an object from the object store.
 getObject :: Bucket -> Object -> GetObjectOptions
-          -> Minio (C.ConduitM () ByteString Minio ())
-getObject bucket object opts = snd <$> getObject' bucket object []
-                               (gooToHeaders opts)
+          -> Minio GetObjectResponse
+getObject bucket object opts =
+    getObject' bucket object [] $ gooToHeaders opts
 
 -- | Get an object's metadata from the object store. It accepts the
 -- same options as GetObject.

src/Network/Minio/Data.hs

@@ -537,6 +537,14 @@ gooToHeaders goo = rangeHdr ++ zip names values
     rangeHdr = maybe [] (\a -> [(hRange, HT.renderByteRanges [a])])
                $ gooRange goo
 
+-- | Data type returned by 'getObject' representing the object being
+-- retrieved. Use the @gor*@ functions to access its contents.
+data GetObjectResponse = GetObjectResponse {
+      -- | ObjectInfo of the object being retrieved.
+      gorObjectInfo   :: ObjectInfo
+      -- | A conduit of the bytes of the object.
+    , gorObjectStream :: C.ConduitM () ByteString Minio ()
+    }
 
 -- | A data-type for events that can occur in the object storage
 -- server. Reference:

src/Network/Minio/S3API.hs

@@ -91,7 +91,6 @@ module Network.Minio.S3API
   , removeAllBucketNotification
   ) where
 
-import qualified Conduit                           as C
 import qualified Data.ByteString                   as BS
 import qualified Data.Text                         as T
 import qualified Network.HTTP.Conduit              as NC
@@ -118,19 +117,37 @@ getService = do
     }
   parseListBuckets $ NC.responseBody resp
 
--- | GET an object from the service and return the response headers
--- and a conduit source for the object content
+-- Parse headers from getObject and headObject calls.
+parseGetObjectHeaders :: Object -> [HT.Header] -> Maybe ObjectInfo
+parseGetObjectHeaders object headers =
+    let metadataPairs = getMetadata headers
+        userMetadata = getUserMetadataMap metadataPairs
+        metadata = getNonUserMetadataMap metadataPairs
+    in ObjectInfo <$> Just object
+                  <*> getLastModifiedHeader headers
+                  <*> getETagHeader headers
+                  <*> getContentLength headers
+                  <*> Just userMetadata
+                  <*> Just metadata
+
+-- | GET an object from the service and return parsed ObjectInfo and a
+-- conduit source for the object content
 getObject' :: Bucket -> Object -> HT.Query -> [HT.Header]
-           -> Minio ([HT.Header], C.ConduitM () ByteString Minio ())
+           -> Minio GetObjectResponse
 getObject' bucket object queryParams headers = do
-  resp <- mkStreamRequest reqInfo
-  return (NC.responseHeaders resp, NC.responseBody resp)
+    resp <- mkStreamRequest reqInfo
+    let objInfoMaybe = parseGetObjectHeaders object $ NC.responseHeaders resp
+    objInfo <- maybe (throwIO MErrVInvalidObjectInfoResponse) return
+               objInfoMaybe
+    return $ GetObjectResponse { gorObjectInfo = objInfo
+                               , gorObjectStream = NC.responseBody resp
+                               }
   where
     reqInfo = defaultS3ReqInfo { riBucket = Just bucket
-                  , riObject = Just object
-                  , riQueryParams = queryParams
-                  , riHeaders = headers
-                  }
+                               , riObject = Just object
+                               , riQueryParams = queryParams
+                               , riHeaders = headers
+                               }
 
 -- | Creates a bucket via a PUT bucket call.
 putBucket :: Bucket -> Region -> Minio ()
@@ -417,22 +434,8 @@ headObject bucket object reqHeaders = do
                                             , riHeaders = reqHeaders
                                             }
 
-  let
-    headers = NC.responseHeaders resp
-    modTime = getLastModifiedHeader headers
-    etag = getETagHeader headers
-    size = getContentLength headers
-    metadataPairs = getMetadata headers
-    userMetadata = getUserMetadataMap metadataPairs
-    metadata = getNonUserMetadataMap metadataPairs
-
   maybe (throwIO MErrVInvalidObjectInfoResponse) return $
-    ObjectInfo <$> Just object
-               <*> modTime
-               <*> etag
-               <*> size
-               <*> Just userMetadata
-               <*> Just metadata
+    parseGetObjectHeaders object $ NC.responseHeaders resp
 
 
 -- | Query the object store if a given bucket exists.

test/LiveServer.hs

@@ -21,10 +21,10 @@ import           Test.Tasty.HUnit
 import           Test.Tasty.QuickCheck                 as QC
 
 import           Conduit                               (replicateC)
+import qualified Conduit                               as C
 import qualified Control.Monad.Trans.Resource          as R
 import qualified Data.ByteString                       as BS
 import           Data.Conduit                          (yield)
-import qualified Data.Conduit                          as C
 import qualified Data.Conduit.Binary                   as CB
 import           Data.Conduit.Combinators              (sinkList)
 import qualified Data.HashMap.Strict                   as H
@@ -42,6 +42,7 @@ import           Lib.Prelude
 
 import           Network.Minio
 import           Network.Minio.Data
+import           Network.Minio.Data.Crypto
 import           Network.Minio.PutObject
 import           Network.Minio.S3API
 import           Network.Minio.Utils
@@ -109,6 +110,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
   , putObjectContentLanguageTest
   , putObjectStorageClassTest
   , putObjectUserMetadataTest
+  , getObjectTest
   , copyObjectTests
   , presignedUrlFunTest
   , presignedPostPolicyFunTest
@@ -771,6 +773,39 @@ putObjectUserMetadataTest = funTestWithBucket "putObject user-metadata test" $
     step "Cleanup actions"
     removeObject bucket object
 
+getObjectTest :: TestTree
+getObjectTest = funTestWithBucket "getObject test" $
+  \step bucket -> do
+    step "putObject with some metadata"
+    let object = "object-with-metadata"
+        size1 = 100 :: Int64
+
+    inputFile <- mkRandFile size1
+    fPutObject bucket object inputFile defaultPutObjectOptions {
+      pooUserMetadata = [ ("x-Amz-meta-mykey1", "myval1")
+                        , ("mykey2", "myval2")
+                        ]
+      }
+
+    step "get the object - check the metadata matches"
+    -- retrieve obj info to check
+    gor <- getObject bucket object defaultGetObjectOptions
+    let m = oiUserMetadata $ gorObjectInfo gor
+        -- need to do a case-insensitive comparison
+        sortedMeta = sort $ map (\(k, v) -> (T.toLower k, T.toLower v)) $
+                     H.toList m
+        ref = sort [("mykey1", "myval1"), ("mykey2", "myval2")]
+
+    liftIO $ (sortedMeta == ref) @? "Metadata mismatch!"
+
+    step "get the object content"
+    getObjectHash <- hashSHA256FromSource $ gorObjectStream gor
+    inputHash <- hashSHA256FromSource $ C.sourceFile inputFile
+    liftIO $ (getObjectHash == inputHash) @? "Input file and output file mismatched!"
+
+    step "Cleanup actions"
+    removeObject bucket object
+
 putObjectStorageClassTest :: TestTree
 putObjectStorageClassTest = funTestWithBucket "putObject storageClass tests" $
   \step bucket -> do