module Aws.S3.Commands.GetBucketLocation
       where

import           Aws.Core
import           Aws.S3.Core

import qualified Data.ByteString.Char8 as B8

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Types as HTTP
import           Text.XML.Cursor (($.//))

data GetBucketLocation
  = GetBucketLocation {
      GetBucketLocation -> Bucket
gblBucket :: Bucket
    } deriving Int -> GetBucketLocation -> ShowS
[GetBucketLocation] -> ShowS
GetBucketLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketLocation] -> ShowS
$cshowList :: [GetBucketLocation] -> ShowS
show :: GetBucketLocation -> String
$cshow :: GetBucketLocation -> String
showsPrec :: Int -> GetBucketLocation -> ShowS
$cshowsPrec :: Int -> GetBucketLocation -> ShowS
Show

getBucketLocation :: Bucket -> GetBucketLocation
getBucketLocation :: Bucket -> GetBucketLocation
getBucketLocation Bucket
bucket
  = GetBucketLocation {
      gblBucket :: Bucket
gblBucket = Bucket
bucket
    }

data GetBucketLocationResponse
  = GetBucketLocationResponse { GetBucketLocationResponse -> Bucket
gblrLocationConstraint :: LocationConstraint }
    deriving Int -> GetBucketLocationResponse -> ShowS
[GetBucketLocationResponse] -> ShowS
GetBucketLocationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketLocationResponse] -> ShowS
$cshowList :: [GetBucketLocationResponse] -> ShowS
show :: GetBucketLocationResponse -> String
$cshow :: GetBucketLocationResponse -> String
showsPrec :: Int -> GetBucketLocationResponse -> ShowS
$cshowsPrec :: Int -> GetBucketLocationResponse -> ShowS
Show

instance SignQuery GetBucketLocation where
  type ServiceConfiguration GetBucketLocation = S3Configuration
  signQuery :: forall queryType.
GetBucketLocation
-> ServiceConfiguration GetBucketLocation queryType
-> SignatureData
-> SignedQuery
signQuery GetBucketLocation {Bucket
gblBucket :: Bucket
gblBucket :: GetBucketLocation -> Bucket
..} = forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
                                       s3QMethod :: Method
s3QMethod = Method
Get
                                     , s3QBucket :: Maybe ByteString
s3QBucket = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
gblBucket
                                     , s3QObject :: Maybe ByteString
s3QObject = forall a. Maybe a
Nothing
                                     , s3QSubresources :: Query
s3QSubresources = [(ByteString
"location" :: B8.ByteString, forall a. Maybe a
Nothing :: Maybe B8.ByteString)]
                                     , s3QQuery :: Query
s3QQuery = forall a. QueryLike a => a -> Query
HTTP.toQuery ([] :: [(B8.ByteString, T.Text)]) 
                                     , s3QContentType :: Maybe ByteString
s3QContentType = forall a. Maybe a
Nothing
                                     , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = forall a. Maybe a
Nothing
                                     , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = []
                                     , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = []
                                     , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = forall a. Maybe a
Nothing
                                     }

instance ResponseConsumer r GetBucketLocationResponse where
  type ResponseMetadata GetBucketLocationResponse = S3Metadata

  responseConsumer :: Request
-> r
-> IORef (ResponseMetadata GetBucketLocationResponse)
-> HTTPResponseConsumer GetBucketLocationResponse
responseConsumer Request
_ r
_ = forall a.
(Cursor -> Response S3Metadata a)
-> IORef S3Metadata -> HTTPResponseConsumer a
s3XmlResponseConsumer forall {m :: * -> *}.
MonadThrow m =>
Cursor -> m GetBucketLocationResponse
parse
    where parse :: Cursor -> m GetBucketLocationResponse
parse Cursor
cursor = do
            Bucket
locationConstraint <- forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Location" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$.// Bucket -> Cursor -> [Bucket]
elContent Bucket
"LocationConstraint"
            forall (m :: * -> *) a. Monad m => a -> m a
return GetBucketLocationResponse { gblrLocationConstraint :: Bucket
gblrLocationConstraint = Bucket -> Bucket
normaliseLocation Bucket
locationConstraint }

instance Transaction GetBucketLocation GetBucketLocationResponse

instance AsMemoryResponse GetBucketLocationResponse where
  type MemoryResponse GetBucketLocationResponse = GetBucketLocationResponse
  loadToMemory :: GetBucketLocationResponse
-> ResourceT IO (MemoryResponse GetBucketLocationResponse)
loadToMemory = forall (m :: * -> *) a. Monad m => a -> m a
return