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"