From b30beecd529f087bdae5139f6a0b0917d2ff6566 Mon Sep 17 00:00:00 2001 From: Krishnan Parthasarathi Date: Thu, 23 Mar 2017 15:57:52 +0530 Subject: [PATCH] Add bucketExists and headBucket APIs (#42) Also fixed examples to work with lts-8.5 --- README.md | 7 ++--- docs/API.md | 15 ++++++++++- examples/BucketExists.hs | 43 +++++++++++++++++++++++++++++++ examples/CopyObject.hs | 2 +- examples/FileUploader.hs | 5 ++-- examples/GetObject.hs | 2 +- examples/HeadObject.hs | 2 +- examples/ListBuckets.hs | 2 +- examples/ListIncompleteUploads.hs | 2 +- examples/ListObjects.hs | 2 +- examples/Makebucket.hs | 2 +- examples/PutObject.hs | 2 +- examples/RemoveObject.hs | 5 ++-- examples/Removebucket.hs | 2 +- src/Network/Minio.hs | 5 ++++ src/Network/Minio/S3API.hs | 33 +++++++++++++++++++++++- test/LiveServer.hs | 2 ++ 17 files changed, 115 insertions(+), 18 deletions(-) create mode 100755 examples/BucketExists.hs diff --git a/README.md b/README.md index ce3c17e..6135f64 100644 --- a/README.md +++ b/README.md @@ -46,17 +46,18 @@ stack haddock ### FileUploader.hs ``` haskell #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs --package optparse-applicative --package filepath +-- stack --resolver lts-8.5 runghc --package minio-hs --package optparse-applicative --package filepath {-# Language OverloadedStrings, ScopedTypeVariables #-} import Network.Minio import Control.Monad.Catch (catchIf) import Control.Monad.IO.Class (liftIO) +import Data.Monoid ((<>)) +import Data.Text (pack) import Options.Applicative import Prelude import System.FilePath.Posix -import Data.Text (pack) -- | The following example uses minio's play server at -- https://play.minio.io:9000. The endpoint and associated @@ -102,7 +103,7 @@ main = do Right () -> putStrLn "file upload succeeded." ``` -### Run fileuploader +### Run FileUploader ``` sh ./FileUploader.hs "path/to/my/file" diff --git a/docs/API.md b/docs/API.md index bd4fa51..fc1a430 100644 --- a/docs/API.md +++ b/docs/API.md @@ -27,7 +27,7 @@ awsCI { connectAccesskey = "your-access-key" |[`removeBucket`](#removeBucket)|[`fGetObject`](#fGetObject)| |[`listObjects`](#listObjects)|[`fPutObject`](#fPutObject)| |[`listIncompleteUploads`](#listIncompleteUploads)|[`copyObject`](#copyObject)| -||[`removeObject`](#removeObject)| +|[`bucketExists`](#bucketExists)|[`removeObject`](#removeObject)| ## 1. Connecting and running operations on the storage service @@ -587,6 +587,19 @@ main = do Right _ -> putStrLn "Removed object successfully" ``` + +### bucketExists :: Bucket -> Minio Bool +Checks if a bucket exists. + +__Parameters__ + +In the expression `bucketExists bucketName` the parameters are: + +|Param |Type |Description | +|:---|:---| :---| +| `bucketName` | _Bucket_ (alias for `Text`) | Name of the bucket | + + diff --git a/examples/BucketExists.hs b/examples/BucketExists.hs new file mode 100755 index 0000000..b5a1ca8 --- /dev/null +++ b/examples/BucketExists.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 Control.Monad.IO.Class (liftIO) +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 = "missingbucket" + + res1 <- runResourceT $ runMinio minioPlayCI $ do + foundBucket <- bucketExists bucket + liftIO $ putStrLn $ "Does " ++ show bucket ++ " exist? - " ++ show foundBucket + + case res1 of + Left e -> putStrLn $ "bucketExists failed." ++ (show e) + Right () -> return () diff --git a/examples/CopyObject.hs b/examples/CopyObject.hs index 271017d..a4ee728 100755 --- a/examples/CopyObject.hs +++ b/examples/CopyObject.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/FileUploader.hs b/examples/FileUploader.hs index 6798554..988b3df 100755 --- a/examples/FileUploader.hs +++ b/examples/FileUploader.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs --package optparse-applicative --package filepath +-- stack --resolver lts-8.5 runghc --package minio-hs --package optparse-applicative --package filepath -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. @@ -23,10 +23,11 @@ import Network.Minio import Control.Monad.Catch (catchIf) import Control.Monad.IO.Class (liftIO) +import Data.Monoid ((<>)) +import Data.Text (pack) import Options.Applicative import Prelude import System.FilePath.Posix -import Data.Text (pack) -- | The following example uses minio's play server at -- https://play.minio.io:9000. The endpoint and associated diff --git a/examples/GetObject.hs b/examples/GetObject.hs index 4d4065d..4aeae57 100755 --- a/examples/GetObject.hs +++ b/examples/GetObject.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/HeadObject.hs b/examples/HeadObject.hs index cf73b1f..f0f7b08 100755 --- a/examples/HeadObject.hs +++ b/examples/HeadObject.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/ListBuckets.hs b/examples/ListBuckets.hs index 3190028..731edd8 100755 --- a/examples/ListBuckets.hs +++ b/examples/ListBuckets.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/ListIncompleteUploads.hs b/examples/ListIncompleteUploads.hs index bbe71c0..491fecd 100755 --- a/examples/ListIncompleteUploads.hs +++ b/examples/ListIncompleteUploads.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/ListObjects.hs b/examples/ListObjects.hs index 6a8635d..c861911 100755 --- a/examples/ListObjects.hs +++ b/examples/ListObjects.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/Makebucket.hs b/examples/Makebucket.hs index aaa7afa..75188c0 100755 --- a/examples/Makebucket.hs +++ b/examples/Makebucket.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/PutObject.hs b/examples/PutObject.hs index d0afea4..3c5ba4d 100755 --- a/examples/PutObject.hs +++ b/examples/PutObject.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/examples/RemoveObject.hs b/examples/RemoveObject.hs index 6cb4aed..b5e6ffc 100755 --- a/examples/RemoveObject.hs +++ b/examples/RemoveObject.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. @@ -20,6 +20,7 @@ {-# Language OverloadedStrings #-} import Network.Minio +import Prelude main :: IO () main = do @@ -31,5 +32,5 @@ main = do removeObject bucket object case res of - Left e -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object + Left _ -> putStrLn $ "Failed to remove " ++ show bucket ++ "/" ++ show object Right _ -> putStrLn "Removed object successfully" diff --git a/examples/Removebucket.hs b/examples/Removebucket.hs index ed299c2..51794a7 100755 --- a/examples/Removebucket.hs +++ b/examples/Removebucket.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --resolver lts-6.27 runghc --package minio-hs +-- stack --resolver lts-8.5 runghc --package minio-hs -- -- Minio Haskell SDK, (C) 2017 Minio, Inc. diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index d027424..753fb01 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -53,6 +53,7 @@ module Network.Minio ---------------------- , listBuckets , getLocation + , bucketExists , makeBucket , removeBucket @@ -149,3 +150,7 @@ removeBucket :: Bucket -> Minio () removeBucket bucket = do deleteBucket bucket modify (Map.delete bucket) + +-- | Query the object store if a given bucket is present. +bucketExists :: Bucket -> Minio Bool +bucketExists = headBucket diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 29cb864..f860578 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -28,6 +28,8 @@ module Network.Minio.S3API , ListObjectsResult , listObjects' + -- * Retrieving buckets + , headBucket -- * Retrieving objects ----------------------- , getObject' @@ -64,12 +66,14 @@ module Network.Minio.S3API ) where +import Control.Monad.Catch (catches, Handler(..)) import qualified Data.Conduit as C import Data.Default (def) import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT +import Network.HTTP.Types.Status (status404) -import Lib.Prelude +import Lib.Prelude hiding (catches) import Network.Minio.API import Network.Minio.Data @@ -325,3 +329,30 @@ headObject bucket object = do maybe (throwM MErrVInvalidObjectInfoResponse) return $ ObjectInfo <$> Just object <*> modTime <*> etag <*> size + + + +-- | Query the object store if a given bucket exists. +headBucket :: Bucket -> Minio Bool +headBucket bucket = headBucketEx `catches` + [ Handler handleNoSuchBucket + , Handler handleStatus404 + ] + + where + handleNoSuchBucket :: ServiceErr -> Minio Bool + handleNoSuchBucket e | e == NoSuchBucket = return False + | otherwise = throwM e + + handleStatus404 :: NC.HttpException -> Minio Bool + handleStatus404 e@(NC.HttpExceptionRequest _ (NC.StatusCodeException res _)) = + if NC.responseStatus res == status404 + then return False + else throwM e + handleStatus404 e = throwM e + + headBucketEx = do + resp <- executeRequest $ def { riMethod = HT.methodHead + , riBucket = Just bucket + } + return $ (NC.responseStatus resp) == HT.ok200 diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 293ae2f..d280291 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -85,6 +85,8 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do connInfo <- maybe minioPlayCI (const def) <$> lookupEnv "MINIO_LOCAL" ret <- runResourceT $ runMinio connInfo $ do liftStep $ "Creating bucket for test - " ++ t + foundBucket <- bucketExists b + liftIO $ foundBucket @?= False makeBucket b def minioTest liftStep b deleteBucket b