Add removeIncompleteupload API (minio#49)

docs/API.md

@@ -584,6 +584,40 @@ main = do
     Right _ -> putStrLn "Removed object successfully"
 ```
 
+<a name="removeIncompleteUpload"></a>
+### removeIncompleteUpload :: Bucket -> Object -> Minio ()
+Removes an ongoing multipart upload of an object from the service
+
+__Parameters__
+
+In the expression `removeIncompleteUpload bucketName objectName` the parameters
+are:
+
+|Param   |Type   |Description   |
+|:---|:---| :---|
+| `bucketName`  | _Bucket_ (alias for `Text`)  | Name of the bucket |
+| `objectName` | _Object_ (alias for `Text`)  | Name of the object |
+
+__Example__
+
+```haskell
+{-# Language OverloadedStrings #-}
+import Network.Minio
+
+main :: IO ()
+main = do
+  let
+    bucket = "mybucket"
+    object = "myobject"
+
+  res <- runMinio minioPlayCI $
+           removeIncompleteUpload bucket object
+
+  case res of
+    Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object
+    Right _ -> putStrLn "Removed incomplete upload successfully"
+```
+
 <a name="BucketExists"></a>
 ### bucketExists :: Bucket -> Minio Bool
 Checks if a bucket exists.

examples/RemoveIncompleteUpload.hs

@@ -0,0 +1,43 @@
+#!/usr/bin/env stack
+-- stack --resolver lts-8.5 runghc --package minio-hs
+
+--
+-- Minio Haskell SDK, (C) 2017 Minio, Inc.
+--
+-- Licensed under the Apache License, Version 2.0 (the "License");
+-- you may not use this file except in compliance with the License.
+-- You may obtain a copy of the License at
+--
+--     http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS,
+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+-- See the License for the specific language governing permissions and
+-- limitations under the License.
+--
+
+{-# Language OverloadedStrings #-}
+import Network.Minio
+
+import Prelude
+
+-- | The following example uses minio's play server at
+-- https://play.minio.io:9000.  The endpoint and associated
+-- credentials are provided via the libary constant,
+--
+-- > minioPlayCI :: ConnectInfo
+--
+
+main :: IO ()
+main = do
+  let
+    bucket = "mybucket"
+    object = "myobject"
+
+  res <- runMinio minioPlayCI $
+           removeIncompleteUpload bucket object
+
+  case res of
+    Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object
+    Right _ -> putStrLn "Removed incomplete upload successfully"

src/Network/Minio.hs

@@ -14,11 +14,15 @@
 -- limitations under the License.
 --
 
+
+
 module Network.Minio
   (
 
     ConnectInfo(..)
   , awsCI
+
+
   , awsWithRegionCI
   , minioPlayCI
   , minioCI
@@ -69,6 +73,7 @@ module Network.Minio
 
   , getObject
   , statObject
+  , removeIncompleteUpload
 
   ) where
 
@@ -78,6 +83,7 @@ This module exports the high-level Minio API for object storage.
 
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.Combinators as CC
 import           Data.Default (def)
 import qualified Data.Map as Map
 
@@ -144,6 +150,7 @@ makeBucket bucket regionMay= do
   putBucket bucket region
   modify (Map.insert bucket region)
 
+-- | Removes a bucket from the object store.
 removeBucket :: Bucket -> Minio ()
 removeBucket bucket = do
   deleteBucket bucket
@@ -152,3 +159,10 @@ removeBucket bucket = do
 -- | Query the object store if a given bucket is present.
 bucketExists :: Bucket -> Minio Bool
 bucketExists = headBucket
+
+
+-- | Removes an ongoing multipart upload of an object.
+removeIncompleteUpload :: Bucket -> Object -> Minio ()
+removeIncompleteUpload bucket object = do
+  uploads <- listIncompleteUploads bucket (Just object) False C.$$ CC.sinkList
+  mapM_ (abortMultipartUpload bucket object) (uiUploadId <$> uploads)

test/LiveServer.hs

@@ -222,7 +222,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
       liftIO $ gotSize == Right (Just mb100) @?
         "Wrong file size of put file after getting"
 
-      step $ "Cleanup actions"
+      step "Cleanup actions"
       removeObject bucket obj
 
       step "Prepare for putObjectInternal with large file as source."
@@ -233,6 +233,28 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
       step "cleanup"
       removeObject bucket "big"
 
+      step "Prepare for removeIncompleteUpload"
+      -- low-level multipart operation tests.
+      let object = "newmpupload"
+          mb15 = 5 * 1024 * 1024
+
+      step "create new multipart upload"
+      uid <- newMultipartUpload bucket object []
+      liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."
+
+      randFile <- mkRandFile mb15
+
+      step "upload 2 parts"
+      for [1,2] $ \partNum -> do
+        h <- liftIO $ SIO.openBinaryFile randFile SIO.ReadMode
+        void $ putObjectPart bucket object uid partNum [] $ PayloadH h 0 mb15
+
+      step "remove ongoing upload"
+      removeIncompleteUpload bucket object
+      uploads <- listIncompleteUploads bucket (Just object) False C.$$ sinkList
+      liftIO $ (uploads == []) @? "removeIncompleteUploads didn't complete successfully"
+
+
 
   , funTestWithBucket "Listing Test" $ \step bucket -> do
       step "listObjects' test"