{-# 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.Glacier.CreateVault
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation creates a new vault with the specified name. The name of
-- the vault must be unique within a region for an AWS account. You can
-- create up to 1,000 vaults per account. If you need to create more
-- vaults, contact Amazon S3 Glacier.
--
-- You must use the following guidelines when naming a vault.
--
-- -   Names can be between 1 and 255 characters long.
--
-- -   Allowed characters are a-z, A-Z, 0-9, \'_\' (underscore), \'-\'
--     (hyphen), and \'.\' (period).
--
-- This operation is idempotent.
--
-- An AWS account has full permission to perform all operations (actions).
-- However, AWS Identity and Access Management (IAM) users don\'t have any
-- permissions by default. You must grant them explicit permission to
-- perform specific actions. For more information, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/using-iam-with-amazon-glacier.html Access Control Using AWS Identity and Access Management (IAM)>.
--
-- For conceptual information and underlying REST API, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/creating-vaults.html Creating a Vault in Amazon Glacier>
-- and
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-vault-put.html Create Vault>
-- in the /Amazon Glacier Developer Guide/.
module Amazonka.Glacier.CreateVault
  ( -- * Creating a Request
    CreateVault (..),
    newCreateVault,

    -- * Request Lenses
    createVault_accountId,
    createVault_vaultName,

    -- * Destructuring the Response
    CreateVaultResponse (..),
    newCreateVaultResponse,

    -- * Response Lenses
    createVaultResponse_location,
    createVaultResponse_httpStatus,
  )
where

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

-- | Provides options to create a vault.
--
-- /See:/ 'newCreateVault' smart constructor.
data CreateVault = CreateVault'
  { -- | The @AccountId@ value is the AWS account ID. This value must match the
    -- AWS account ID associated with the credentials used to sign the request.
    -- You can either specify an AWS account ID or optionally a single \'@-@\'
    -- (hyphen), in which case Amazon S3 Glacier uses the AWS account ID
    -- associated with the credentials used to sign the request. If you specify
    -- your account ID, do not include any hyphens (\'-\') in the ID.
    CreateVault -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    CreateVault -> Text
vaultName :: Prelude.Text
  }
  deriving (CreateVault -> CreateVault -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVault -> CreateVault -> Bool
$c/= :: CreateVault -> CreateVault -> Bool
== :: CreateVault -> CreateVault -> Bool
$c== :: CreateVault -> CreateVault -> Bool
Prelude.Eq, ReadPrec [CreateVault]
ReadPrec CreateVault
Int -> ReadS CreateVault
ReadS [CreateVault]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVault]
$creadListPrec :: ReadPrec [CreateVault]
readPrec :: ReadPrec CreateVault
$creadPrec :: ReadPrec CreateVault
readList :: ReadS [CreateVault]
$creadList :: ReadS [CreateVault]
readsPrec :: Int -> ReadS CreateVault
$creadsPrec :: Int -> ReadS CreateVault
Prelude.Read, Int -> CreateVault -> ShowS
[CreateVault] -> ShowS
CreateVault -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVault] -> ShowS
$cshowList :: [CreateVault] -> ShowS
show :: CreateVault -> String
$cshow :: CreateVault -> String
showsPrec :: Int -> CreateVault -> ShowS
$cshowsPrec :: Int -> CreateVault -> ShowS
Prelude.Show, forall x. Rep CreateVault x -> CreateVault
forall x. CreateVault -> Rep CreateVault x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVault x -> CreateVault
$cfrom :: forall x. CreateVault -> Rep CreateVault x
Prelude.Generic)

-- |
-- Create a value of 'CreateVault' 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:
--
-- 'accountId', 'createVault_accountId' - The @AccountId@ value is the AWS account ID. This value must match the
-- AWS account ID associated with the credentials used to sign the request.
-- You can either specify an AWS account ID or optionally a single \'@-@\'
-- (hyphen), in which case Amazon S3 Glacier uses the AWS account ID
-- associated with the credentials used to sign the request. If you specify
-- your account ID, do not include any hyphens (\'-\') in the ID.
--
-- 'vaultName', 'createVault_vaultName' - The name of the vault.
newCreateVault ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  CreateVault
newCreateVault :: Text -> Text -> CreateVault
newCreateVault Text
pAccountId_ Text
pVaultName_ =
  CreateVault'
    { $sel:accountId:CreateVault' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:CreateVault' :: Text
vaultName = Text
pVaultName_
    }

-- | The @AccountId@ value is the AWS account ID. This value must match the
-- AWS account ID associated with the credentials used to sign the request.
-- You can either specify an AWS account ID or optionally a single \'@-@\'
-- (hyphen), in which case Amazon S3 Glacier uses the AWS account ID
-- associated with the credentials used to sign the request. If you specify
-- your account ID, do not include any hyphens (\'-\') in the ID.
createVault_accountId :: Lens.Lens' CreateVault Prelude.Text
createVault_accountId :: Lens' CreateVault Text
createVault_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVault' {Text
accountId :: Text
$sel:accountId:CreateVault' :: CreateVault -> Text
accountId} -> Text
accountId) (\s :: CreateVault
s@CreateVault' {} Text
a -> CreateVault
s {$sel:accountId:CreateVault' :: Text
accountId = Text
a} :: CreateVault)

-- | The name of the vault.
createVault_vaultName :: Lens.Lens' CreateVault Prelude.Text
createVault_vaultName :: Lens' CreateVault Text
createVault_vaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVault' {Text
vaultName :: Text
$sel:vaultName:CreateVault' :: CreateVault -> Text
vaultName} -> Text
vaultName) (\s :: CreateVault
s@CreateVault' {} Text
a -> CreateVault
s {$sel:vaultName:CreateVault' :: Text
vaultName = Text
a} :: CreateVault)

instance Core.AWSRequest CreateVault where
  type AWSResponse CreateVault = CreateVaultResponse
  request :: (Service -> Service) -> CreateVault -> Request CreateVault
request Service -> Service
overrides =
    forall a. ByteString -> Request a -> Request a
Request.glacierVersionHeader (Service -> ByteString
Core.version Service
defaultService)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateVault
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateVault)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Maybe Text -> Int -> CreateVaultResponse
CreateVaultResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Location")
            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 CreateVault where
  hashWithSalt :: Int -> CreateVault -> Int
hashWithSalt Int
_salt CreateVault' {Text
vaultName :: Text
accountId :: Text
$sel:vaultName:CreateVault' :: CreateVault -> Text
$sel:accountId:CreateVault' :: CreateVault -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vaultName

instance Prelude.NFData CreateVault where
  rnf :: CreateVault -> ()
rnf CreateVault' {Text
vaultName :: Text
accountId :: Text
$sel:vaultName:CreateVault' :: CreateVault -> Text
$sel:accountId:CreateVault' :: CreateVault -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vaultName

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

instance Data.ToJSON CreateVault where
  toJSON :: CreateVault -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CreateVault where
  toPath :: CreateVault -> ByteString
toPath CreateVault' {Text
vaultName :: Text
accountId :: Text
$sel:vaultName:CreateVault' :: CreateVault -> Text
$sel:accountId:CreateVault' :: CreateVault -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
vaultName
      ]

instance Data.ToQuery CreateVault where
  toQuery :: CreateVault -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Contains the Amazon S3 Glacier response to your request.
--
-- /See:/ 'newCreateVaultResponse' smart constructor.
data CreateVaultResponse = CreateVaultResponse'
  { -- | The URI of the vault that was created.
    CreateVaultResponse -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateVaultResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateVaultResponse -> CreateVaultResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVaultResponse -> CreateVaultResponse -> Bool
$c/= :: CreateVaultResponse -> CreateVaultResponse -> Bool
== :: CreateVaultResponse -> CreateVaultResponse -> Bool
$c== :: CreateVaultResponse -> CreateVaultResponse -> Bool
Prelude.Eq, ReadPrec [CreateVaultResponse]
ReadPrec CreateVaultResponse
Int -> ReadS CreateVaultResponse
ReadS [CreateVaultResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVaultResponse]
$creadListPrec :: ReadPrec [CreateVaultResponse]
readPrec :: ReadPrec CreateVaultResponse
$creadPrec :: ReadPrec CreateVaultResponse
readList :: ReadS [CreateVaultResponse]
$creadList :: ReadS [CreateVaultResponse]
readsPrec :: Int -> ReadS CreateVaultResponse
$creadsPrec :: Int -> ReadS CreateVaultResponse
Prelude.Read, Int -> CreateVaultResponse -> ShowS
[CreateVaultResponse] -> ShowS
CreateVaultResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVaultResponse] -> ShowS
$cshowList :: [CreateVaultResponse] -> ShowS
show :: CreateVaultResponse -> String
$cshow :: CreateVaultResponse -> String
showsPrec :: Int -> CreateVaultResponse -> ShowS
$cshowsPrec :: Int -> CreateVaultResponse -> ShowS
Prelude.Show, forall x. Rep CreateVaultResponse x -> CreateVaultResponse
forall x. CreateVaultResponse -> Rep CreateVaultResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVaultResponse x -> CreateVaultResponse
$cfrom :: forall x. CreateVaultResponse -> Rep CreateVaultResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVaultResponse' 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:
--
-- 'location', 'createVaultResponse_location' - The URI of the vault that was created.
--
-- 'httpStatus', 'createVaultResponse_httpStatus' - The response's http status code.
newCreateVaultResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVaultResponse
newCreateVaultResponse :: Int -> CreateVaultResponse
newCreateVaultResponse Int
pHttpStatus_ =
  CreateVaultResponse'
    { $sel:location:CreateVaultResponse' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVaultResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The URI of the vault that was created.
createVaultResponse_location :: Lens.Lens' CreateVaultResponse (Prelude.Maybe Prelude.Text)
createVaultResponse_location :: Lens' CreateVaultResponse (Maybe Text)
createVaultResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVaultResponse' {Maybe Text
location :: Maybe Text
$sel:location:CreateVaultResponse' :: CreateVaultResponse -> Maybe Text
location} -> Maybe Text
location) (\s :: CreateVaultResponse
s@CreateVaultResponse' {} Maybe Text
a -> CreateVaultResponse
s {$sel:location:CreateVaultResponse' :: Maybe Text
location = Maybe Text
a} :: CreateVaultResponse)

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

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