Add putBucket API

app/Main.hs

@@ -3,6 +3,7 @@ module Main where
 import Protolude
 
 import Network.Minio
+import Network.Minio.S3API
 
 -- import Network.Minio.S3API
 import Control.Monad.Trans.Resource (runResourceT)
@@ -31,6 +32,8 @@ main = do
     res <- getLocation "test1"
     print res
 
+    status <- putBucket "test1" res
+    print status
     fGetObject "test1" "passwd" "/tmp/passwd"
 
   print "After runResourceT"

src/Network/Minio/Data.hs

@@ -6,6 +6,7 @@ module Network.Minio.Data
   , MinioConn(..)
   , Bucket
   , Object
+  , Location
   , BucketInfo(..)
   , getPathFromRI
   , Minio
@@ -44,6 +45,9 @@ defaultConnectInfo =
 type Bucket = Text
 type Object = Text
 
+-- FIXME: This could be a Sum Type with all defined regions for AWS.
+type Location = Text
+
 data BucketInfo = BucketInfo {
     biName :: Bucket
   , biCreationDate :: UTCTime

src/Network/Minio/S3API.hs

@@ -2,11 +2,15 @@ module Network.Minio.S3API
   ( getService
   , getLocation
   , getObject
+  , putBucket
   ) where
 
 import qualified Network.HTTP.Types as HT
 import qualified Network.HTTP.Conduit as NC
 import qualified Data.Conduit as C
+import qualified Data.ByteString.Lazy as LBS
+import Text.XML
+import qualified Data.Map as M
 
 
 import           Lib.Prelude
@@ -37,3 +41,16 @@ getObject bucket object queryParams headers = do
   where
     reqInfo = requestInfo HT.methodGet (Just bucket) (Just object)
               queryParams headers (PayloadSingle "")
+
+
+putBucket :: Bucket -> Location -> Minio HT.Status
+putBucket bucket location = do
+  resp <- executeRequest $
+    requestInfo HT.methodPut (Just bucket) Nothing [] [] (PayloadSingle $ LBS.toStrict $ renderLBS def bucketConfig)
+  return $ NC.responseStatus resp
+    where
+      root = Element (Name "CreateBucketConfiguration" (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing) M.empty
+        [ NodeElement $ Element  "LocationConstraint" M.empty
+          [ NodeContent location]
+        ]
+      bucketConfig = Document (Prologue [] Nothing []) root []