From 8be1ff429f4d2b9171a94175ee56a9aef44f8a0e Mon Sep 17 00:00:00 2001 From: Harshavardhana Date: Wed, 6 Dec 2017 23:47:24 -0800 Subject: [PATCH] Support GetObjectOptions for getObject and fGetObject (#72) --- docs/API.md | 16 +++++++++-- src/Network/Minio.hs | 17 ++++++++---- src/Network/Minio/Data.hs | 31 ++++++++++++++++++++-- test/LiveServer.hs | 56 ++++++++++++++++++++++++++++----------- 4 files changed, 95 insertions(+), 25 deletions(-) diff --git a/docs/API.md b/docs/API.md index 213ca3f..d703bdd 100644 --- a/docs/API.md +++ b/docs/API.md @@ -473,7 +473,7 @@ main = do ``` -### fGetObject :: Bucket -> Object -> FilePath -> Minio () +### fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio () Downloads an object from a bucket in the service, to the given file __Parameters__ @@ -486,6 +486,18 @@ are: | `bucketName` | _Bucket_ (alias for `Text`) | Name of the bucket | | `objectName` | _Object_ (alias for `Text`) | Name of the object | | `inputFile` | _FilePath_ | Path to the file to be uploaded | +| `opts` | _GetObjectOptions_ | Options for GET requests specifying additional options like If-Match, Range | + + +__GetObjectOptions record type__ + +|Field |Type |Description | +|:---|:---| :---| +| `gooRange` | `Maybe ByteRanges` | Represents the byte range of object. E.g ByteRangeFromTo 0 9 represents first ten bytes of the object| +| `gooIfMatch` | `Maybe ETag` (alias for `Text`) | (Optional) ETag of object should match | +| `gooIfNoneMatch` | `Maybe ETag` (alias for `Text`) | (Optional) ETag of object shouldn't match | +| `gooIfUnmodifiedSince` | `Maybe UTCTime` | (Optional) Time since object wasn't modified | +| `gooIfModifiedSince` | `Maybe UTCTime` | (Optional) Time since object was modified | ``` haskell @@ -511,7 +523,7 @@ main = do localFile = "/etc/lsb-release" res <- runMinio minioPlayCI $ do - src <- fGetObject bucket object localFile + src <- fGetObject bucket object localFile def (src $$+- sinkLbs) case res of diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index f88bc49..ebe0750 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -89,6 +89,13 @@ module Network.Minio -- ** Conduit-based streaming operations , putObject , getObject + -- | Input data type represents GetObject options. + , GetObjectOptions + , gooRange + , gooIfMatch + , gooIfNoneMatch + , gooIfModifiedSince + , gooIfUnmodifiedSince -- ** Server-side copying , copyObject @@ -170,9 +177,9 @@ listBuckets = getService -- | Fetch the object and write it to the given file safely. The -- object is first written to a temporary file in the same directory -- and then moved to the given path. -fGetObject :: Bucket -> Object -> FilePath -> Minio () -fGetObject bucket object fp = do - src <- getObject bucket object +fGetObject :: Bucket -> Object -> FilePath -> GetObjectOptions -> Minio () +fGetObject bucket object fp opts = do + src <- getObject bucket object opts src C.$$+- CB.sinkFileCautious fp -- | Upload the given file to the given object. @@ -202,8 +209,8 @@ removeObject :: Bucket -> Object -> Minio () removeObject = deleteObject -- | Get an object from the object store as a resumable source (conduit). -getObject :: Bucket -> Object -> Minio (C.ResumableSource Minio ByteString) -getObject bucket object = snd <$> getObject' bucket object [] [] +getObject :: Bucket -> Object -> GetObjectOptions -> Minio (C.ResumableSource Minio ByteString) +getObject bucket object opts = snd <$> getObject' bucket object [] (gooToHeaders opts) -- | Get an object's metadata from the object store. statObject :: Bucket -> Object -> Minio ObjectInfo diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 2766e06..1e83464 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -30,7 +30,7 @@ import qualified Data.Text as T import Data.Time (defaultTimeLocale, formatTime) import Network.HTTP.Client (defaultManagerSettings) import qualified Network.HTTP.Conduit as NC -import Network.HTTP.Types (Header, Method, Query) +import Network.HTTP.Types (Header, Method, Query, ByteRange, hRange) import qualified Network.HTTP.Types as HT import Network.Minio.Errors import Text.XML @@ -267,7 +267,7 @@ data SourceInfo = SourceInfo { , srcIfNoneMatch :: Maybe Text , srcIfModifiedSince :: Maybe UTCTime , srcIfUnmodifiedSince :: Maybe UTCTime - } deriving (Show, Eq) + } deriving (Show, Eq) instance Default SourceInfo where def = SourceInfo "" "" def def def def def @@ -281,6 +281,33 @@ data DestinationInfo = DestinationInfo { instance Default DestinationInfo where def = DestinationInfo "" "" +data GetObjectOptions = GetObjectOptions { + -- | [ByteRangeFromTo 0 9] means first ten bytes of the source object. + gooRange :: Maybe ByteRange + , gooIfMatch :: Maybe ETag + , gooIfNoneMatch :: Maybe ETag + , gooIfUnmodifiedSince :: Maybe UTCTime + , gooIfModifiedSince :: Maybe UTCTime + } deriving (Show, Eq) + +instance Default GetObjectOptions where + def = GetObjectOptions def def def def def + +gooToHeaders :: GetObjectOptions -> [HT.Header] +gooToHeaders goo = rangeHdr ++ zip names values + where + names = ["If-Match", + "If-None-Match", + "If-Unmodified-Since", + "If-Modified-Since"] + values = mapMaybe (fmap encodeUtf8 . (goo &)) + [gooIfMatch, gooIfNoneMatch, + fmap formatRFC1123 . gooIfUnmodifiedSince, + fmap formatRFC1123 . gooIfModifiedSince] + rangeHdr = maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) + $ gooRange goo + + -- | A data-type for events that can occur in the object storage -- server. Reference: -- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 6d59990..ec273a8 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -35,6 +35,7 @@ import Data.Default (Default (..)) import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Time as Time +import Data.Time (fromGregorian) import qualified Network.HTTP.Client.MultipartFormData as Form import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT @@ -116,7 +117,7 @@ lowLevelMultipartTest = funTestWithBucket "Low-level Multipart Test" $ destFile <- mkRandFile 0 step "Retrieve the created object and check size" - fGetObject bucket object destFile + fGetObject bucket object destFile def gotSize <- withNewHandle destFile getFileSize liftIO $ gotSize == Right (Just mb15) @? "Wrong file size of put file after getting" @@ -139,7 +140,7 @@ putObjectNoSizeTest = funTestWithBucket "PutObject of conduit source with no siz step "Retrieve and verify file size" destFile <- mkRandFile 0 - fGetObject bucket obj destFile + fGetObject bucket obj destFile def gotSize <- withNewHandle destFile getFileSize liftIO $ gotSize == Right (Just mb70) @? "Wrong file size of put file after getting" @@ -180,11 +181,8 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") step "High-level listing of incomplete multipart uploads" - uploads <- listIncompleteUploads bucket Nothing True $$ sinkList - -- Minio server behaviour changed to list no incomplete uploads, - -- so the check below reflects this; this test is expected to - -- fail on AWS S3. - liftIO $ length uploads @?= 0 + uploads <- listIncompleteUploads bucket (Just "newmpupload") True $$ sinkList + liftIO $ length uploads @?= 10 step "cleanup" forM_ uploads $ \(UploadInfo _ uid _ _) -> @@ -246,12 +244,9 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.") step "list incomplete multipart uploads" - incompleteUploads <- listIncompleteUploads' bucket Nothing Nothing + incompleteUploads <- listIncompleteUploads' bucket (Just "newmpupload") Nothing Nothing Nothing Nothing - -- Minio server behaviour changed to list no incomplete uploads, - -- so the check below reflects this; this test is expected to - -- fail on AWS S3. - liftIO $ (length $ lurUploads incompleteUploads) @?= 0 + liftIO $ (length $ lurUploads incompleteUploads) @?= 10 step "cleanup" forM_ (lurUploads incompleteUploads) $ @@ -294,7 +289,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server" step "Retrieve and verify file size" destFile <- mkRandFile 0 - fGetObject bucket obj destFile + fGetObject bucket obj destFile def gotSize <- withNewHandle destFile getFileSize liftIO $ gotSize == Right (Just mb80) @? "Wrong file size of put file after getting" @@ -469,15 +464,44 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do outFile <- mkRandFile 0 step "simple fGetObject works" - fGetObject bucket "lsb-release" outFile + fGetObject bucket "lsb-release" outFile def + + let unmodifiedTime = UTCTime (fromGregorian 2010 11 26) 69857 + step "fGetObject an object which is modified now but requesting as un-modified in past, check for exception" + resE <- MC.try $ fGetObject bucket "lsb-release" outFile def{ + gooIfUnmodifiedSince = (Just unmodifiedTime) + } + case resE of + Left exn -> liftIO $ exn @?= ServiceErr "PreconditionFailed" "At least one of the pre-conditions you specified did not hold" + _ -> return () + + step "fGetObject an object with no matching etag, check for exception" + resE <- MC.try $ fGetObject bucket "lsb-release" outFile def{ + gooIfMatch = (Just "invalid-etag") + } + case resE of + Left exn -> liftIO $ exn @?= ServiceErr "PreconditionFailed" "At least one of the pre-conditions you specified did not hold" + _ -> return () + + step "fGetObject an object with no valid range, check for exception" + resE <- MC.try $ fGetObject bucket "lsb-release" outFile def{ + gooRange = (Just $ HT.ByteRangeFromTo 100 200) + } + case resE of + Left exn -> liftIO $ exn @?= ServiceErr "InvalidRange" "The requested range is not satisfiable" + _ -> return () + + step "fGetObject on object with a valid range" + fGetObject bucket "lsb-release" outFile def{ + gooRange = (Just $ HT.ByteRangeFrom 1) + } step "fGetObject a non-existent object and check for NoSuchKey exception" - resE <- MC.try $ fGetObject bucket "noSuchKey" outFile + resE <- MC.try $ fGetObject bucket "noSuchKey" outFile def case resE of Left exn -> liftIO $ exn @?= NoSuchKey _ -> return () - step "create new multipart upload works" uid <- newMultipartUpload bucket "newmpupload" [] liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")