Add putObjectOptions for PutObject (#71)
This commit is contained in:
Harshavardhana
Krishnan Parthasarathi
parent
8be1ff429f
commit
37940ad170
@ -47,11 +47,12 @@ main = do
|
||||
|
||||
res <- runMinio minioPlayCI $ do
|
||||
liftIO $ B.putStrLn "Upload a file that we will fetch with a presigned URL..."
|
||||
putObject bucket object (CC.repeat "a") (Just kb15)
|
||||
putObject bucket object (CC.repeat "a") (Just kb15) def
|
||||
liftIO $ putStrLn $ "Done. Object created at: my-bucket/my-object"
|
||||
|
||||
-- Extract Etag of uploaded object
|
||||
(ObjectInfo _ _ etag _) <- statObject bucket object
|
||||
oi <- statObject bucket object
|
||||
let etag = oiETag oi
|
||||
|
||||
-- Set header to add an if-match constraint - this makes sure
|
||||
-- the fetching fails if the object is changed on the server
|
||||
|
||||
@ -37,17 +37,17 @@ main = do
|
||||
localFile = "/etc/lsb-release"
|
||||
kb15 = 15 * 1024
|
||||
|
||||
-- Eg 1. Upload a stream of repeating "a" using putObject.
|
||||
-- Eg 1. Upload a stream of repeating "a" using putObject with default options.
|
||||
res1 <- runMinio minioPlayCI $
|
||||
putObject bucket object (CC.repeat "a") (Just kb15)
|
||||
putObject bucket object (CC.repeat "a") (Just kb15) def
|
||||
case res1 of
|
||||
Left e -> putStrLn $ "putObject failed." ++ show e
|
||||
Right () -> putStrLn "putObject succeeded."
|
||||
|
||||
|
||||
-- Eg 2. Upload a file using fPutObject.
|
||||
-- Eg 2. Upload a file using fPutObject with default options.
|
||||
res2 <- runMinio minioPlayCI $
|
||||
fPutObject bucket object localFile
|
||||
fPutObject bucket object localFile def
|
||||
case res2 of
|
||||
Left e -> putStrLn $ "fPutObject failed." ++ show e
|
||||
Right () -> putStrLn "fPutObject succeeded."
|
||||
|
||||
@ -55,9 +55,18 @@ module Network.Minio
|
||||
-- ** Listing
|
||||
, BucketInfo(..)
|
||||
, listBuckets
|
||||
, ObjectInfo(..)
|
||||
|
||||
-- ** Object info type represents object metadata information.
|
||||
, ObjectInfo
|
||||
, oiObject
|
||||
, oiModTime
|
||||
, oiETag
|
||||
, oiSize
|
||||
, oiMetadata
|
||||
|
||||
, listObjects
|
||||
, listObjectsV1
|
||||
|
||||
, UploadId
|
||||
, UploadInfo(..)
|
||||
, listIncompleteUploads
|
||||
@ -88,6 +97,15 @@ module Network.Minio
|
||||
|
||||
-- ** Conduit-based streaming operations
|
||||
, putObject
|
||||
-- | Input data type represents PutObject options.
|
||||
, PutObjectOptions
|
||||
, pooContentType
|
||||
, pooContentEncoding
|
||||
, pooContentDisposition
|
||||
, pooCacheControl
|
||||
, pooUserMetadata
|
||||
, pooNumThreads
|
||||
|
||||
, getObject
|
||||
-- | Input data type represents GetObject options.
|
||||
, GetObjectOptions
|
||||
@ -183,18 +201,19 @@ fGetObject bucket object fp opts = do
|
||||
src C.$$+- CB.sinkFileCautious fp
|
||||
|
||||
-- | Upload the given file to the given object.
|
||||
fPutObject :: Bucket -> Object -> FilePath -> Minio ()
|
||||
fPutObject bucket object f = void $ putObjectInternal bucket object $
|
||||
ODFile f Nothing
|
||||
fPutObject :: Bucket -> Object -> FilePath
|
||||
-> PutObjectOptions -> Minio ()
|
||||
fPutObject bucket object f opts =
|
||||
void $ putObjectInternal bucket object opts $ ODFile f Nothing
|
||||
|
||||
-- | Put an object from a conduit source. The size can be provided if
|
||||
-- known; this helps the library select optimal part sizes to perform
|
||||
-- a multipart upload. If not specified, it is assumed that the object
|
||||
-- can be potentially 5TiB and selects multipart sizes appropriately.
|
||||
putObject :: Bucket -> Object -> C.Producer Minio ByteString
|
||||
-> Maybe Int64 -> Minio ()
|
||||
putObject bucket object src sizeMay =
|
||||
void $ putObjectInternal bucket object $ ODStream src sizeMay
|
||||
-> Maybe Int64 -> PutObjectOptions -> Minio ()
|
||||
putObject bucket object src sizeMay opts =
|
||||
void $ putObjectInternal bucket object opts $ ODStream src sizeMay
|
||||
|
||||
-- | Perform a server-side copy operation to create an object based on
|
||||
-- the destination specification in DestinationInfo from the source
|
||||
|
||||
@ -35,7 +35,8 @@ copyObjectInternal b' o srcInfo = do
|
||||
sObject = srcObject srcInfo
|
||||
|
||||
-- get source object size with a head request
|
||||
(ObjectInfo _ _ _ srcSize) <- headObject sBucket sObject
|
||||
oi <- headObject sBucket sObject
|
||||
let srcSize = oiSize oi
|
||||
|
||||
-- check that byte offsets are valid if specified in cps
|
||||
let rangeMay = srcRange srcInfo
|
||||
|
||||
@ -27,6 +27,7 @@ import qualified Data.ByteString as B
|
||||
import Data.Default (Default (..))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as T
|
||||
import Data.CaseInsensitive (mk)
|
||||
import Data.Time (defaultTimeLocale, formatTime)
|
||||
import Network.HTTP.Client (defaultManagerSettings)
|
||||
import qualified Network.HTTP.Conduit as NC
|
||||
@ -39,7 +40,6 @@ import GHC.Show (Show (..))
|
||||
|
||||
import Lib.Prelude
|
||||
|
||||
|
||||
-- | max obj size is 5TiB
|
||||
maxObjectSize :: Int64
|
||||
maxObjectSize = 5 * 1024 * 1024 * oneMiB
|
||||
@ -182,6 +182,45 @@ type Region = Text
|
||||
-- APIs.
|
||||
type ETag = Text
|
||||
|
||||
-- |
|
||||
-- Data type represents various options specified for PutObject call.
|
||||
-- To specify PutObject options use the poo* accessors.
|
||||
data PutObjectOptions = PutObjectOptions {
|
||||
pooContentType :: Maybe Text
|
||||
, pooContentEncoding :: Maybe Text
|
||||
, pooContentDisposition :: Maybe Text
|
||||
, pooCacheControl :: Maybe Text
|
||||
, pooUserMetadata :: [(Text, Text)]
|
||||
, pooNumThreads :: Maybe Word
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- Provide a default instance
|
||||
instance Default PutObjectOptions where
|
||||
def = PutObjectOptions def def def def [] def
|
||||
|
||||
addXAmzMetaPrefix :: Text -> Text
|
||||
addXAmzMetaPrefix s = do
|
||||
if (T.isPrefixOf "x-amz-meta-" s)
|
||||
then s
|
||||
else T.concat ["x-amz-meta-", s]
|
||||
|
||||
mkHeaderFromMetadata :: [(Text, Text)] -> [HT.Header]
|
||||
mkHeaderFromMetadata = map (\(x, y) -> (mk $ encodeUtf8 $ addXAmzMetaPrefix $ T.toLower x, encodeUtf8 y))
|
||||
|
||||
pooToHeaders :: PutObjectOptions -> [HT.Header]
|
||||
pooToHeaders poo = userMetadata ++ zip names values
|
||||
where
|
||||
userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
|
||||
|
||||
names = ["content-type",
|
||||
"content-encoding",
|
||||
"content-disposition",
|
||||
"cache-control"]
|
||||
values = mapMaybe (fmap encodeUtf8 . (poo &))
|
||||
[pooContentType, pooContentEncoding,
|
||||
pooContentDisposition, pooCacheControl]
|
||||
|
||||
|
||||
-- |
|
||||
-- BucketInfo returned for list buckets call
|
||||
data BucketInfo = BucketInfo {
|
||||
@ -206,7 +245,6 @@ data ListPartsResult = ListPartsResult {
|
||||
, lprParts :: [ObjectPartInfo]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
|
||||
-- | Represents information about an object part in an ongoing
|
||||
-- multipart upload.
|
||||
data ObjectPartInfo = ObjectPartInfo {
|
||||
@ -256,6 +294,7 @@ data ObjectInfo = ObjectInfo {
|
||||
, oiModTime :: UTCTime
|
||||
, oiETag :: ETag
|
||||
, oiSize :: Int64
|
||||
, oiMetadata :: Map.Map Text Text
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | Represents source object in server-side copy object
|
||||
@ -267,7 +306,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
|
||||
|
||||
@ -52,9 +52,10 @@ data ObjectData m =
|
||||
|
||||
-- | Put an object from ObjectData. This high-level API handles
|
||||
-- objects of all sizes, and even if the object size is unknown.
|
||||
putObjectInternal :: Bucket -> Object -> ObjectData Minio -> Minio ETag
|
||||
putObjectInternal b o (ODStream src sizeMay) = sequentialMultipartUpload b o sizeMay src
|
||||
putObjectInternal b o (ODFile fp sizeMay) = do
|
||||
putObjectInternal :: Bucket -> Object -> PutObjectOptions
|
||||
-> ObjectData Minio -> Minio ETag
|
||||
putObjectInternal b o opts (ODStream src sizeMay) = sequentialMultipartUpload b o opts sizeMay src
|
||||
putObjectInternal b o opts (ODFile fp sizeMay) = do
|
||||
hResE <- withNewHandle fp $ \h ->
|
||||
liftM2 (,) (isHandleSeekable h) (getFileSize h)
|
||||
|
||||
@ -66,28 +67,30 @@ putObjectInternal b o (ODFile fp sizeMay) = do
|
||||
|
||||
case finalSizeMay of
|
||||
-- unable to get size, so assume non-seekable file and max-object size
|
||||
Nothing -> sequentialMultipartUpload b o (Just maxObjectSize) $
|
||||
Nothing -> sequentialMultipartUpload b o opts (Just maxObjectSize) $
|
||||
CB.sourceFile fp
|
||||
|
||||
-- got file size, so check for single/multipart upload
|
||||
Just size ->
|
||||
if | size <= 64 * oneMiB -> either throwM return =<<
|
||||
withNewHandle fp (\h -> putObjectSingle b o [] h 0 size)
|
||||
withNewHandle fp (\h -> putObjectSingle b o (pooToHeaders opts) h 0 size)
|
||||
| size > maxObjectSize -> throwM $ MErrVPutSizeExceeded size
|
||||
| isSeekable -> parallelMultipartUpload b o fp size
|
||||
| otherwise -> sequentialMultipartUpload b o (Just size) $
|
||||
| isSeekable -> parallelMultipartUpload b o opts fp size
|
||||
| otherwise -> sequentialMultipartUpload b o opts (Just size) $
|
||||
CB.sourceFile fp
|
||||
|
||||
parallelMultipartUpload :: Bucket -> Object -> FilePath -> Int64
|
||||
-> Minio ETag
|
||||
parallelMultipartUpload b o filePath size = do
|
||||
parallelMultipartUpload :: Bucket -> Object -> PutObjectOptions
|
||||
-> FilePath -> Int64 -> Minio ETag
|
||||
parallelMultipartUpload b o opts filePath size = do
|
||||
-- get a new upload id.
|
||||
uploadId <- newMultipartUpload b o []
|
||||
uploadId <- newMultipartUpload b o (pooToHeaders opts)
|
||||
|
||||
let partSizeInfo = selectPartSizes size
|
||||
|
||||
-- perform upload with 10 threads
|
||||
uploadedPartsE <- limitedMapConcurrently 10
|
||||
let threads = fromMaybe 10 $ pooNumThreads opts
|
||||
|
||||
-- perform upload with 'threads' threads
|
||||
uploadedPartsE <- limitedMapConcurrently (fromIntegral threads)
|
||||
(uploadPart uploadId) partSizeInfo
|
||||
|
||||
-- if there were any errors, rethrow exception.
|
||||
@ -95,6 +98,7 @@ parallelMultipartUpload b o filePath size = do
|
||||
|
||||
-- if we get here, all parts were successfully uploaded.
|
||||
completeMultipartUpload b o uploadId $ rights uploadedPartsE
|
||||
|
||||
where
|
||||
uploadPart uploadId (partNum, offset, sz) =
|
||||
withNewHandle filePath $ \h -> do
|
||||
@ -102,11 +106,13 @@ parallelMultipartUpload b o filePath size = do
|
||||
putObjectPart b o uploadId partNum [] payload
|
||||
|
||||
-- | Upload multipart object from conduit source sequentially
|
||||
sequentialMultipartUpload :: Bucket -> Object -> Maybe Int64
|
||||
-> C.Producer Minio ByteString -> Minio ETag
|
||||
sequentialMultipartUpload b o sizeMay src = do
|
||||
sequentialMultipartUpload :: Bucket -> Object -> PutObjectOptions
|
||||
-> Maybe Int64
|
||||
-> C.Producer Minio ByteString
|
||||
-> Minio ETag
|
||||
sequentialMultipartUpload b o opts sizeMay src = do
|
||||
-- get a new upload id.
|
||||
uploadId <- newMultipartUpload b o []
|
||||
uploadId <- newMultipartUpload b o (pooToHeaders opts)
|
||||
|
||||
-- upload parts in loop
|
||||
let partSizes = selectPartSizes $ maybe maxObjectSize identity sizeMay
|
||||
|
||||
@ -382,10 +382,10 @@ headObject bucket object = do
|
||||
modTime = getLastModifiedHeader headers
|
||||
etag = getETagHeader headers
|
||||
size = getContentLength headers
|
||||
metadata = getMetadataMap headers
|
||||
|
||||
maybe (throwM MErrVInvalidObjectInfoResponse) return $
|
||||
ObjectInfo <$> Just object <*> modTime <*> etag <*> size
|
||||
|
||||
ObjectInfo <$> Just object <*> modTime <*> etag <*> size <*> Just metadata
|
||||
|
||||
|
||||
-- | Query the object store if a given bucket exists.
|
||||
|
||||
@ -22,9 +22,11 @@ import qualified Control.Exception.Lifted as ExL
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import qualified Control.Monad.Trans.Resource as R
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.CaseInsensitive (mk)
|
||||
import Data.CaseInsensitive (original)
|
||||
import qualified Data.Conduit as C
|
||||
import qualified Data.Conduit.Binary as CB
|
||||
import qualified Data.List as List
|
||||
@ -42,6 +44,7 @@ import qualified System.IO as IO
|
||||
import Lib.Prelude
|
||||
|
||||
import Network.Minio.Data
|
||||
import Network.Minio.Data.ByteString
|
||||
import Network.Minio.XmlParser (parseErrResponse)
|
||||
|
||||
allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m, MonadCatch m)
|
||||
@ -100,6 +103,12 @@ lookupHeader hdr = headMay . map snd . filter (\(h, _) -> h == hdr)
|
||||
getETagHeader :: [HT.Header] -> Maybe Text
|
||||
getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs
|
||||
|
||||
getMetadata :: [HT.Header] -> [(Text, Text)]
|
||||
getMetadata = map ((\(x, y) -> (decodeUtf8Lenient $ original x, decodeUtf8Lenient $ stripBS y)))
|
||||
|
||||
getMetadataMap :: [HT.Header] -> Map Text Text
|
||||
getMetadataMap hs = Map.fromList (getMetadata hs)
|
||||
|
||||
getLastModifiedHeader :: [HT.Header] -> Maybe UTCTime
|
||||
getLastModifiedHeader hs = do
|
||||
modTimebs <- decodeUtf8Lenient <$> lookupHeader Hdr.hLastModified hs
|
||||
|
||||
@ -29,8 +29,9 @@ module Network.Minio.XmlParser
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.List (zip3, zip4)
|
||||
import Data.List (zip3, zip4, zip5)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text.Read (decimal)
|
||||
import Data.Time
|
||||
import Text.XML
|
||||
@ -50,6 +51,9 @@ s3TimeFormat = iso8601DateFormat $ Just "%T%QZ"
|
||||
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
|
||||
uncurry4 f (a, b, c, d) = f a b c d
|
||||
|
||||
uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
|
||||
uncurry5 f (a, b, c, d, e) = f a b c d e
|
||||
|
||||
-- | Parse time strings from XML
|
||||
parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime
|
||||
parseS3XMLTime = either (throwM . MErrVXmlParse) return
|
||||
@ -134,7 +138,7 @@ parseListObjectsV1Response xmldata = do
|
||||
sizes <- parseDecimals sizeStr
|
||||
|
||||
let
|
||||
objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes
|
||||
objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat Map.empty)
|
||||
|
||||
return $ ListObjectsV1Result hasMore nextMarker objects prefixes
|
||||
|
||||
@ -161,7 +165,7 @@ parseListObjectsResponse xmldata = do
|
||||
sizes <- parseDecimals sizeStr
|
||||
|
||||
let
|
||||
objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes
|
||||
objects = map (uncurry5 ObjectInfo) $ zip5 keys modTimes etags sizes (repeat Map.empty)
|
||||
|
||||
return $ ListObjectsResult hasMore nextToken objects prefixes
|
||||
|
||||
|
||||
@ -136,7 +136,7 @@ putObjectNoSizeTest = funTestWithBucket "PutObject of conduit source with no siz
|
||||
rFile <- mkRandFile mb70
|
||||
|
||||
step "Upload multipart file."
|
||||
putObject bucket obj (CB.sourceFile rFile) Nothing
|
||||
putObject bucket obj (CB.sourceFile rFile) Nothing def
|
||||
|
||||
step "Retrieve and verify file size"
|
||||
destFile <- mkRandFile 0
|
||||
@ -155,7 +155,7 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $
|
||||
step "put 3 objects"
|
||||
let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3"]
|
||||
forM_ expectedObjects $
|
||||
\obj -> fPutObject bucket obj "/etc/lsb-release"
|
||||
\obj -> fPutObject bucket obj "/etc/lsb-release" def
|
||||
|
||||
step "High-level listing of objects"
|
||||
objects <- listObjects bucket Nothing True $$ sinkList
|
||||
@ -215,7 +215,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do
|
||||
let objects = (\s ->T.concat ["lsb-release", T.pack (show s)]) <$> [1..10::Int]
|
||||
|
||||
forM_ [1..10::Int] $ \s ->
|
||||
fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release"
|
||||
fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release" def
|
||||
|
||||
step "Simple list"
|
||||
res <- listObjects' bucket Nothing Nothing Nothing Nothing
|
||||
@ -285,7 +285,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
let mb80 = 80 * 1024 * 1024
|
||||
obj = "mpart"
|
||||
|
||||
void $ putObjectInternal bucket obj $ ODFile "/dev/zero" (Just mb80)
|
||||
void $ putObjectInternal bucket obj def $ ODFile "/dev/zero" (Just mb80)
|
||||
|
||||
step "Retrieve and verify file size"
|
||||
destFile <- mkRandFile 0
|
||||
@ -321,6 +321,25 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
uploads <- listIncompleteUploads bucket (Just object) False C.$$ sinkList
|
||||
liftIO $ (null uploads) @? "removeIncompleteUploads didn't complete successfully"
|
||||
|
||||
, funTestWithBucket "putObject contentType tests" $ \step bucket -> do
|
||||
step "fPutObject content type test"
|
||||
let object = "xxx-content-type"
|
||||
size1 = 100 :: Int64
|
||||
|
||||
step "create server object with content-type"
|
||||
inputFile <- mkRandFile size1
|
||||
fPutObject bucket object inputFile def{
|
||||
pooContentType = Just "application/javascript"
|
||||
}
|
||||
|
||||
-- retrieve obj info to check
|
||||
oi <- headObject bucket object
|
||||
let m = oiMetadata oi
|
||||
|
||||
step "Validate content-type"
|
||||
liftIO $ assertEqual "Content-Type did not match" (Just "application/javascript") (Map.lookup "Content-Type" m)
|
||||
step "Cleanup actions"
|
||||
removeObject bucket object
|
||||
|
||||
, funTestWithBucket "copyObject related tests" $ \step bucket -> do
|
||||
step "copyObjectSingle basic tests"
|
||||
@ -330,14 +349,17 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
|
||||
step "create server object to copy"
|
||||
inputFile <- mkRandFile size1
|
||||
fPutObject bucket object inputFile
|
||||
fPutObject bucket object inputFile def
|
||||
|
||||
step "copy object"
|
||||
let srcInfo = def { srcBucket = bucket, srcObject = object}
|
||||
(etag, modTime) <- copyObjectSingle bucket objCopy srcInfo []
|
||||
|
||||
-- retrieve obj info to check
|
||||
ObjectInfo _ t e s <- headObject bucket objCopy
|
||||
oi <- headObject bucket objCopy
|
||||
let t = oiModTime oi
|
||||
let e = oiETag oi
|
||||
let s = oiSize oi
|
||||
|
||||
let isMTimeDiffOk = abs (diffUTCTime modTime t) < 1.0
|
||||
|
||||
@ -356,7 +378,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
let mb15 = 15 * 1024 * 1024
|
||||
mb5 = 5 * 1024 * 1024
|
||||
randFile <- mkRandFile mb15
|
||||
fPutObject bucket srcObj randFile
|
||||
fPutObject bucket srcObj randFile def
|
||||
|
||||
step "create new multipart upload"
|
||||
uid <- newMultipartUpload bucket copyObj []
|
||||
@ -375,7 +397,8 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
void $ completeMultipartUpload bucket copyObj uid parts
|
||||
|
||||
step "verify copied object size"
|
||||
(ObjectInfo _ _ _ s') <- headObject bucket copyObj
|
||||
oi <- headObject bucket copyObj
|
||||
let s' = oiSize oi
|
||||
|
||||
liftIO $ (s' == mb15) @? "Size failed to match"
|
||||
|
||||
@ -389,8 +412,9 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
sizes = map (* (1024 * 1024)) [15, 65]
|
||||
|
||||
step "Prepare"
|
||||
forM_ (zip srcs sizes) $ \(src, size) ->
|
||||
fPutObject bucket src =<< mkRandFile size
|
||||
forM_ (zip srcs sizes) $ \(src, size) -> do
|
||||
inputFile <- mkRandFile size
|
||||
fPutObject bucket src inputFile def
|
||||
|
||||
step "make small and large object copy"
|
||||
forM_ (zip copyObjs srcs) $ \(cp, src) ->
|
||||
@ -408,7 +432,8 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
size = 15 * 1024 * 1024
|
||||
|
||||
step "Prepare"
|
||||
fPutObject bucket src =<< mkRandFile size
|
||||
inputFile <- mkRandFile size
|
||||
fPutObject bucket src inputFile def
|
||||
|
||||
step "copy last 10MiB of object"
|
||||
copyObject def { dstBucket = bucket, dstObject = copyObj } def{
|
||||
@ -454,10 +479,10 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
liftIO $ region == "us-east-1" @? ("Got unexpected region => " ++ show region)
|
||||
|
||||
step "singlepart putObject works"
|
||||
fPutObject bucket "lsb-release" "/etc/lsb-release"
|
||||
fPutObject bucket "lsb-release" "/etc/lsb-release" def
|
||||
|
||||
step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"
|
||||
fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release"
|
||||
fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" def
|
||||
case fpE of
|
||||
Left exn -> liftIO $ exn @?= NoSuchBucket
|
||||
_ -> return ()
|
||||
@ -516,7 +541,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
let object = "sample"
|
||||
step "create an object"
|
||||
inputFile <- mkRandFile 0
|
||||
fPutObject bucket object inputFile
|
||||
fPutObject bucket object inputFile def
|
||||
|
||||
step "get metadata of the object"
|
||||
res <- statObject bucket object
|
||||
|
||||
@ -21,6 +21,7 @@ module Network.Minio.XmlParser.Test
|
||||
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import Data.Time (fromGregorian)
|
||||
import qualified Data.Map as Map
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
@ -126,7 +127,7 @@ testParseListObjectsResult = do
|
||||
\</ListBucketResult>"
|
||||
|
||||
expectedListResult = ListObjectsResult True (Just "opaque") [object1] []
|
||||
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234
|
||||
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty
|
||||
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
|
||||
|
||||
parsedListObjectsResult <- tryValidationErr $ parseListObjectsResponse xmldata
|
||||
@ -153,7 +154,7 @@ testParseListObjectsV1Result = do
|
||||
\</ListBucketResult>"
|
||||
|
||||
expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] []
|
||||
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234
|
||||
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty
|
||||
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
|
||||
|
||||
parsedListObjectsV1Result <- tryValidationErr $ parseListObjectsV1Response xmldata
|
||||
|
||||
Loading…
Reference in New Issue
Block a user