diff --git a/CHANGELOG.md b/CHANGELOG.md index 8db1649..cea47ed 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index d7d3981..c17d5bf 100644 --- a/src/Network/Minio.hs +++ b/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. diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 0845d7c..6de6154 100644 --- a/src/Network/Minio/Data.hs +++ b/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: diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 72c9437..5e31f5f 100644 --- a/src/Network/Minio/S3API.hs +++ b/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. diff --git a/test/LiveServer.hs b/test/LiveServer.hs index ce4339d..0a44f14 100644 --- a/test/LiveServer.hs +++ b/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