{-# 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.CreateArchive
-- 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 an archive of events with the specified settings. When you
-- create an archive, incoming events might not immediately start being
-- sent to the archive. Allow a short period of time for changes to take
-- effect. If you do not specify a pattern to filter events sent to the
-- archive, all events are sent to the archive except replayed events.
-- Replayed events are not sent to an archive.
module Amazonka.CloudWatchEvents.CreateArchive
  ( -- * Creating a Request
    CreateArchive (..),
    newCreateArchive,

    -- * Request Lenses
    createArchive_description,
    createArchive_eventPattern,
    createArchive_retentionDays,
    createArchive_archiveName,
    createArchive_eventSourceArn,

    -- * Destructuring the Response
    CreateArchiveResponse (..),
    newCreateArchiveResponse,

    -- * Response Lenses
    createArchiveResponse_archiveArn,
    createArchiveResponse_creationTime,
    createArchiveResponse_state,
    createArchiveResponse_stateReason,
    createArchiveResponse_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:/ 'newCreateArchive' smart constructor.
data CreateArchive = CreateArchive'
  { -- | A description for the archive.
    CreateArchive -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An event pattern to use to filter events sent to the archive.
    CreateArchive -> Maybe Text
eventPattern :: Prelude.Maybe Prelude.Text,
    -- | The number of days to retain events for. Default value is 0. If set to
    -- 0, events are retained indefinitely
    CreateArchive -> Maybe Natural
retentionDays :: Prelude.Maybe Prelude.Natural,
    -- | The name for the archive to create.
    CreateArchive -> Text
archiveName :: Prelude.Text,
    -- | The ARN of the event bus that sends events to the archive.
    CreateArchive -> Text
eventSourceArn :: Prelude.Text
  }
  deriving (CreateArchive -> CreateArchive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateArchive -> CreateArchive -> Bool
$c/= :: CreateArchive -> CreateArchive -> Bool
== :: CreateArchive -> CreateArchive -> Bool
$c== :: CreateArchive -> CreateArchive -> Bool
Prelude.Eq, ReadPrec [CreateArchive]
ReadPrec CreateArchive
Int -> ReadS CreateArchive
ReadS [CreateArchive]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateArchive]
$creadListPrec :: ReadPrec [CreateArchive]
readPrec :: ReadPrec CreateArchive
$creadPrec :: ReadPrec CreateArchive
readList :: ReadS [CreateArchive]
$creadList :: ReadS [CreateArchive]
readsPrec :: Int -> ReadS CreateArchive
$creadsPrec :: Int -> ReadS CreateArchive
Prelude.Read, Int -> CreateArchive -> ShowS
[CreateArchive] -> ShowS
CreateArchive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateArchive] -> ShowS
$cshowList :: [CreateArchive] -> ShowS
show :: CreateArchive -> String
$cshow :: CreateArchive -> String
showsPrec :: Int -> CreateArchive -> ShowS
$cshowsPrec :: Int -> CreateArchive -> ShowS
Prelude.Show, forall x. Rep CreateArchive x -> CreateArchive
forall x. CreateArchive -> Rep CreateArchive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateArchive x -> CreateArchive
$cfrom :: forall x. CreateArchive -> Rep CreateArchive x
Prelude.Generic)

-- |
-- Create a value of 'CreateArchive' 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', 'createArchive_description' - A description for the archive.
--
-- 'eventPattern', 'createArchive_eventPattern' - An event pattern to use to filter events sent to the archive.
--
-- 'retentionDays', 'createArchive_retentionDays' - The number of days to retain events for. Default value is 0. If set to
-- 0, events are retained indefinitely
--
-- 'archiveName', 'createArchive_archiveName' - The name for the archive to create.
--
-- 'eventSourceArn', 'createArchive_eventSourceArn' - The ARN of the event bus that sends events to the archive.
newCreateArchive ::
  -- | 'archiveName'
  Prelude.Text ->
  -- | 'eventSourceArn'
  Prelude.Text ->
  CreateArchive
newCreateArchive :: Text -> Text -> CreateArchive
newCreateArchive Text
pArchiveName_ Text
pEventSourceArn_ =
  CreateArchive'
    { $sel:description:CreateArchive' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:eventPattern:CreateArchive' :: Maybe Text
eventPattern = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionDays:CreateArchive' :: Maybe Natural
retentionDays = forall a. Maybe a
Prelude.Nothing,
      $sel:archiveName:CreateArchive' :: Text
archiveName = Text
pArchiveName_,
      $sel:eventSourceArn:CreateArchive' :: Text
eventSourceArn = Text
pEventSourceArn_
    }

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

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

-- | The number of days to retain events for. Default value is 0. If set to
-- 0, events are retained indefinitely
createArchive_retentionDays :: Lens.Lens' CreateArchive (Prelude.Maybe Prelude.Natural)
createArchive_retentionDays :: Lens' CreateArchive (Maybe Natural)
createArchive_retentionDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchive' {Maybe Natural
retentionDays :: Maybe Natural
$sel:retentionDays:CreateArchive' :: CreateArchive -> Maybe Natural
retentionDays} -> Maybe Natural
retentionDays) (\s :: CreateArchive
s@CreateArchive' {} Maybe Natural
a -> CreateArchive
s {$sel:retentionDays:CreateArchive' :: Maybe Natural
retentionDays = Maybe Natural
a} :: CreateArchive)

-- | The name for the archive to create.
createArchive_archiveName :: Lens.Lens' CreateArchive Prelude.Text
createArchive_archiveName :: Lens' CreateArchive Text
createArchive_archiveName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchive' {Text
archiveName :: Text
$sel:archiveName:CreateArchive' :: CreateArchive -> Text
archiveName} -> Text
archiveName) (\s :: CreateArchive
s@CreateArchive' {} Text
a -> CreateArchive
s {$sel:archiveName:CreateArchive' :: Text
archiveName = Text
a} :: CreateArchive)

-- | The ARN of the event bus that sends events to the archive.
createArchive_eventSourceArn :: Lens.Lens' CreateArchive Prelude.Text
createArchive_eventSourceArn :: Lens' CreateArchive Text
createArchive_eventSourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchive' {Text
eventSourceArn :: Text
$sel:eventSourceArn:CreateArchive' :: CreateArchive -> Text
eventSourceArn} -> Text
eventSourceArn) (\s :: CreateArchive
s@CreateArchive' {} Text
a -> CreateArchive
s {$sel:eventSourceArn:CreateArchive' :: Text
eventSourceArn = Text
a} :: CreateArchive)

instance Core.AWSRequest CreateArchive where
  type
    AWSResponse CreateArchive =
      CreateArchiveResponse
  request :: (Service -> Service) -> CreateArchive -> Request CreateArchive
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 CreateArchive
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateArchive)))
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
-> CreateArchiveResponse
CreateArchiveResponse'
            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 CreateArchive where
  hashWithSalt :: Int -> CreateArchive -> Int
hashWithSalt Int
_salt CreateArchive' {Maybe Natural
Maybe Text
Text
eventSourceArn :: Text
archiveName :: Text
retentionDays :: Maybe Natural
eventPattern :: Maybe Text
description :: Maybe Text
$sel:eventSourceArn:CreateArchive' :: CreateArchive -> Text
$sel:archiveName:CreateArchive' :: CreateArchive -> Text
$sel:retentionDays:CreateArchive' :: CreateArchive -> Maybe Natural
$sel:eventPattern:CreateArchive' :: CreateArchive -> Maybe Text
$sel:description:CreateArchive' :: CreateArchive -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventSourceArn

instance Prelude.NFData CreateArchive where
  rnf :: CreateArchive -> ()
rnf CreateArchive' {Maybe Natural
Maybe Text
Text
eventSourceArn :: Text
archiveName :: Text
retentionDays :: Maybe Natural
eventPattern :: Maybe Text
description :: Maybe Text
$sel:eventSourceArn:CreateArchive' :: CreateArchive -> Text
$sel:archiveName:CreateArchive' :: CreateArchive -> Text
$sel:retentionDays:CreateArchive' :: CreateArchive -> Maybe Natural
$sel:eventPattern:CreateArchive' :: CreateArchive -> Maybe Text
$sel:description:CreateArchive' :: CreateArchive -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventSourceArn

instance Data.ToHeaders CreateArchive where
  toHeaders :: CreateArchive -> 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.CreateArchive" :: 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 CreateArchive where
  toJSON :: CreateArchive -> Value
toJSON CreateArchive' {Maybe Natural
Maybe Text
Text
eventSourceArn :: Text
archiveName :: Text
retentionDays :: Maybe Natural
eventPattern :: Maybe Text
description :: Maybe Text
$sel:eventSourceArn:CreateArchive' :: CreateArchive -> Text
$sel:archiveName:CreateArchive' :: CreateArchive -> Text
$sel:retentionDays:CreateArchive' :: CreateArchive -> Maybe Natural
$sel:eventPattern:CreateArchive' :: CreateArchive -> Maybe Text
$sel:description:CreateArchive' :: CreateArchive -> 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),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EventSourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventSourceArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateArchiveResponse' 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', 'createArchiveResponse_archiveArn' - The ARN of the archive that was created.
--
-- 'creationTime', 'createArchiveResponse_creationTime' - The time at which the archive was created.
--
-- 'state', 'createArchiveResponse_state' - The state of the archive that was created.
--
-- 'stateReason', 'createArchiveResponse_stateReason' - The reason that the archive is in the state.
--
-- 'httpStatus', 'createArchiveResponse_httpStatus' - The response's http status code.
newCreateArchiveResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateArchiveResponse
newCreateArchiveResponse :: Int -> CreateArchiveResponse
newCreateArchiveResponse Int
pHttpStatus_ =
  CreateArchiveResponse'
    { $sel:archiveArn:CreateArchiveResponse' :: Maybe Text
archiveArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:CreateArchiveResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateArchiveResponse' :: Maybe ArchiveState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateReason:CreateArchiveResponse' :: Maybe Text
stateReason = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateArchiveResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The time at which the archive was created.
createArchiveResponse_creationTime :: Lens.Lens' CreateArchiveResponse (Prelude.Maybe Prelude.UTCTime)
createArchiveResponse_creationTime :: Lens' CreateArchiveResponse (Maybe UTCTime)
createArchiveResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchiveResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:CreateArchiveResponse' :: CreateArchiveResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: CreateArchiveResponse
s@CreateArchiveResponse' {} Maybe POSIX
a -> CreateArchiveResponse
s {$sel:creationTime:CreateArchiveResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: CreateArchiveResponse) 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 that was created.
createArchiveResponse_state :: Lens.Lens' CreateArchiveResponse (Prelude.Maybe ArchiveState)
createArchiveResponse_state :: Lens' CreateArchiveResponse (Maybe ArchiveState)
createArchiveResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateArchiveResponse' {Maybe ArchiveState
state :: Maybe ArchiveState
$sel:state:CreateArchiveResponse' :: CreateArchiveResponse -> Maybe ArchiveState
state} -> Maybe ArchiveState
state) (\s :: CreateArchiveResponse
s@CreateArchiveResponse' {} Maybe ArchiveState
a -> CreateArchiveResponse
s {$sel:state:CreateArchiveResponse' :: Maybe ArchiveState
state = Maybe ArchiveState
a} :: CreateArchiveResponse)

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

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

instance Prelude.NFData CreateArchiveResponse where
  rnf :: CreateArchiveResponse -> ()
rnf CreateArchiveResponse' {Int
Maybe Text
Maybe POSIX
Maybe ArchiveState
httpStatus :: Int
stateReason :: Maybe Text
state :: Maybe ArchiveState
creationTime :: Maybe POSIX
archiveArn :: Maybe Text
$sel:httpStatus:CreateArchiveResponse' :: CreateArchiveResponse -> Int
$sel:stateReason:CreateArchiveResponse' :: CreateArchiveResponse -> Maybe Text
$sel:state:CreateArchiveResponse' :: CreateArchiveResponse -> Maybe ArchiveState
$sel:creationTime:CreateArchiveResponse' :: CreateArchiveResponse -> Maybe POSIX
$sel:archiveArn:CreateArchiveResponse' :: CreateArchiveResponse -> 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