Add putObjectFromSource and some minor refactors

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

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
+      if | size <= 64 * oneMiB -> either throwM return =<<
-             resE <- withNewHandle fp (\h -> putObjectSingle b o [] h 0 size)
+           withNewHandle fp (\h -> putObjectSingle b o [] h 0 size)
-             either throwM return resE
          | 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: "

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
+      liftStep = liftIO . step
-  let liftStep = liftIO . step
   ret <- runResourceT $ runMinio def $ do
+    liftStep $ "Creating bucket for test - " ++ t
     putBucket b "us-east-1"
     minioTest liftStep b
     deleteBucket b