1module Aws.S3.Commands.GetBucketLocation
2       where
3
4import           Aws.Core
5import           Aws.S3.Core
6
7import qualified Data.ByteString.Char8 as B8
8
9import qualified Data.Text as T
10import qualified Data.Text.Encoding as T
11import qualified Network.HTTP.Types as HTTP
12import           Text.XML.Cursor (($.//))
13
14data GetBucketLocation
15  = GetBucketLocation {
16      gblBucket :: Bucket
17    } deriving Show
18
19getBucketLocation :: Bucket -> GetBucketLocation
20getBucketLocation bucket
21  = GetBucketLocation {
22      gblBucket = bucket
23    }
24
25data GetBucketLocationResponse
26  = GetBucketLocationResponse { gblrLocationConstraint :: LocationConstraint }
27    deriving Show
28
29instance SignQuery GetBucketLocation where
30  type ServiceConfiguration GetBucketLocation = S3Configuration
31  signQuery GetBucketLocation {..} = s3SignQuery S3Query {
32                                       s3QMethod = Get
33                                     , s3QBucket = Just $ T.encodeUtf8 gblBucket
34                                     , s3QObject = Nothing
35                                     , s3QSubresources = [("location" :: B8.ByteString, Nothing :: Maybe B8.ByteString)]
36                                     , s3QQuery = HTTP.toQuery ([] :: [(B8.ByteString, T.Text)])
37                                     , s3QContentType = Nothing
38                                     , s3QContentMd5 = Nothing
39                                     , s3QAmzHeaders = []
40                                     , s3QOtherHeaders = []
41                                     , s3QRequestBody = Nothing
42                                     }
43
44instance ResponseConsumer r GetBucketLocationResponse where
45  type ResponseMetadata GetBucketLocationResponse = S3Metadata
46
47  responseConsumer _ _ = s3XmlResponseConsumer parse
48    where parse cursor = do
49            locationConstraint <- force "Missing Location" $ cursor $.// elContent "LocationConstraint"
50            return GetBucketLocationResponse { gblrLocationConstraint = normaliseLocation locationConstraint }
51
52instance Transaction GetBucketLocation GetBucketLocationResponse
53
54instance AsMemoryResponse GetBucketLocationResponse where
55  type MemoryResponse GetBucketLocationResponse = GetBucketLocationResponse
56  loadToMemory = return
57