diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index f5283f1..a7a8b7a 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -8,6 +8,7 @@ module Network.Minio , Minio , runMinio + , runResourceT -- * Error handling ----------------------- @@ -31,8 +32,11 @@ module Network.Minio , fGetObject , fPutObject + , putObjectFromSource + , ObjectData(..) , putObject + , listObjects , listIncompleteUploads , listIncompleteParts @@ -42,6 +46,7 @@ module Network.Minio This module exports the high-level Minio API for object storage. -} +import Control.Monad.Trans.Resource (runResourceT) import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB @@ -64,3 +69,13 @@ fGetObject bucket object fp = do fPutObject :: Bucket -> Object -> FilePath -> Minio () fPutObject bucket object f = void $ putObject bucket object $ 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 +-- performing a multipart upload. If not specified, it is assumed that +-- the object can be potentially 5TiB and selects multipart sizes +-- appropriately. +putObjectFromSource :: Bucket -> Object -> C.Producer Minio ByteString + -> Maybe Int64 -> Minio () +putObjectFromSource bucket object src sizeMay = void $ putObject bucket object $ + ODStream src sizeMay diff --git a/src/Network/Minio/PutObject.hs b/src/Network/Minio/PutObject.hs index ac99930..62254ef 100644 --- a/src/Network/Minio/PutObject.hs +++ b/src/Network/Minio/PutObject.hs @@ -68,9 +68,8 @@ putObject b o (ODFile fp sizeMay) = do -- got file size, so check for single/multipart upload Just size -> - if | size <= 64 * oneMiB -> do - resE <- withNewHandle fp (\h -> putObjectSingle b o [] h 0 size) - either throwM return resE + if | size <= 64 * oneMiB -> either throwM return =<< + withNewHandle fp (\h -> putObjectSingle b o [] h 0 size) | size > maxObjectSize -> throwM $ ValidationError $ MErrVPutSizeExceeded size | isSeekable -> parallelMultipartUpload b o fp size @@ -151,14 +150,11 @@ sequentialMultipartUpload b o sizeMay src = do -- complete multipart upload completeMultipartUpload b o uploadId uploadedParts where - rSrc = C.newResumableSource src - partSizeInfo = selectPartSizes $ maybe maxObjectSize identity sizeMay - -- make a sink that consumes only `s` bytes limitedSink s = CB.isolate (fromIntegral s) C.=$= CB.sinkLbs -- FIXME: test, confirm and remove traceShowM statements - loopFunc pmap uid rSource ([], uparts) = return $ Right $ reverse uparts + loopFunc _ _ _ ([], uparts) = return $ Right $ reverse uparts loopFunc pmap uid rSource (((partNum, _, size):ps), uparts) = do (newSource, buf) <- rSource C.$$++ (limitedSink size) traceShowM "psize: " diff --git a/test/Spec.hs b/test/Spec.hs index 2d02cd3..8d58323 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -21,7 +21,6 @@ import Network.Minio.XmlParser.Test main :: IO () main = defaultMain tests --- main = putStrLn ("Test suite not yet implemented" :: Text) tests :: TestTree tests = testGroup "Tests" [properties, unitTests, liveServerUnitTests] @@ -60,9 +59,9 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do -- generate a random name for the bucket bktSuffix <- liftIO $ generate $ Q.vectorOf 10 (Q.choose ('a', 'z')) let b = T.concat [funTestBucketPrefix, T.pack bktSuffix] - step $ "Creating bucket for test - " ++ t - let liftStep = liftIO . step + liftStep = liftIO . step ret <- runResourceT $ runMinio def $ do + liftStep $ "Creating bucket for test - " ++ t putBucket b "us-east-1" minioTest liftStep b deleteBucket b