{-# 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.CloudWatchEvents.UpdateArchive
-- 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 specified archive.
module Amazonka.CloudWatchEvents.UpdateArchive
  ( -- * Creating a Request
    UpdateArchive (..),
    newUpdateArchive,

    -- * Request Lenses
    updateArchive_description,
    updateArchive_eventPattern,
    updateArchive_retentionDays,
    updateArchive_archiveName,

    -- * Destructuring the Response
    UpdateArchiveResponse (..),
    newUpdateArchiveResponse,

    -- * Response Lenses
    updateArchiveResponse_archiveArn,
    updateArchiveResponse_creationTime,
    updateArchiveResponse_state,
    updateArchiveResponse_stateReason,
    updateArchiveResponse_httpStatus,
  )
where

import Amazonka.CloudWatchEvents.Types
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

-- | /See:/ 'newUpdateArchive' smart constructor.
data UpdateArchive = UpdateArchive'
  { -- | The description for the archive.
    UpdateArchive -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The event pattern to use to filter events sent to the archive.
    UpdateArchive -> Maybe Text
eventPattern :: Prelude.Maybe Prelude.Text,
    -- | The number of days to retain events in the archive.
    UpdateArchive -> Maybe Natural
retentionDays :: Prelude.Maybe Prelude.Natural,
    -- | The name of the archive to update.
    UpdateArchive -> Text
archiveName :: Prelude.Text
  }
  deriving (UpdateArchive -> UpdateArchive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateArchive -> UpdateArchive -> Bool
$c/= :: UpdateArchive -> UpdateArchive -> Bool
== :: UpdateArchive -> UpdateArchive -> Bool
$c== :: UpdateArchive -> UpdateArchive -> Bool
Prelude.Eq, ReadPrec [UpdateArchive]
ReadPrec UpdateArchive
Int -> ReadS UpdateArchive
ReadS [UpdateArchive]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateArchive]
$creadListPrec :: ReadPrec [UpdateArchive]
readPrec :: ReadPrec UpdateArchive
$creadPrec :: ReadPrec UpdateArchive
readList :: ReadS [UpdateArchive]
$creadList :: ReadS [UpdateArchive]
readsPrec :: Int -> ReadS UpdateArchive
$creadsPrec :: Int -> ReadS UpdateArchive
Prelude.Read, Int -> UpdateArchive -> ShowS
[UpdateArchive] -> ShowS
UpdateArchive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateArchive] -> ShowS
$cshowList :: [UpdateArchive] -> ShowS
show :: UpdateArchive -> String
$cshow :: UpdateArchive -> String
showsPrec :: Int -> UpdateArchive -> ShowS
$cshowsPrec :: Int -> UpdateArchive -> ShowS
Prelude.Show, forall x. Rep UpdateArchive x -> UpdateArchive
forall x. UpdateArchive -> Rep UpdateArchive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateArchive x -> UpdateArchive
$cfrom :: forall x. UpdateArchive -> Rep UpdateArchive x
Prelude.Generic)

-- |
-- Create a value of 'UpdateArchive' 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:
--
-- 'description', 'updateArchive_description' - The description for the archive.
--
-- 'eventPattern', 'updateArchive_eventPattern' - The event pattern to use to filter events sent to the archive.
--
-- 'retentionDays', 'updateArchive_retentionDays' - The number of days to retain events in the archive.
--
-- 'archiveName', 'updateArchive_archiveName' - The name of the archive to update.
newUpdateArchive ::
  -- | 'archiveName'
  Prelude.Text ->
  UpdateArchive
newUpdateArchive :: Text -> UpdateArchive
newUpdateArchive Text
pArchiveName_ =
  UpdateArchive'
    { $sel:description:UpdateArchive' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:eventPattern:UpdateArchive' :: Maybe Text
eventPattern = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionDays:UpdateArchive' :: Maybe Natural
retentionDays = forall a. Maybe a
Prelude.Nothing,
      $sel:archiveName:UpdateArchive' :: Text
archiveName = Text
pArchiveName_
    }

-- | The description for the archive.
updateArchive_description :: Lens.Lens' UpdateArchive (Prelude.Maybe Prelude.Text)
updateArchive_description :: Lens' UpdateArchive (Maybe Text)
updateArchive_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchive' {Maybe Text
description :: Maybe Text
$sel:description:UpdateArchive' :: UpdateArchive -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateArchive
s@UpdateArchive' {} Maybe Text
a -> UpdateArchive
s {$sel:description:UpdateArchive' :: Maybe Text
description = Maybe Text
a} :: UpdateArchive)

-- | The event pattern to use to filter events sent to the archive.
updateArchive_eventPattern :: Lens.Lens' UpdateArchive (Prelude.Maybe Prelude.Text)
updateArchive_eventPattern :: Lens' UpdateArchive (Maybe Text)
updateArchive_eventPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchive' {Maybe Text
eventPattern :: Maybe Text
$sel:eventPattern:UpdateArchive' :: UpdateArchive -> Maybe Text
eventPattern} -> Maybe Text
eventPattern) (\s :: UpdateArchive
s@UpdateArchive' {} Maybe Text
a -> UpdateArchive
s {$sel:eventPattern:UpdateArchive' :: Maybe Text
eventPattern = Maybe Text
a} :: UpdateArchive)

-- | The number of days to retain events in the archive.
updateArchive_retentionDays :: Lens.Lens' UpdateArchive (Prelude.Maybe Prelude.Natural)
updateArchive_retentionDays :: Lens' UpdateArchive (Maybe Natural)
updateArchive_retentionDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchive' {Maybe Natural
retentionDays :: Maybe Natural
$sel:retentionDays:UpdateArchive' :: UpdateArchive -> Maybe Natural
retentionDays} -> Maybe Natural
retentionDays) (\s :: UpdateArchive
s@UpdateArchive' {} Maybe Natural
a -> UpdateArchive
s {$sel:retentionDays:UpdateArchive' :: Maybe Natural
retentionDays = Maybe Natural
a} :: UpdateArchive)

-- | The name of the archive to update.
updateArchive_archiveName :: Lens.Lens' UpdateArchive Prelude.Text
updateArchive_archiveName :: Lens' UpdateArchive Text
updateArchive_archiveName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchive' {Text
archiveName :: Text
$sel:archiveName:UpdateArchive' :: UpdateArchive -> Text
archiveName} -> Text
archiveName) (\s :: UpdateArchive
s@UpdateArchive' {} Text
a -> UpdateArchive
s {$sel:archiveName:UpdateArchive' :: Text
archiveName = Text
a} :: UpdateArchive)

instance Core.AWSRequest UpdateArchive where
  type
    AWSResponse UpdateArchive =
      UpdateArchiveResponse
  request :: (Service -> Service) -> UpdateArchive -> Request UpdateArchive
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 UpdateArchive
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateArchive)))
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
-> Maybe POSIX
-> Maybe ArchiveState
-> Maybe Text
-> Int
-> UpdateArchiveResponse
UpdateArchiveResponse'
            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
"ArchiveArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StateReason")
            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 UpdateArchive where
  hashWithSalt :: Int -> UpdateArchive -> Int
hashWithSalt Int
_salt UpdateArchive' {Maybe Natural
Maybe Text
Text
archiveName :: Text
retentionDays :: Maybe Natural
eventPattern :: Maybe Text
description :: Maybe Text
$sel:archiveName:UpdateArchive' :: UpdateArchive -> Text
$sel:retentionDays:UpdateArchive' :: UpdateArchive -> Maybe Natural
$sel:eventPattern:UpdateArchive' :: UpdateArchive -> Maybe Text
$sel:description:UpdateArchive' :: UpdateArchive -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventPattern
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
retentionDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
archiveName

instance Prelude.NFData UpdateArchive where
  rnf :: UpdateArchive -> ()
rnf UpdateArchive' {Maybe Natural
Maybe Text
Text
archiveName :: Text
retentionDays :: Maybe Natural
eventPattern :: Maybe Text
description :: Maybe Text
$sel:archiveName:UpdateArchive' :: UpdateArchive -> Text
$sel:retentionDays:UpdateArchive' :: UpdateArchive -> Maybe Natural
$sel:eventPattern:UpdateArchive' :: UpdateArchive -> Maybe Text
$sel:description:UpdateArchive' :: UpdateArchive -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventPattern
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
retentionDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
archiveName

instance Data.ToHeaders UpdateArchive where
  toHeaders :: UpdateArchive -> 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
"AWSEvents.UpdateArchive" :: 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 UpdateArchive where
  toJSON :: UpdateArchive -> Value
toJSON UpdateArchive' {Maybe Natural
Maybe Text
Text
archiveName :: Text
retentionDays :: Maybe Natural
eventPattern :: Maybe Text
description :: Maybe Text
$sel:archiveName:UpdateArchive' :: UpdateArchive -> Text
$sel:retentionDays:UpdateArchive' :: UpdateArchive -> Maybe Natural
$sel:eventPattern:UpdateArchive' :: UpdateArchive -> Maybe Text
$sel:description:UpdateArchive' :: UpdateArchive -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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 Text
description,
            (Key
"EventPattern" 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 Text
eventPattern,
            (Key
"RetentionDays" 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
retentionDays,
            forall a. a -> Maybe a
Prelude.Just (Key
"ArchiveName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
archiveName)
          ]
      )

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

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

-- | /See:/ 'newUpdateArchiveResponse' smart constructor.
data UpdateArchiveResponse = UpdateArchiveResponse'
  { -- | The ARN of the archive.
    UpdateArchiveResponse -> Maybe Text
archiveArn :: Prelude.Maybe Prelude.Text,
    -- | The time at which the archive was updated.
    UpdateArchiveResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The state of the archive.
    UpdateArchiveResponse -> Maybe ArchiveState
state :: Prelude.Maybe ArchiveState,
    -- | The reason that the archive is in the current state.
    UpdateArchiveResponse -> Maybe Text
stateReason :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateArchiveResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateArchiveResponse -> UpdateArchiveResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateArchiveResponse -> UpdateArchiveResponse -> Bool
$c/= :: UpdateArchiveResponse -> UpdateArchiveResponse -> Bool
== :: UpdateArchiveResponse -> UpdateArchiveResponse -> Bool
$c== :: UpdateArchiveResponse -> UpdateArchiveResponse -> Bool
Prelude.Eq, ReadPrec [UpdateArchiveResponse]
ReadPrec UpdateArchiveResponse
Int -> ReadS UpdateArchiveResponse
ReadS [UpdateArchiveResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateArchiveResponse]
$creadListPrec :: ReadPrec [UpdateArchiveResponse]
readPrec :: ReadPrec UpdateArchiveResponse
$creadPrec :: ReadPrec UpdateArchiveResponse
readList :: ReadS [UpdateArchiveResponse]
$creadList :: ReadS [UpdateArchiveResponse]
readsPrec :: Int -> ReadS UpdateArchiveResponse
$creadsPrec :: Int -> ReadS UpdateArchiveResponse
Prelude.Read, Int -> UpdateArchiveResponse -> ShowS
[UpdateArchiveResponse] -> ShowS
UpdateArchiveResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateArchiveResponse] -> ShowS
$cshowList :: [UpdateArchiveResponse] -> ShowS
show :: UpdateArchiveResponse -> String
$cshow :: UpdateArchiveResponse -> String
showsPrec :: Int -> UpdateArchiveResponse -> ShowS
$cshowsPrec :: Int -> UpdateArchiveResponse -> ShowS
Prelude.Show, forall x. Rep UpdateArchiveResponse x -> UpdateArchiveResponse
forall x. UpdateArchiveResponse -> Rep UpdateArchiveResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateArchiveResponse x -> UpdateArchiveResponse
$cfrom :: forall x. UpdateArchiveResponse -> Rep UpdateArchiveResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateArchiveResponse' 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:
--
-- 'archiveArn', 'updateArchiveResponse_archiveArn' - The ARN of the archive.
--
-- 'creationTime', 'updateArchiveResponse_creationTime' - The time at which the archive was updated.
--
-- 'state', 'updateArchiveResponse_state' - The state of the archive.
--
-- 'stateReason', 'updateArchiveResponse_stateReason' - The reason that the archive is in the current state.
--
-- 'httpStatus', 'updateArchiveResponse_httpStatus' - The response's http status code.
newUpdateArchiveResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateArchiveResponse
newUpdateArchiveResponse :: Int -> UpdateArchiveResponse
newUpdateArchiveResponse Int
pHttpStatus_ =
  UpdateArchiveResponse'
    { $sel:archiveArn:UpdateArchiveResponse' :: Maybe Text
archiveArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:UpdateArchiveResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:state:UpdateArchiveResponse' :: Maybe ArchiveState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateReason:UpdateArchiveResponse' :: Maybe Text
stateReason = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateArchiveResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the archive.
updateArchiveResponse_archiveArn :: Lens.Lens' UpdateArchiveResponse (Prelude.Maybe Prelude.Text)
updateArchiveResponse_archiveArn :: Lens' UpdateArchiveResponse (Maybe Text)
updateArchiveResponse_archiveArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchiveResponse' {Maybe Text
archiveArn :: Maybe Text
$sel:archiveArn:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe Text
archiveArn} -> Maybe Text
archiveArn) (\s :: UpdateArchiveResponse
s@UpdateArchiveResponse' {} Maybe Text
a -> UpdateArchiveResponse
s {$sel:archiveArn:UpdateArchiveResponse' :: Maybe Text
archiveArn = Maybe Text
a} :: UpdateArchiveResponse)

-- | The time at which the archive was updated.
updateArchiveResponse_creationTime :: Lens.Lens' UpdateArchiveResponse (Prelude.Maybe Prelude.UTCTime)
updateArchiveResponse_creationTime :: Lens' UpdateArchiveResponse (Maybe UTCTime)
updateArchiveResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchiveResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: UpdateArchiveResponse
s@UpdateArchiveResponse' {} Maybe POSIX
a -> UpdateArchiveResponse
s {$sel:creationTime:UpdateArchiveResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: UpdateArchiveResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The state of the archive.
updateArchiveResponse_state :: Lens.Lens' UpdateArchiveResponse (Prelude.Maybe ArchiveState)
updateArchiveResponse_state :: Lens' UpdateArchiveResponse (Maybe ArchiveState)
updateArchiveResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchiveResponse' {Maybe ArchiveState
state :: Maybe ArchiveState
$sel:state:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe ArchiveState
state} -> Maybe ArchiveState
state) (\s :: UpdateArchiveResponse
s@UpdateArchiveResponse' {} Maybe ArchiveState
a -> UpdateArchiveResponse
s {$sel:state:UpdateArchiveResponse' :: Maybe ArchiveState
state = Maybe ArchiveState
a} :: UpdateArchiveResponse)

-- | The reason that the archive is in the current state.
updateArchiveResponse_stateReason :: Lens.Lens' UpdateArchiveResponse (Prelude.Maybe Prelude.Text)
updateArchiveResponse_stateReason :: Lens' UpdateArchiveResponse (Maybe Text)
updateArchiveResponse_stateReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArchiveResponse' {Maybe Text
stateReason :: Maybe Text
$sel:stateReason:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe Text
stateReason} -> Maybe Text
stateReason) (\s :: UpdateArchiveResponse
s@UpdateArchiveResponse' {} Maybe Text
a -> UpdateArchiveResponse
s {$sel:stateReason:UpdateArchiveResponse' :: Maybe Text
stateReason = Maybe Text
a} :: UpdateArchiveResponse)

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

instance Prelude.NFData UpdateArchiveResponse where
  rnf :: UpdateArchiveResponse -> ()
rnf UpdateArchiveResponse' {Int
Maybe Text
Maybe POSIX
Maybe ArchiveState
httpStatus :: Int
stateReason :: Maybe Text
state :: Maybe ArchiveState
creationTime :: Maybe POSIX
archiveArn :: Maybe Text
$sel:httpStatus:UpdateArchiveResponse' :: UpdateArchiveResponse -> Int
$sel:stateReason:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe Text
$sel:state:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe ArchiveState
$sel:creationTime:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe POSIX
$sel:archiveArn:UpdateArchiveResponse' :: UpdateArchiveResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
archiveArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ArchiveState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stateReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus