diff --git a/docs/API.md b/docs/API.md
index f010f05..093f5f0 100644
--- a/docs/API.md
+++ b/docs/API.md
@@ -584,6 +584,40 @@ main = do
Right _ -> putStrLn "Removed object successfully"
```
+
+### 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"
+```
+
### bucketExists :: Bucket -> Minio Bool
Checks if a bucket exists.
diff --git a/examples/RemoveIncompleteUpload.hs b/examples/RemoveIncompleteUpload.hs
new file mode 100755
index 0000000..adda4db
--- /dev/null
+++ b/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"
diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs
index 77278dd..702fd53 100644
--- a/src/Network/Minio.hs
+++ b/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)
diff --git a/test/LiveServer.hs b/test/LiveServer.hs
index a27cc89..543113e 100644
--- a/test/LiveServer.hs
+++ b/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"