Add bucketExists and headBucket APIs (#42)

Also fixed examples to work with lts-8.5

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"

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"
 ```
 
+<a name="BucketExists"></a>
+### 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 |
+
+
 <!-- ## 4. Presigned operations -->
 
 <!-- TODO -->

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 ()

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.

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

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.

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.

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.

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.

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.

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.

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.

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"

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.

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

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

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