{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.ElasticBeanstalk.CreateStorageLocation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a bucket in Amazon S3 to store application versions, logs, and
-- other files used by Elastic Beanstalk environments. The Elastic
-- Beanstalk console and EB CLI call this API the first time you create an
-- environment in a region. If the storage location already exists,
-- @CreateStorageLocation@ still returns the bucket name but does not
-- create a new bucket.
module Amazonka.ElasticBeanstalk.CreateStorageLocation
  ( -- * Creating a Request
    CreateStorageLocation (..),
    newCreateStorageLocation,

    -- * Destructuring the Response
    CreateStorageLocationResponse (..),
    newCreateStorageLocationResponse,

    -- * Response Lenses
    createStorageLocationResponse_s3Bucket,
    createStorageLocationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElasticBeanstalk.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateStorageLocation' smart constructor.
data CreateStorageLocation = CreateStorageLocation'
  {
  }
  deriving (CreateStorageLocation -> CreateStorageLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStorageLocation -> CreateStorageLocation -> Bool
$c/= :: CreateStorageLocation -> CreateStorageLocation -> Bool
== :: CreateStorageLocation -> CreateStorageLocation -> Bool
$c== :: CreateStorageLocation -> CreateStorageLocation -> Bool
Prelude.Eq, ReadPrec [CreateStorageLocation]
ReadPrec CreateStorageLocation
Int -> ReadS CreateStorageLocation
ReadS [CreateStorageLocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStorageLocation]
$creadListPrec :: ReadPrec [CreateStorageLocation]
readPrec :: ReadPrec CreateStorageLocation
$creadPrec :: ReadPrec CreateStorageLocation
readList :: ReadS [CreateStorageLocation]
$creadList :: ReadS [CreateStorageLocation]
readsPrec :: Int -> ReadS CreateStorageLocation
$creadsPrec :: Int -> ReadS CreateStorageLocation
Prelude.Read, Int -> CreateStorageLocation -> ShowS
[CreateStorageLocation] -> ShowS
CreateStorageLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStorageLocation] -> ShowS
$cshowList :: [CreateStorageLocation] -> ShowS
show :: CreateStorageLocation -> String
$cshow :: CreateStorageLocation -> String
showsPrec :: Int -> CreateStorageLocation -> ShowS
$cshowsPrec :: Int -> CreateStorageLocation -> ShowS
Prelude.Show, forall x. Rep CreateStorageLocation x -> CreateStorageLocation
forall x. CreateStorageLocation -> Rep CreateStorageLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStorageLocation x -> CreateStorageLocation
$cfrom :: forall x. CreateStorageLocation -> Rep CreateStorageLocation x
Prelude.Generic)

-- |
-- Create a value of 'CreateStorageLocation' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
newCreateStorageLocation ::
  CreateStorageLocation
newCreateStorageLocation :: CreateStorageLocation
newCreateStorageLocation = CreateStorageLocation
CreateStorageLocation'

instance Core.AWSRequest CreateStorageLocation where
  type
    AWSResponse CreateStorageLocation =
      CreateStorageLocationResponse
  request :: (Service -> Service)
-> CreateStorageLocation -> Request CreateStorageLocation
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateStorageLocation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateStorageLocation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreateStorageLocationResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> CreateStorageLocationResponse
CreateStorageLocationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"S3Bucket")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateStorageLocation where
  hashWithSalt :: Int -> CreateStorageLocation -> Int
hashWithSalt Int
_salt CreateStorageLocation
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData CreateStorageLocation where
  rnf :: CreateStorageLocation -> ()
rnf CreateStorageLocation
_ = ()

instance Data.ToHeaders CreateStorageLocation where
  toHeaders :: CreateStorageLocation -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath CreateStorageLocation where
  toPath :: CreateStorageLocation -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateStorageLocation where
  toQuery :: CreateStorageLocation -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ ByteString
"Action"
              forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateStorageLocation" :: Prelude.ByteString),
            ByteString
"Version"
              forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString)
          ]
      )

-- | Results of a CreateStorageLocationResult call.
--
-- /See:/ 'newCreateStorageLocationResponse' smart constructor.
data CreateStorageLocationResponse = CreateStorageLocationResponse'
  { -- | The name of the Amazon S3 bucket created.
    CreateStorageLocationResponse -> Maybe Text
s3Bucket :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateStorageLocationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateStorageLocationResponse
-> CreateStorageLocationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStorageLocationResponse
-> CreateStorageLocationResponse -> Bool
$c/= :: CreateStorageLocationResponse
-> CreateStorageLocationResponse -> Bool
== :: CreateStorageLocationResponse
-> CreateStorageLocationResponse -> Bool
$c== :: CreateStorageLocationResponse
-> CreateStorageLocationResponse -> Bool
Prelude.Eq, ReadPrec [CreateStorageLocationResponse]
ReadPrec CreateStorageLocationResponse
Int -> ReadS CreateStorageLocationResponse
ReadS [CreateStorageLocationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStorageLocationResponse]
$creadListPrec :: ReadPrec [CreateStorageLocationResponse]
readPrec :: ReadPrec CreateStorageLocationResponse
$creadPrec :: ReadPrec CreateStorageLocationResponse
readList :: ReadS [CreateStorageLocationResponse]
$creadList :: ReadS [CreateStorageLocationResponse]
readsPrec :: Int -> ReadS CreateStorageLocationResponse
$creadsPrec :: Int -> ReadS CreateStorageLocationResponse
Prelude.Read, Int -> CreateStorageLocationResponse -> ShowS
[CreateStorageLocationResponse] -> ShowS
CreateStorageLocationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStorageLocationResponse] -> ShowS
$cshowList :: [CreateStorageLocationResponse] -> ShowS
show :: CreateStorageLocationResponse -> String
$cshow :: CreateStorageLocationResponse -> String
showsPrec :: Int -> CreateStorageLocationResponse -> ShowS
$cshowsPrec :: Int -> CreateStorageLocationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateStorageLocationResponse x
-> CreateStorageLocationResponse
forall x.
CreateStorageLocationResponse
-> Rep CreateStorageLocationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateStorageLocationResponse x
-> CreateStorageLocationResponse
$cfrom :: forall x.
CreateStorageLocationResponse
-> Rep CreateStorageLocationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateStorageLocationResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 's3Bucket', 'createStorageLocationResponse_s3Bucket' - The name of the Amazon S3 bucket created.
--
-- 'httpStatus', 'createStorageLocationResponse_httpStatus' - The response's http status code.
newCreateStorageLocationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStorageLocationResponse
newCreateStorageLocationResponse :: Int -> CreateStorageLocationResponse
newCreateStorageLocationResponse Int
pHttpStatus_ =
  CreateStorageLocationResponse'
    { $sel:s3Bucket:CreateStorageLocationResponse' :: Maybe Text
s3Bucket =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStorageLocationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the Amazon S3 bucket created.
createStorageLocationResponse_s3Bucket :: Lens.Lens' CreateStorageLocationResponse (Prelude.Maybe Prelude.Text)
createStorageLocationResponse_s3Bucket :: Lens' CreateStorageLocationResponse (Maybe Text)
createStorageLocationResponse_s3Bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStorageLocationResponse' {Maybe Text
s3Bucket :: Maybe Text
$sel:s3Bucket:CreateStorageLocationResponse' :: CreateStorageLocationResponse -> Maybe Text
s3Bucket} -> Maybe Text
s3Bucket) (\s :: CreateStorageLocationResponse
s@CreateStorageLocationResponse' {} Maybe Text
a -> CreateStorageLocationResponse
s {$sel:s3Bucket:CreateStorageLocationResponse' :: Maybe Text
s3Bucket = Maybe Text
a} :: CreateStorageLocationResponse)

-- | The response's http status code.
createStorageLocationResponse_httpStatus :: Lens.Lens' CreateStorageLocationResponse Prelude.Int
createStorageLocationResponse_httpStatus :: Lens' CreateStorageLocationResponse Int
createStorageLocationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStorageLocationResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateStorageLocationResponse' :: CreateStorageLocationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateStorageLocationResponse
s@CreateStorageLocationResponse' {} Int
a -> CreateStorageLocationResponse
s {$sel:httpStatus:CreateStorageLocationResponse' :: Int
httpStatus = Int
a} :: CreateStorageLocationResponse)

instance Prelude.NFData CreateStorageLocationResponse where
  rnf :: CreateStorageLocationResponse -> ()
rnf CreateStorageLocationResponse' {Int
Maybe Text
httpStatus :: Int
s3Bucket :: Maybe Text
$sel:httpStatus:CreateStorageLocationResponse' :: CreateStorageLocationResponse -> Int
$sel:s3Bucket:CreateStorageLocationResponse' :: CreateStorageLocationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3Bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus