diff --git a/app/Main.hs b/app/Main.hs index 45ca1a7..30fefbc 100644 --- a/app/Main.hs +++ b/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" diff --git a/minio-hs.cabal b/minio-hs.cabal index aba5834..69d7000 100644 --- a/minio-hs.cabal +++ b/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 diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 4184fa3..5a16f40 100644 --- a/src/Network/Minio/Data.hs +++ b/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 diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index d1be5cc..48379fb 100644 --- a/src/Network/Minio/S3API.hs +++ b/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 () diff --git a/src/Network/Minio/XmlGenerator.hs b/src/Network/Minio/XmlGenerator.hs new file mode 100644 index 0000000..c3890e7 --- /dev/null +++ b/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 [] diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 14fdcf8..a3ad309 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/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]