module Aws.S3.Commands.PutBucket where import Aws.Core import Aws.S3.Core import Control.Monad import Data.Maybe import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Network.HTTP.Conduit as HTTP import qualified Text.XML as XML data PutBucket = PutBucket { pbBucket :: Bucket , pbCannedAcl :: Maybe CannedAcl , pbLocationConstraint :: LocationConstraint , pbXStorageClass :: Maybe StorageClass -- ^ Google Cloud Storage S3 nonstandard extension } deriving (Show) putBucket :: Bucket -> PutBucket putBucket bucket = PutBucket bucket Nothing locationUsClassic Nothing data PutBucketResponse = PutBucketResponse deriving (Show) -- | ServiceConfiguration: 'S3Configuration' instance SignQuery PutBucket where type ServiceConfiguration PutBucket = S3Configuration signQuery PutBucket{..} = s3SignQuery (S3Query { s3QMethod = Put , s3QBucket = Just $ T.encodeUtf8 pbBucket , s3QSubresources = [] , s3QQuery = [] , s3QContentType = Nothing , s3QContentMd5 = Nothing , s3QObject = Nothing , s3QAmzHeaders = case pbCannedAcl of Nothing -> [] Just acl -> [("x-amz-acl", T.encodeUtf8 $ writeCannedAcl acl)] , s3QOtherHeaders = [] , s3QRequestBody = guard (not (null elts)) >> (Just . HTTP.RequestBodyLBS . XML.renderLBS XML.def) XML.Document { XML.documentPrologue = XML.Prologue [] Nothing [] , XML.documentRoot = root , XML.documentEpilogue = [] } }) where root = XML.Element { XML.elementName = "{http://s3.amazonaws.com/doc/2006-03-01/}CreateBucketConfiguration" , XML.elementAttributes = M.empty , XML.elementNodes = elts } elts = catMaybes [ if T.null pbLocationConstraint then Nothing else Just (locationconstraint pbLocationConstraint) , fmap storageclass pbXStorageClass ] locationconstraint c = XML.NodeElement (XML.Element { XML.elementName = "{http://s3.amazonaws.com/doc/2006-03-01/}LocationConstraint" , XML.elementAttributes = M.empty , XML.elementNodes = [XML.NodeContent c] }) storageclass c = XML.NodeElement (XML.Element { XML.elementName = "StorageClass" , XML.elementAttributes = M.empty , XML.elementNodes = [XML.NodeContent (writeStorageClass c)] }) instance ResponseConsumer r PutBucketResponse where type ResponseMetadata PutBucketResponse = S3Metadata responseConsumer _ _ = s3ResponseConsumer $ \_ -> return PutBucketResponse instance Transaction PutBucket PutBucketResponse instance AsMemoryResponse PutBucketResponse where type MemoryResponse PutBucketResponse = PutBucketResponse loadToMemory = return