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