1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
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
|
