Move Xml Generation to a module

- Make putBucket throw exception of failure

app/Main.hs

@@ -32,8 +32,9 @@ main = do
     res <- getLocation "test1"
     print res
 
-    status <- putBucket "test1" res
-    print status
+    res <- putBucket "test1" res
+    print res
+
     fGetObject "test1" "passwd" "/tmp/passwd"
 
   print "After runResourceT"

minio-hs.cabal

@@ -26,6 +26,7 @@ library
                      , Network.Minio.Sign.V4
                      , Network.Minio.API
                      , Network.Minio.XmlParser
+                     , Network.Minio.XmlGenerator
   build-depends:       base >= 4.7 && < 5
                      , protolude >= 0.1.6 && < 0.2
                      , bytestring

src/Network/Minio/Data.hs

@@ -15,6 +15,7 @@ module Network.Minio.Data
   , defaultConnectInfo
   , connect
   , Payload(..)
+  , s3Name
   ) where
 
 import qualified Data.ByteString as B
@@ -27,6 +28,8 @@ import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT, ResIO)
 import Control.Monad.Base (MonadBase(..))
 
+import Text.XML
+
 import           Lib.Prelude
 
 data ConnectInfo = ConnectInfo {
@@ -107,3 +110,6 @@ connect ci = do
 
 runMinio :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
 runMinio conn = runExceptT . flip runReaderT conn . unMinio
+
+s3Name :: Text -> Name
+s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing

src/Network/Minio/S3API.hs

@@ -8,16 +8,15 @@ module Network.Minio.S3API
 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
 
+import qualified Data.ByteString.Lazy as LBS
+
 import           Network.Minio.Data
 import Network.Minio.API
 import Network.Minio.XmlParser
+import Network.Minio.XmlGenerator
 
 getService :: Minio [BucketInfo]
 getService = do
@@ -42,15 +41,12 @@ getObject bucket object queryParams headers = do
     reqInfo = requestInfo HT.methodGet (Just bucket) (Just object)
               queryParams headers (PayloadSingle "")
 
-
-putBucket :: Bucket -> Location -> Minio HT.Status
+putBucket :: Bucket -> Location -> Minio ()
 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 []
+    requestInfo HT.methodPut (Just bucket) Nothing [] [] (PayloadSingle $ mkCreateBucketConfig bucket location)
+
+  let httpStatus = NC.responseStatus resp
+  when (httpStatus /= HT.ok200) $
+    throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp
+  return ()

src/Network/Minio/XmlGenerator.hs

@@ -0,0 +1,20 @@
+module Network.Minio.XmlGenerator
+  ( mkCreateBucketConfig
+  ) where
+
+import Lib.Prelude
+
+import qualified Data.ByteString.Lazy as LBS
+import Text.XML
+import qualified Data.Map as M
+
+import Network.Minio.Data
+
+mkCreateBucketConfig :: Bucket -> Location -> ByteString
+mkCreateBucketConfig bucket location = LBS.toStrict $ renderLBS def bucketConfig
+  where
+      root = Element (s3Name "CreateBucketConfiguration") M.empty
+        [ NodeElement $ Element  "LocationConstraint" M.empty
+          [ NodeContent location]
+        ]
+      bucketConfig = Document (Prologue [] Nothing []) root []

src/Network/Minio/XmlParser.hs

@@ -13,9 +13,6 @@ import           Lib.Prelude
 
 import Network.Minio.Data
 
-s3Name :: Text -> Name
-s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
-
 s3TimeFormat = iso8601DateFormat $ Just "%T%QZ"
 
 parseListBuckets :: (MonadError MinioErr m) => LByteString -> m [BucketInfo]