{-# 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.UpdateAutomaticTapeCreationPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the automatic tape creation policy of a gateway. Use this to
-- update the policy with a new set of automatic tape creation rules. This
-- is only supported for tape gateways.
--
-- By default, there is no automatic tape creation policy.
--
-- A gateway can have only one automatic tape creation policy.
module Amazonka.StorageGateway.UpdateAutomaticTapeCreationPolicy
  ( -- * Creating a Request
    UpdateAutomaticTapeCreationPolicy (..),
    newUpdateAutomaticTapeCreationPolicy,

    -- * Request Lenses
    updateAutomaticTapeCreationPolicy_automaticTapeCreationRules,
    updateAutomaticTapeCreationPolicy_gatewayARN,

    -- * Destructuring the Response
    UpdateAutomaticTapeCreationPolicyResponse (..),
    newUpdateAutomaticTapeCreationPolicyResponse,

    -- * Response Lenses
    updateAutomaticTapeCreationPolicyResponse_gatewayARN,
    updateAutomaticTapeCreationPolicyResponse_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:/ 'newUpdateAutomaticTapeCreationPolicy' smart constructor.
data UpdateAutomaticTapeCreationPolicy = UpdateAutomaticTapeCreationPolicy'
  { -- | An automatic tape creation policy consists of a list of automatic tape
    -- creation rules. The rules determine when and how to automatically create
    -- new tapes.
    UpdateAutomaticTapeCreationPolicy
-> NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules :: Prelude.NonEmpty AutomaticTapeCreationRule,
    UpdateAutomaticTapeCreationPolicy -> Text
gatewayARN :: Prelude.Text
  }
  deriving (UpdateAutomaticTapeCreationPolicy
-> UpdateAutomaticTapeCreationPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAutomaticTapeCreationPolicy
-> UpdateAutomaticTapeCreationPolicy -> Bool
$c/= :: UpdateAutomaticTapeCreationPolicy
-> UpdateAutomaticTapeCreationPolicy -> Bool
== :: UpdateAutomaticTapeCreationPolicy
-> UpdateAutomaticTapeCreationPolicy -> Bool
$c== :: UpdateAutomaticTapeCreationPolicy
-> UpdateAutomaticTapeCreationPolicy -> Bool
Prelude.Eq, ReadPrec [UpdateAutomaticTapeCreationPolicy]
ReadPrec UpdateAutomaticTapeCreationPolicy
Int -> ReadS UpdateAutomaticTapeCreationPolicy
ReadS [UpdateAutomaticTapeCreationPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAutomaticTapeCreationPolicy]
$creadListPrec :: ReadPrec [UpdateAutomaticTapeCreationPolicy]
readPrec :: ReadPrec UpdateAutomaticTapeCreationPolicy
$creadPrec :: ReadPrec UpdateAutomaticTapeCreationPolicy
readList :: ReadS [UpdateAutomaticTapeCreationPolicy]
$creadList :: ReadS [UpdateAutomaticTapeCreationPolicy]
readsPrec :: Int -> ReadS UpdateAutomaticTapeCreationPolicy
$creadsPrec :: Int -> ReadS UpdateAutomaticTapeCreationPolicy
Prelude.Read, Int -> UpdateAutomaticTapeCreationPolicy -> ShowS
[UpdateAutomaticTapeCreationPolicy] -> ShowS
UpdateAutomaticTapeCreationPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAutomaticTapeCreationPolicy] -> ShowS
$cshowList :: [UpdateAutomaticTapeCreationPolicy] -> ShowS
show :: UpdateAutomaticTapeCreationPolicy -> String
$cshow :: UpdateAutomaticTapeCreationPolicy -> String
showsPrec :: Int -> UpdateAutomaticTapeCreationPolicy -> ShowS
$cshowsPrec :: Int -> UpdateAutomaticTapeCreationPolicy -> ShowS
Prelude.Show, forall x.
Rep UpdateAutomaticTapeCreationPolicy x
-> UpdateAutomaticTapeCreationPolicy
forall x.
UpdateAutomaticTapeCreationPolicy
-> Rep UpdateAutomaticTapeCreationPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAutomaticTapeCreationPolicy x
-> UpdateAutomaticTapeCreationPolicy
$cfrom :: forall x.
UpdateAutomaticTapeCreationPolicy
-> Rep UpdateAutomaticTapeCreationPolicy x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAutomaticTapeCreationPolicy' 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:
--
-- 'automaticTapeCreationRules', 'updateAutomaticTapeCreationPolicy_automaticTapeCreationRules' - An automatic tape creation policy consists of a list of automatic tape
-- creation rules. The rules determine when and how to automatically create
-- new tapes.
--
-- 'gatewayARN', 'updateAutomaticTapeCreationPolicy_gatewayARN' - Undocumented member.
newUpdateAutomaticTapeCreationPolicy ::
  -- | 'automaticTapeCreationRules'
  Prelude.NonEmpty AutomaticTapeCreationRule ->
  -- | 'gatewayARN'
  Prelude.Text ->
  UpdateAutomaticTapeCreationPolicy
newUpdateAutomaticTapeCreationPolicy :: NonEmpty AutomaticTapeCreationRule
-> Text -> UpdateAutomaticTapeCreationPolicy
newUpdateAutomaticTapeCreationPolicy
  NonEmpty AutomaticTapeCreationRule
pAutomaticTapeCreationRules_
  Text
pGatewayARN_ =
    UpdateAutomaticTapeCreationPolicy'
      { $sel:automaticTapeCreationRules:UpdateAutomaticTapeCreationPolicy' :: NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
            forall t b. AReview t b -> b -> t
Lens.# NonEmpty AutomaticTapeCreationRule
pAutomaticTapeCreationRules_,
        $sel:gatewayARN:UpdateAutomaticTapeCreationPolicy' :: Text
gatewayARN = Text
pGatewayARN_
      }

-- | An automatic tape creation policy consists of a list of automatic tape
-- creation rules. The rules determine when and how to automatically create
-- new tapes.
updateAutomaticTapeCreationPolicy_automaticTapeCreationRules :: Lens.Lens' UpdateAutomaticTapeCreationPolicy (Prelude.NonEmpty AutomaticTapeCreationRule)
updateAutomaticTapeCreationPolicy_automaticTapeCreationRules :: Lens'
  UpdateAutomaticTapeCreationPolicy
  (NonEmpty AutomaticTapeCreationRule)
updateAutomaticTapeCreationPolicy_automaticTapeCreationRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAutomaticTapeCreationPolicy' {NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules :: NonEmpty AutomaticTapeCreationRule
$sel:automaticTapeCreationRules:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy
-> NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules} -> NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules) (\s :: UpdateAutomaticTapeCreationPolicy
s@UpdateAutomaticTapeCreationPolicy' {} NonEmpty AutomaticTapeCreationRule
a -> UpdateAutomaticTapeCreationPolicy
s {$sel:automaticTapeCreationRules:UpdateAutomaticTapeCreationPolicy' :: NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules = NonEmpty AutomaticTapeCreationRule
a} :: UpdateAutomaticTapeCreationPolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
updateAutomaticTapeCreationPolicy_gatewayARN :: Lens.Lens' UpdateAutomaticTapeCreationPolicy Prelude.Text
updateAutomaticTapeCreationPolicy_gatewayARN :: Lens' UpdateAutomaticTapeCreationPolicy Text
updateAutomaticTapeCreationPolicy_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAutomaticTapeCreationPolicy' {Text
gatewayARN :: Text
$sel:gatewayARN:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy -> Text
gatewayARN} -> Text
gatewayARN) (\s :: UpdateAutomaticTapeCreationPolicy
s@UpdateAutomaticTapeCreationPolicy' {} Text
a -> UpdateAutomaticTapeCreationPolicy
s {$sel:gatewayARN:UpdateAutomaticTapeCreationPolicy' :: Text
gatewayARN = Text
a} :: UpdateAutomaticTapeCreationPolicy)

instance
  Core.AWSRequest
    UpdateAutomaticTapeCreationPolicy
  where
  type
    AWSResponse UpdateAutomaticTapeCreationPolicy =
      UpdateAutomaticTapeCreationPolicyResponse
  request :: (Service -> Service)
-> UpdateAutomaticTapeCreationPolicy
-> Request UpdateAutomaticTapeCreationPolicy
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 UpdateAutomaticTapeCreationPolicy
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateAutomaticTapeCreationPolicy)))
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 -> UpdateAutomaticTapeCreationPolicyResponse
UpdateAutomaticTapeCreationPolicyResponse'
            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
"GatewayARN")
            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
    UpdateAutomaticTapeCreationPolicy
  where
  hashWithSalt :: Int -> UpdateAutomaticTapeCreationPolicy -> Int
hashWithSalt
    Int
_salt
    UpdateAutomaticTapeCreationPolicy' {NonEmpty AutomaticTapeCreationRule
Text
gatewayARN :: Text
automaticTapeCreationRules :: NonEmpty AutomaticTapeCreationRule
$sel:gatewayARN:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy -> Text
$sel:automaticTapeCreationRules:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy
-> NonEmpty AutomaticTapeCreationRule
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN

instance
  Prelude.NFData
    UpdateAutomaticTapeCreationPolicy
  where
  rnf :: UpdateAutomaticTapeCreationPolicy -> ()
rnf UpdateAutomaticTapeCreationPolicy' {NonEmpty AutomaticTapeCreationRule
Text
gatewayARN :: Text
automaticTapeCreationRules :: NonEmpty AutomaticTapeCreationRule
$sel:gatewayARN:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy -> Text
$sel:automaticTapeCreationRules:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy
-> NonEmpty AutomaticTapeCreationRule
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayARN

instance
  Data.ToHeaders
    UpdateAutomaticTapeCreationPolicy
  where
  toHeaders :: UpdateAutomaticTapeCreationPolicy -> 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.UpdateAutomaticTapeCreationPolicy" ::
                          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
    UpdateAutomaticTapeCreationPolicy
  where
  toJSON :: UpdateAutomaticTapeCreationPolicy -> Value
toJSON UpdateAutomaticTapeCreationPolicy' {NonEmpty AutomaticTapeCreationRule
Text
gatewayARN :: Text
automaticTapeCreationRules :: NonEmpty AutomaticTapeCreationRule
$sel:gatewayARN:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy -> Text
$sel:automaticTapeCreationRules:UpdateAutomaticTapeCreationPolicy' :: UpdateAutomaticTapeCreationPolicy
-> NonEmpty AutomaticTapeCreationRule
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"AutomaticTapeCreationRules"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty AutomaticTapeCreationRule
automaticTapeCreationRules
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"GatewayARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayARN)
          ]
      )

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

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

-- | /See:/ 'newUpdateAutomaticTapeCreationPolicyResponse' smart constructor.
data UpdateAutomaticTapeCreationPolicyResponse = UpdateAutomaticTapeCreationPolicyResponse'
  { UpdateAutomaticTapeCreationPolicyResponse -> Maybe Text
gatewayARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateAutomaticTapeCreationPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateAutomaticTapeCreationPolicyResponse
-> UpdateAutomaticTapeCreationPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAutomaticTapeCreationPolicyResponse
-> UpdateAutomaticTapeCreationPolicyResponse -> Bool
$c/= :: UpdateAutomaticTapeCreationPolicyResponse
-> UpdateAutomaticTapeCreationPolicyResponse -> Bool
== :: UpdateAutomaticTapeCreationPolicyResponse
-> UpdateAutomaticTapeCreationPolicyResponse -> Bool
$c== :: UpdateAutomaticTapeCreationPolicyResponse
-> UpdateAutomaticTapeCreationPolicyResponse -> Bool
Prelude.Eq, ReadPrec [UpdateAutomaticTapeCreationPolicyResponse]
ReadPrec UpdateAutomaticTapeCreationPolicyResponse
Int -> ReadS UpdateAutomaticTapeCreationPolicyResponse
ReadS [UpdateAutomaticTapeCreationPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAutomaticTapeCreationPolicyResponse]
$creadListPrec :: ReadPrec [UpdateAutomaticTapeCreationPolicyResponse]
readPrec :: ReadPrec UpdateAutomaticTapeCreationPolicyResponse
$creadPrec :: ReadPrec UpdateAutomaticTapeCreationPolicyResponse
readList :: ReadS [UpdateAutomaticTapeCreationPolicyResponse]
$creadList :: ReadS [UpdateAutomaticTapeCreationPolicyResponse]
readsPrec :: Int -> ReadS UpdateAutomaticTapeCreationPolicyResponse
$creadsPrec :: Int -> ReadS UpdateAutomaticTapeCreationPolicyResponse
Prelude.Read, Int -> UpdateAutomaticTapeCreationPolicyResponse -> ShowS
[UpdateAutomaticTapeCreationPolicyResponse] -> ShowS
UpdateAutomaticTapeCreationPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAutomaticTapeCreationPolicyResponse] -> ShowS
$cshowList :: [UpdateAutomaticTapeCreationPolicyResponse] -> ShowS
show :: UpdateAutomaticTapeCreationPolicyResponse -> String
$cshow :: UpdateAutomaticTapeCreationPolicyResponse -> String
showsPrec :: Int -> UpdateAutomaticTapeCreationPolicyResponse -> ShowS
$cshowsPrec :: Int -> UpdateAutomaticTapeCreationPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateAutomaticTapeCreationPolicyResponse x
-> UpdateAutomaticTapeCreationPolicyResponse
forall x.
UpdateAutomaticTapeCreationPolicyResponse
-> Rep UpdateAutomaticTapeCreationPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAutomaticTapeCreationPolicyResponse x
-> UpdateAutomaticTapeCreationPolicyResponse
$cfrom :: forall x.
UpdateAutomaticTapeCreationPolicyResponse
-> Rep UpdateAutomaticTapeCreationPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAutomaticTapeCreationPolicyResponse' 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:
--
-- 'gatewayARN', 'updateAutomaticTapeCreationPolicyResponse_gatewayARN' - Undocumented member.
--
-- 'httpStatus', 'updateAutomaticTapeCreationPolicyResponse_httpStatus' - The response's http status code.
newUpdateAutomaticTapeCreationPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAutomaticTapeCreationPolicyResponse
newUpdateAutomaticTapeCreationPolicyResponse :: Int -> UpdateAutomaticTapeCreationPolicyResponse
newUpdateAutomaticTapeCreationPolicyResponse
  Int
pHttpStatus_ =
    UpdateAutomaticTapeCreationPolicyResponse'
      { $sel:gatewayARN:UpdateAutomaticTapeCreationPolicyResponse' :: Maybe Text
gatewayARN =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateAutomaticTapeCreationPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Undocumented member.
updateAutomaticTapeCreationPolicyResponse_gatewayARN :: Lens.Lens' UpdateAutomaticTapeCreationPolicyResponse (Prelude.Maybe Prelude.Text)
updateAutomaticTapeCreationPolicyResponse_gatewayARN :: Lens' UpdateAutomaticTapeCreationPolicyResponse (Maybe Text)
updateAutomaticTapeCreationPolicyResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAutomaticTapeCreationPolicyResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:UpdateAutomaticTapeCreationPolicyResponse' :: UpdateAutomaticTapeCreationPolicyResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: UpdateAutomaticTapeCreationPolicyResponse
s@UpdateAutomaticTapeCreationPolicyResponse' {} Maybe Text
a -> UpdateAutomaticTapeCreationPolicyResponse
s {$sel:gatewayARN:UpdateAutomaticTapeCreationPolicyResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: UpdateAutomaticTapeCreationPolicyResponse)

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

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