Support GetObjectOptions for getObject and fGetObject (minio#72)

docs/API.md

@@ -473,7 +473,7 @@ main = do
 ```
 
 <a name="fGetObject"></a>
-### 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

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

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

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.")