{-# 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.StorageGateway.CreateTapePool
-- 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 new custom tape pool. You can use custom tape pool to enable
-- tape retention lock on tapes that are archived in the custom pool.
module Amazonka.StorageGateway.CreateTapePool
  ( -- * Creating a Request
    CreateTapePool (..),
    newCreateTapePool,

    -- * Request Lenses
    createTapePool_retentionLockTimeInDays,
    createTapePool_retentionLockType,
    createTapePool_tags,
    createTapePool_poolName,
    createTapePool_storageClass,

    -- * Destructuring the Response
    CreateTapePoolResponse (..),
    newCreateTapePoolResponse,

    -- * Response Lenses
    createTapePoolResponse_poolARN,
    createTapePoolResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateTapePool' smart constructor.
data CreateTapePool = CreateTapePool'
  { -- | Tape retention lock time is set in days. Tape retention lock can be
    -- enabled for up to 100 years (36,500 days).
    CreateTapePool -> Maybe Natural
retentionLockTimeInDays :: Prelude.Maybe Prelude.Natural,
    -- | Tape retention lock can be configured in two modes. When configured in
    -- governance mode, Amazon Web Services accounts with specific IAM
    -- permissions are authorized to remove the tape retention lock from
    -- archived virtual tapes. When configured in compliance mode, the tape
    -- retention lock cannot be removed by any user, including the root Amazon
    -- Web Services account.
    CreateTapePool -> Maybe RetentionLockType
retentionLockType :: Prelude.Maybe RetentionLockType,
    -- | A list of up to 50 tags that can be assigned to tape pool. Each tag is a
    -- key-value pair.
    --
    -- Valid characters for key and value are letters, spaces, and numbers
    -- representable in UTF-8 format, and the following special characters: + -
    -- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
    -- the maximum length for a tag\'s value is 256.
    CreateTapePool -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the new custom tape pool.
    CreateTapePool -> Text
poolName :: Prelude.Text,
    -- | The storage class that is associated with the new custom pool. When you
    -- use your backup application to eject the tape, the tape is archived
    -- directly into the storage class (S3 Glacier or S3 Glacier Deep Archive)
    -- that corresponds to the pool.
    CreateTapePool -> TapeStorageClass
storageClass :: TapeStorageClass
  }
  deriving (CreateTapePool -> CreateTapePool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTapePool -> CreateTapePool -> Bool
$c/= :: CreateTapePool -> CreateTapePool -> Bool
== :: CreateTapePool -> CreateTapePool -> Bool
$c== :: CreateTapePool -> CreateTapePool -> Bool
Prelude.Eq, ReadPrec [CreateTapePool]
ReadPrec CreateTapePool
Int -> ReadS CreateTapePool
ReadS [CreateTapePool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTapePool]
$creadListPrec :: ReadPrec [CreateTapePool]
readPrec :: ReadPrec CreateTapePool
$creadPrec :: ReadPrec CreateTapePool
readList :: ReadS [CreateTapePool]
$creadList :: ReadS [CreateTapePool]
readsPrec :: Int -> ReadS CreateTapePool
$creadsPrec :: Int -> ReadS CreateTapePool
Prelude.Read, Int -> CreateTapePool -> ShowS
[CreateTapePool] -> ShowS
CreateTapePool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTapePool] -> ShowS
$cshowList :: [CreateTapePool] -> ShowS
show :: CreateTapePool -> String
$cshow :: CreateTapePool -> String
showsPrec :: Int -> CreateTapePool -> ShowS
$cshowsPrec :: Int -> CreateTapePool -> ShowS
Prelude.Show, forall x. Rep CreateTapePool x -> CreateTapePool
forall x. CreateTapePool -> Rep CreateTapePool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTapePool x -> CreateTapePool
$cfrom :: forall x. CreateTapePool -> Rep CreateTapePool x
Prelude.Generic)

-- |
-- Create a value of 'CreateTapePool' 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:
--
-- 'retentionLockTimeInDays', 'createTapePool_retentionLockTimeInDays' - Tape retention lock time is set in days. Tape retention lock can be
-- enabled for up to 100 years (36,500 days).
--
-- 'retentionLockType', 'createTapePool_retentionLockType' - Tape retention lock can be configured in two modes. When configured in
-- governance mode, Amazon Web Services accounts with specific IAM
-- permissions are authorized to remove the tape retention lock from
-- archived virtual tapes. When configured in compliance mode, the tape
-- retention lock cannot be removed by any user, including the root Amazon
-- Web Services account.
--
-- 'tags', 'createTapePool_tags' - A list of up to 50 tags that can be assigned to tape pool. Each tag is a
-- key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
-- the maximum length for a tag\'s value is 256.
--
-- 'poolName', 'createTapePool_poolName' - The name of the new custom tape pool.
--
-- 'storageClass', 'createTapePool_storageClass' - The storage class that is associated with the new custom pool. When you
-- use your backup application to eject the tape, the tape is archived
-- directly into the storage class (S3 Glacier or S3 Glacier Deep Archive)
-- that corresponds to the pool.
newCreateTapePool ::
  -- | 'poolName'
  Prelude.Text ->
  -- | 'storageClass'
  TapeStorageClass ->
  CreateTapePool
newCreateTapePool :: Text -> TapeStorageClass -> CreateTapePool
newCreateTapePool Text
pPoolName_ TapeStorageClass
pStorageClass_ =
  CreateTapePool'
    { $sel:retentionLockTimeInDays:CreateTapePool' :: Maybe Natural
retentionLockTimeInDays =
        forall a. Maybe a
Prelude.Nothing,
      $sel:retentionLockType:CreateTapePool' :: Maybe RetentionLockType
retentionLockType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateTapePool' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:poolName:CreateTapePool' :: Text
poolName = Text
pPoolName_,
      $sel:storageClass:CreateTapePool' :: TapeStorageClass
storageClass = TapeStorageClass
pStorageClass_
    }

-- | Tape retention lock time is set in days. Tape retention lock can be
-- enabled for up to 100 years (36,500 days).
createTapePool_retentionLockTimeInDays :: Lens.Lens' CreateTapePool (Prelude.Maybe Prelude.Natural)
createTapePool_retentionLockTimeInDays :: Lens' CreateTapePool (Maybe Natural)
createTapePool_retentionLockTimeInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTapePool' {Maybe Natural
retentionLockTimeInDays :: Maybe Natural
$sel:retentionLockTimeInDays:CreateTapePool' :: CreateTapePool -> Maybe Natural
retentionLockTimeInDays} -> Maybe Natural
retentionLockTimeInDays) (\s :: CreateTapePool
s@CreateTapePool' {} Maybe Natural
a -> CreateTapePool
s {$sel:retentionLockTimeInDays:CreateTapePool' :: Maybe Natural
retentionLockTimeInDays = Maybe Natural
a} :: CreateTapePool)

-- | Tape retention lock can be configured in two modes. When configured in
-- governance mode, Amazon Web Services accounts with specific IAM
-- permissions are authorized to remove the tape retention lock from
-- archived virtual tapes. When configured in compliance mode, the tape
-- retention lock cannot be removed by any user, including the root Amazon
-- Web Services account.
createTapePool_retentionLockType :: Lens.Lens' CreateTapePool (Prelude.Maybe RetentionLockType)
createTapePool_retentionLockType :: Lens' CreateTapePool (Maybe RetentionLockType)
createTapePool_retentionLockType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTapePool' {Maybe RetentionLockType
retentionLockType :: Maybe RetentionLockType
$sel:retentionLockType:CreateTapePool' :: CreateTapePool -> Maybe RetentionLockType
retentionLockType} -> Maybe RetentionLockType
retentionLockType) (\s :: CreateTapePool
s@CreateTapePool' {} Maybe RetentionLockType
a -> CreateTapePool
s {$sel:retentionLockType:CreateTapePool' :: Maybe RetentionLockType
retentionLockType = Maybe RetentionLockType
a} :: CreateTapePool)

-- | A list of up to 50 tags that can be assigned to tape pool. Each tag is a
-- key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
-- the maximum length for a tag\'s value is 256.
createTapePool_tags :: Lens.Lens' CreateTapePool (Prelude.Maybe [Tag])
createTapePool_tags :: Lens' CreateTapePool (Maybe [Tag])
createTapePool_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTapePool' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateTapePool' :: CreateTapePool -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateTapePool
s@CreateTapePool' {} Maybe [Tag]
a -> CreateTapePool
s {$sel:tags:CreateTapePool' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateTapePool) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the new custom tape pool.
createTapePool_poolName :: Lens.Lens' CreateTapePool Prelude.Text
createTapePool_poolName :: Lens' CreateTapePool Text
createTapePool_poolName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTapePool' {Text
poolName :: Text
$sel:poolName:CreateTapePool' :: CreateTapePool -> Text
poolName} -> Text
poolName) (\s :: CreateTapePool
s@CreateTapePool' {} Text
a -> CreateTapePool
s {$sel:poolName:CreateTapePool' :: Text
poolName = Text
a} :: CreateTapePool)

-- | The storage class that is associated with the new custom pool. When you
-- use your backup application to eject the tape, the tape is archived
-- directly into the storage class (S3 Glacier or S3 Glacier Deep Archive)
-- that corresponds to the pool.
createTapePool_storageClass :: Lens.Lens' CreateTapePool TapeStorageClass
createTapePool_storageClass :: Lens' CreateTapePool TapeStorageClass
createTapePool_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTapePool' {TapeStorageClass
storageClass :: TapeStorageClass
$sel:storageClass:CreateTapePool' :: CreateTapePool -> TapeStorageClass
storageClass} -> TapeStorageClass
storageClass) (\s :: CreateTapePool
s@CreateTapePool' {} TapeStorageClass
a -> CreateTapePool
s {$sel:storageClass:CreateTapePool' :: TapeStorageClass
storageClass = TapeStorageClass
a} :: CreateTapePool)

instance Core.AWSRequest CreateTapePool where
  type
    AWSResponse CreateTapePool =
      CreateTapePoolResponse
  request :: (Service -> Service) -> CreateTapePool -> Request CreateTapePool
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateTapePool
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateTapePool)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateTapePoolResponse
CreateTapePoolResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PoolARN")
            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 CreateTapePool where
  hashWithSalt :: Int -> CreateTapePool -> Int
hashWithSalt Int
_salt CreateTapePool' {Maybe Natural
Maybe [Tag]
Maybe RetentionLockType
Text
TapeStorageClass
storageClass :: TapeStorageClass
poolName :: Text
tags :: Maybe [Tag]
retentionLockType :: Maybe RetentionLockType
retentionLockTimeInDays :: Maybe Natural
$sel:storageClass:CreateTapePool' :: CreateTapePool -> TapeStorageClass
$sel:poolName:CreateTapePool' :: CreateTapePool -> Text
$sel:tags:CreateTapePool' :: CreateTapePool -> Maybe [Tag]
$sel:retentionLockType:CreateTapePool' :: CreateTapePool -> Maybe RetentionLockType
$sel:retentionLockTimeInDays:CreateTapePool' :: CreateTapePool -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
retentionLockTimeInDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetentionLockType
retentionLockType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
poolName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TapeStorageClass
storageClass

instance Prelude.NFData CreateTapePool where
  rnf :: CreateTapePool -> ()
rnf CreateTapePool' {Maybe Natural
Maybe [Tag]
Maybe RetentionLockType
Text
TapeStorageClass
storageClass :: TapeStorageClass
poolName :: Text
tags :: Maybe [Tag]
retentionLockType :: Maybe RetentionLockType
retentionLockTimeInDays :: Maybe Natural
$sel:storageClass:CreateTapePool' :: CreateTapePool -> TapeStorageClass
$sel:poolName:CreateTapePool' :: CreateTapePool -> Text
$sel:tags:CreateTapePool' :: CreateTapePool -> Maybe [Tag]
$sel:retentionLockType:CreateTapePool' :: CreateTapePool -> Maybe RetentionLockType
$sel:retentionLockTimeInDays:CreateTapePool' :: CreateTapePool -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
retentionLockTimeInDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionLockType
retentionLockType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
poolName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TapeStorageClass
storageClass

instance Data.ToHeaders CreateTapePool where
  toHeaders :: CreateTapePool -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"StorageGateway_20130630.CreateTapePool" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateTapePool where
  toJSON :: CreateTapePool -> Value
toJSON CreateTapePool' {Maybe Natural
Maybe [Tag]
Maybe RetentionLockType
Text
TapeStorageClass
storageClass :: TapeStorageClass
poolName :: Text
tags :: Maybe [Tag]
retentionLockType :: Maybe RetentionLockType
retentionLockTimeInDays :: Maybe Natural
$sel:storageClass:CreateTapePool' :: CreateTapePool -> TapeStorageClass
$sel:poolName:CreateTapePool' :: CreateTapePool -> Text
$sel:tags:CreateTapePool' :: CreateTapePool -> Maybe [Tag]
$sel:retentionLockType:CreateTapePool' :: CreateTapePool -> Maybe RetentionLockType
$sel:retentionLockTimeInDays:CreateTapePool' :: CreateTapePool -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"RetentionLockTimeInDays" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
retentionLockTimeInDays,
            (Key
"RetentionLockType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RetentionLockType
retentionLockType,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"PoolName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
poolName),
            forall a. a -> Maybe a
Prelude.Just (Key
"StorageClass" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TapeStorageClass
storageClass)
          ]
      )

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

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

-- | /See:/ 'newCreateTapePoolResponse' smart constructor.
data CreateTapePoolResponse = CreateTapePoolResponse'
  { -- | The unique Amazon Resource Name (ARN) that represents the custom tape
    -- pool. Use the ListTapePools operation to return a list of tape pools for
    -- your account and Amazon Web Services Region.
    CreateTapePoolResponse -> Maybe Text
poolARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateTapePoolResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTapePoolResponse -> CreateTapePoolResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTapePoolResponse -> CreateTapePoolResponse -> Bool
$c/= :: CreateTapePoolResponse -> CreateTapePoolResponse -> Bool
== :: CreateTapePoolResponse -> CreateTapePoolResponse -> Bool
$c== :: CreateTapePoolResponse -> CreateTapePoolResponse -> Bool
Prelude.Eq, ReadPrec [CreateTapePoolResponse]
ReadPrec CreateTapePoolResponse
Int -> ReadS CreateTapePoolResponse
ReadS [CreateTapePoolResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTapePoolResponse]
$creadListPrec :: ReadPrec [CreateTapePoolResponse]
readPrec :: ReadPrec CreateTapePoolResponse
$creadPrec :: ReadPrec CreateTapePoolResponse
readList :: ReadS [CreateTapePoolResponse]
$creadList :: ReadS [CreateTapePoolResponse]
readsPrec :: Int -> ReadS CreateTapePoolResponse
$creadsPrec :: Int -> ReadS CreateTapePoolResponse
Prelude.Read, Int -> CreateTapePoolResponse -> ShowS
[CreateTapePoolResponse] -> ShowS
CreateTapePoolResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTapePoolResponse] -> ShowS
$cshowList :: [CreateTapePoolResponse] -> ShowS
show :: CreateTapePoolResponse -> String
$cshow :: CreateTapePoolResponse -> String
showsPrec :: Int -> CreateTapePoolResponse -> ShowS
$cshowsPrec :: Int -> CreateTapePoolResponse -> ShowS
Prelude.Show, forall x. Rep CreateTapePoolResponse x -> CreateTapePoolResponse
forall x. CreateTapePoolResponse -> Rep CreateTapePoolResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTapePoolResponse x -> CreateTapePoolResponse
$cfrom :: forall x. CreateTapePoolResponse -> Rep CreateTapePoolResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTapePoolResponse' 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:
--
-- 'poolARN', 'createTapePoolResponse_poolARN' - The unique Amazon Resource Name (ARN) that represents the custom tape
-- pool. Use the ListTapePools operation to return a list of tape pools for
-- your account and Amazon Web Services Region.
--
-- 'httpStatus', 'createTapePoolResponse_httpStatus' - The response's http status code.
newCreateTapePoolResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTapePoolResponse
newCreateTapePoolResponse :: Int -> CreateTapePoolResponse
newCreateTapePoolResponse Int
pHttpStatus_ =
  CreateTapePoolResponse'
    { $sel:poolARN:CreateTapePoolResponse' :: Maybe Text
poolARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateTapePoolResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique Amazon Resource Name (ARN) that represents the custom tape
-- pool. Use the ListTapePools operation to return a list of tape pools for
-- your account and Amazon Web Services Region.
createTapePoolResponse_poolARN :: Lens.Lens' CreateTapePoolResponse (Prelude.Maybe Prelude.Text)
createTapePoolResponse_poolARN :: Lens' CreateTapePoolResponse (Maybe Text)
createTapePoolResponse_poolARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTapePoolResponse' {Maybe Text
poolARN :: Maybe Text
$sel:poolARN:CreateTapePoolResponse' :: CreateTapePoolResponse -> Maybe Text
poolARN} -> Maybe Text
poolARN) (\s :: CreateTapePoolResponse
s@CreateTapePoolResponse' {} Maybe Text
a -> CreateTapePoolResponse
s {$sel:poolARN:CreateTapePoolResponse' :: Maybe Text
poolARN = Maybe Text
a} :: CreateTapePoolResponse)

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

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