Add abort multipart

src/Network/Minio.hs

@@ -20,8 +20,10 @@ module Network.Minio
   , D.Bucket
   , D.Object
   , D.BucketInfo(..)
-  , D.MultipartUpload(..)
+  , D.UploadId
 
+  -- * Bucket and Object Operations
+  ---------------------------------
   , S.getService
   , S.getLocation
 

src/Network/Minio/Data.hs

@@ -7,7 +7,7 @@ module Network.Minio.Data
   , Object
   , Region
   , BucketInfo(..)
-  , MultipartUpload(..)
+  , UploadId
   , getPathFromRI
   , getRegionFromRI
   , Minio
@@ -71,10 +71,6 @@ data BucketInfo = BucketInfo {
 -- | A type alias to represent an upload-id for multipart upload
 type UploadId = Text
 
--- | Info about a multipart upload
-data MultipartUpload = MultipartUpload Bucket Object UploadId
-  deriving (Show, Eq)
-
 data Payload = PayloadBS ByteString
              | PayloadH Handle
                         Int64 -- offset

src/Network/Minio/S3API.hs

@@ -1,12 +1,30 @@
 module Network.Minio.S3API
-  ( getService
+  (
-  , getLocation
+    getLocation
+
+  -- * Listing buckets
+  --------------------
+  , getService
+
+
+  -- * Retrieving objects
+  -----------------------
   , getObject
+
+  -- * Creating buckets and objects
+  ---------------------------------
   , putBucket
   , putObject
+
+  -- * Deletion APIs
+  --------------------------
   , deleteBucket
   , deleteObject
+
+  -- * Multipart Upload APIs
+  --------------------------
   , newMultipartUpload
+  , abortMultipartUpload
   ) where
 
 import qualified Network.HTTP.Types as HT
@@ -97,7 +115,8 @@ deleteObject bucket object = do
         , riObject = Just object
         }
 
-newMultipartUpload :: Bucket -> Object -> [HT.Header] -> Minio MultipartUpload
+-- | Create a new multipart upload.
+newMultipartUpload :: Bucket -> Object -> [HT.Header] -> Minio UploadId
 newMultipartUpload bucket object headers = do
   resp <- executeRequest $ def { riMethod = HT.methodPost
                                , riBucket = Just bucket
@@ -106,3 +125,13 @@ newMultipartUpload bucket object headers = do
                                , riHeaders = headers
                                }
   parseNewMultipartUpload $ NC.responseBody resp
+
+-- | Abort a multipart upload.
+abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()
+abortMultipartUpload bucket object uploadId = do
+  void $ executeRequest $ def { riMethod = HT.methodDelete
+                              , riBucket = Just bucket
+                              , riObject = Just object
+                              , riQueryParams = [("uploadId",
+                                                  Just $ encodeUtf8 uploadId)]
+                              }

src/Network/Minio/XmlParser.hs

@@ -39,11 +39,8 @@ parseLocation xmldata = do
 
 -- | Parse the response XML of an newMultipartUpload call.
 parseNewMultipartUpload :: (MonadError MinioErr m)
-                        => LByteString -> m MultipartUpload
+                        => LByteString -> m UploadId
 parseNewMultipartUpload xmldata = do
   doc <- either (throwError . MErrXml . show) return $ parseLBS def xmldata
-  let cursor = fromDocument doc
+  return $ T.concat $ fromDocument doc
-      bucket = T.concat $ cursor $// element (s3Name "Bucket") &/ content
+    $// element (s3Name "UploadId") &/ content
-      object = T.concat $ cursor $// element (s3Name "Key") &/ content
-      upId = T.concat $ cursor $// element (s3Name "UploadId") &/ content
-  return $ MultipartUpload bucket object upId

test/Spec.hs

@@ -72,10 +72,8 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
         fGetObject "testbucket" "lsb-release" "/tmp/out"
 
         liftIO $ step "create new multipart upload works"
-        mp@(MultipartUpload _ _ uid) <- newMultipartUpload "testbucket"
+        uid <- newMultipartUpload "testbucket" "newmpupload" []
-                                        "newmpupload" []
+        liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
-        liftIO $ (T.length uid > 0) @?
-          ("Got an empty newMultipartUpload Id => " ++ show mp)
 
         liftIO $ step "abort a new multipart upload works"
         abortMultipartUpload "testbucket" "newmpupload" uid