haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Support GetObjectOptions for getObject and fGetObject (#72)

Browse Source
This commit is contained in:
Harshavardhana 2017-12-06 23:47:24 -08:00 committed by Krishnan Parthasarathi
parent fe7aef21b7
commit 8be1ff429f
4 changed files with 95 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
docs/API.md
View File

@ -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

17
src/Network/Minio.hs
View File

@ -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

31
src/Network/Minio/Data.hs
View File

@ -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

56
test/LiveServer.hs
View File

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