From 153c5a67cdb62575f462698156a7609eb1476190 Mon Sep 17 00:00:00 2001
From: Aditya Manthramurthy <donatello@users.noreply.github.com>
Date: Sat, 11 Feb 2017 11:08:00 +0530
Subject: [PATCH] Add high-level makeBucket API (#2)

* Add high-level makeBucket API

* Add build badge

* Bring back live server tests.
---
 .travis.yml                |  2 ++
 README.md                  |  2 +-
 src/Network/Minio.hs       | 11 ++++++++++-
 src/Network/Minio/Data.hs  |  3 ++-
 src/Network/Minio/S3API.hs |  5 ++---
 test/Spec.hs               |  5 ++---
 6 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index ad53513..0a8830d 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -37,4 +37,6 @@ install:
 
 script:
 # Build the package, its tests, and its docs and run the tests
+- wget -q "https://dl.minio.io/server/minio/release/linux-amd64/minio" && chmod +x ./minio
+- MINIO_ACCESS_KEY=minio MINIO_SECRET_KEY=minio123 ./minio server /tmp/export &
 - stack --no-terminal test --haddock --no-haddock-deps
diff --git a/README.md b/README.md
index 599a751..c81b432 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-# Minio Client SDK for Haskell
+# Minio Client SDK for Haskell [![Build Status](https://travis-ci.org/donatello/minio-hs.svg?branch=master)](https://travis-ci.org/donatello/minio-hs)
 
 This Minio Haskell Client SDK provides simple APIs to
 access [Minio](https://minio.io), AWS S3 or any S3-compatible object
diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs
index 1a78a6c..a772bd5 100644
--- a/src/Network/Minio.hs
+++ b/src/Network/Minio.hs
@@ -4,7 +4,6 @@ module Network.Minio
     ConnectInfo(..)
   , awsCI
   , minioPlayCI
-  , connect
 
   , Minio
   , runMinio
@@ -31,6 +30,7 @@ module Network.Minio
   ----------------------
   , getService
   , getLocation
+  , makeBucket
 
   , listObjects
   , listIncompleteUploads
@@ -87,3 +87,12 @@ putObjectFromSource bucket object src sizeMay = void $ putObject bucket object $
 -- | Get an object from the object store as a resumable source (conduit).
 getObject :: Bucket -> Object -> Minio (C.ResumableSource Minio ByteString)
 getObject bucket object = snd <$> getObject' bucket object [] []
+
+-- | Creates a new bucket in the object store. The Region can be
+-- optionally specified. If not specified, it will use the region
+-- configured in ConnectInfo, which is by default, the US Standard
+-- Region.
+makeBucket :: Bucket -> Maybe Region -> Minio ()
+makeBucket bucket regionMay= do
+  region <- maybe (asks $ connectRegion . mcConnInfo) return regionMay
+  putBucket bucket region
diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs
index 5044905..566d15f 100644
--- a/src/Network/Minio/Data.hs
+++ b/src/Network/Minio/Data.hs
@@ -23,10 +23,11 @@ data ConnectInfo = ConnectInfo {
   , connectAccessKey :: Text
   , connectSecretKey :: Text
   , connectIsSecure :: Bool
+  , connectRegion :: Region
   } deriving (Eq, Show)
 
 instance Default ConnectInfo where
-  def = ConnectInfo "localhost" 9000 "minio" "minio123" False
+  def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1"
 
 -- |
 -- Default aws ConnectInfo. Credentials should be supplied before use.
diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs
index 1e0cecb..7fcce80 100644
--- a/src/Network/Minio/S3API.hs
+++ b/src/Network/Minio/S3API.hs
@@ -74,7 +74,8 @@ getObject' bucket object queryParams headers = do
     reqInfo = def { riBucket = Just bucket
                   , riObject = Just object
                   , riQueryParams = queryParams
-                  , riHeaders = headers}
+                  , riHeaders = headers
+                  }
 
 -- | Creates a bucket via a PUT bucket call.
 putBucket :: Bucket -> Region -> Minio ()
@@ -113,8 +114,6 @@ putObjectSingle bucket object headers h offset size = do
     (throwM $ ValidationError MErrVETagHeaderNotFound)
     return etag
 
-
-
 -- | List objects in a bucket matching prefix up to delimiter,
 -- starting from nextToken.
 listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text
diff --git a/test/Spec.hs b/test/Spec.hs
index d5cd556..ee5b8fd 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -29,8 +29,7 @@ main :: IO ()
 main = defaultMain tests
 
 tests :: TestTree
-tests = testGroup "Tests" [properties, unitTests]
--- tests = testGroup "Tests" [properties, unitTests, liveServerUnitTests]
+tests = testGroup "Tests" [properties, unitTests, liveServerUnitTests]
 
 properties :: TestTree
 properties = testGroup "Properties" [] -- [scProps, qcProps]
@@ -92,7 +91,7 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do
       liftStep = liftIO . step
   ret <- runResourceT $ runMinio def $ do
     liftStep $ "Creating bucket for test - " ++ t
-    putBucket b "us-east-1"
+    makeBucket b def
     minioTest liftStep b
     deleteBucket b
   isRight ret @? ("Functional test " ++ t ++ " failed => " ++ show ret)