{-# 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.Backup.CreateBackupSelection
-- 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 JSON document that specifies a set of resources to assign to a
-- backup plan. For examples, see
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/assigning-resources.html#assigning-resources-json Assigning resources programmatically>.
module Amazonka.Backup.CreateBackupSelection
  ( -- * Creating a Request
    CreateBackupSelection (..),
    newCreateBackupSelection,

    -- * Request Lenses
    createBackupSelection_creatorRequestId,
    createBackupSelection_backupPlanId,
    createBackupSelection_backupSelection,

    -- * Destructuring the Response
    CreateBackupSelectionResponse (..),
    newCreateBackupSelectionResponse,

    -- * Response Lenses
    createBackupSelectionResponse_backupPlanId,
    createBackupSelectionResponse_creationDate,
    createBackupSelectionResponse_selectionId,
    createBackupSelectionResponse_httpStatus,
  )
where

import Amazonka.Backup.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:/ 'newCreateBackupSelection' smart constructor.
data CreateBackupSelection = CreateBackupSelection'
  { -- | A unique string that identifies the request and allows failed requests
    -- to be retried without the risk of running the operation twice. This
    -- parameter is optional.
    --
    -- If used, this parameter must contain 1 to 50 alphanumeric or \'-_.\'
    -- characters.
    CreateBackupSelection -> Maybe Text
creatorRequestId :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies the backup plan to be associated with the selection
    -- of resources.
    CreateBackupSelection -> Text
backupPlanId :: Prelude.Text,
    -- | Specifies the body of a request to assign a set of resources to a backup
    -- plan.
    CreateBackupSelection -> BackupSelection
backupSelection :: BackupSelection
  }
  deriving (CreateBackupSelection -> CreateBackupSelection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBackupSelection -> CreateBackupSelection -> Bool
$c/= :: CreateBackupSelection -> CreateBackupSelection -> Bool
== :: CreateBackupSelection -> CreateBackupSelection -> Bool
$c== :: CreateBackupSelection -> CreateBackupSelection -> Bool
Prelude.Eq, ReadPrec [CreateBackupSelection]
ReadPrec CreateBackupSelection
Int -> ReadS CreateBackupSelection
ReadS [CreateBackupSelection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBackupSelection]
$creadListPrec :: ReadPrec [CreateBackupSelection]
readPrec :: ReadPrec CreateBackupSelection
$creadPrec :: ReadPrec CreateBackupSelection
readList :: ReadS [CreateBackupSelection]
$creadList :: ReadS [CreateBackupSelection]
readsPrec :: Int -> ReadS CreateBackupSelection
$creadsPrec :: Int -> ReadS CreateBackupSelection
Prelude.Read, Int -> CreateBackupSelection -> ShowS
[CreateBackupSelection] -> ShowS
CreateBackupSelection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBackupSelection] -> ShowS
$cshowList :: [CreateBackupSelection] -> ShowS
show :: CreateBackupSelection -> String
$cshow :: CreateBackupSelection -> String
showsPrec :: Int -> CreateBackupSelection -> ShowS
$cshowsPrec :: Int -> CreateBackupSelection -> ShowS
Prelude.Show, forall x. Rep CreateBackupSelection x -> CreateBackupSelection
forall x. CreateBackupSelection -> Rep CreateBackupSelection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBackupSelection x -> CreateBackupSelection
$cfrom :: forall x. CreateBackupSelection -> Rep CreateBackupSelection x
Prelude.Generic)

-- |
-- Create a value of 'CreateBackupSelection' 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:
--
-- 'creatorRequestId', 'createBackupSelection_creatorRequestId' - A unique string that identifies the request and allows failed requests
-- to be retried without the risk of running the operation twice. This
-- parameter is optional.
--
-- If used, this parameter must contain 1 to 50 alphanumeric or \'-_.\'
-- characters.
--
-- 'backupPlanId', 'createBackupSelection_backupPlanId' - Uniquely identifies the backup plan to be associated with the selection
-- of resources.
--
-- 'backupSelection', 'createBackupSelection_backupSelection' - Specifies the body of a request to assign a set of resources to a backup
-- plan.
newCreateBackupSelection ::
  -- | 'backupPlanId'
  Prelude.Text ->
  -- | 'backupSelection'
  BackupSelection ->
  CreateBackupSelection
newCreateBackupSelection :: Text -> BackupSelection -> CreateBackupSelection
newCreateBackupSelection
  Text
pBackupPlanId_
  BackupSelection
pBackupSelection_ =
    CreateBackupSelection'
      { $sel:creatorRequestId:CreateBackupSelection' :: Maybe Text
creatorRequestId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:backupPlanId:CreateBackupSelection' :: Text
backupPlanId = Text
pBackupPlanId_,
        $sel:backupSelection:CreateBackupSelection' :: BackupSelection
backupSelection = BackupSelection
pBackupSelection_
      }

-- | A unique string that identifies the request and allows failed requests
-- to be retried without the risk of running the operation twice. This
-- parameter is optional.
--
-- If used, this parameter must contain 1 to 50 alphanumeric or \'-_.\'
-- characters.
createBackupSelection_creatorRequestId :: Lens.Lens' CreateBackupSelection (Prelude.Maybe Prelude.Text)
createBackupSelection_creatorRequestId :: Lens' CreateBackupSelection (Maybe Text)
createBackupSelection_creatorRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupSelection' {Maybe Text
creatorRequestId :: Maybe Text
$sel:creatorRequestId:CreateBackupSelection' :: CreateBackupSelection -> Maybe Text
creatorRequestId} -> Maybe Text
creatorRequestId) (\s :: CreateBackupSelection
s@CreateBackupSelection' {} Maybe Text
a -> CreateBackupSelection
s {$sel:creatorRequestId:CreateBackupSelection' :: Maybe Text
creatorRequestId = Maybe Text
a} :: CreateBackupSelection)

-- | Uniquely identifies the backup plan to be associated with the selection
-- of resources.
createBackupSelection_backupPlanId :: Lens.Lens' CreateBackupSelection Prelude.Text
createBackupSelection_backupPlanId :: Lens' CreateBackupSelection Text
createBackupSelection_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupSelection' {Text
backupPlanId :: Text
$sel:backupPlanId:CreateBackupSelection' :: CreateBackupSelection -> Text
backupPlanId} -> Text
backupPlanId) (\s :: CreateBackupSelection
s@CreateBackupSelection' {} Text
a -> CreateBackupSelection
s {$sel:backupPlanId:CreateBackupSelection' :: Text
backupPlanId = Text
a} :: CreateBackupSelection)

-- | Specifies the body of a request to assign a set of resources to a backup
-- plan.
createBackupSelection_backupSelection :: Lens.Lens' CreateBackupSelection BackupSelection
createBackupSelection_backupSelection :: Lens' CreateBackupSelection BackupSelection
createBackupSelection_backupSelection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupSelection' {BackupSelection
backupSelection :: BackupSelection
$sel:backupSelection:CreateBackupSelection' :: CreateBackupSelection -> BackupSelection
backupSelection} -> BackupSelection
backupSelection) (\s :: CreateBackupSelection
s@CreateBackupSelection' {} BackupSelection
a -> CreateBackupSelection
s {$sel:backupSelection:CreateBackupSelection' :: BackupSelection
backupSelection = BackupSelection
a} :: CreateBackupSelection)

instance Core.AWSRequest CreateBackupSelection where
  type
    AWSResponse CreateBackupSelection =
      CreateBackupSelectionResponse
  request :: (Service -> Service)
-> CreateBackupSelection -> Request CreateBackupSelection
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateBackupSelection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateBackupSelection)))
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 Text
-> Int
-> CreateBackupSelectionResponse
CreateBackupSelectionResponse'
            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
"BackupPlanId")
            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
"CreationDate")
            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
"SelectionId")
            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 CreateBackupSelection where
  hashWithSalt :: Int -> CreateBackupSelection -> Int
hashWithSalt Int
_salt CreateBackupSelection' {Maybe Text
Text
BackupSelection
backupSelection :: BackupSelection
backupPlanId :: Text
creatorRequestId :: Maybe Text
$sel:backupSelection:CreateBackupSelection' :: CreateBackupSelection -> BackupSelection
$sel:backupPlanId:CreateBackupSelection' :: CreateBackupSelection -> Text
$sel:creatorRequestId:CreateBackupSelection' :: CreateBackupSelection -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
creatorRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupPlanId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BackupSelection
backupSelection

instance Prelude.NFData CreateBackupSelection where
  rnf :: CreateBackupSelection -> ()
rnf CreateBackupSelection' {Maybe Text
Text
BackupSelection
backupSelection :: BackupSelection
backupPlanId :: Text
creatorRequestId :: Maybe Text
$sel:backupSelection:CreateBackupSelection' :: CreateBackupSelection -> BackupSelection
$sel:backupPlanId:CreateBackupSelection' :: CreateBackupSelection -> Text
$sel:creatorRequestId:CreateBackupSelection' :: CreateBackupSelection -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creatorRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
backupPlanId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BackupSelection
backupSelection

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

instance Data.ToJSON CreateBackupSelection where
  toJSON :: CreateBackupSelection -> Value
toJSON CreateBackupSelection' {Maybe Text
Text
BackupSelection
backupSelection :: BackupSelection
backupPlanId :: Text
creatorRequestId :: Maybe Text
$sel:backupSelection:CreateBackupSelection' :: CreateBackupSelection -> BackupSelection
$sel:backupPlanId:CreateBackupSelection' :: CreateBackupSelection -> Text
$sel:creatorRequestId:CreateBackupSelection' :: CreateBackupSelection -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CreatorRequestId" 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
creatorRequestId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"BackupSelection" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= BackupSelection
backupSelection)
          ]
      )

instance Data.ToPath CreateBackupSelection where
  toPath :: CreateBackupSelection -> ByteString
toPath CreateBackupSelection' {Maybe Text
Text
BackupSelection
backupSelection :: BackupSelection
backupPlanId :: Text
creatorRequestId :: Maybe Text
$sel:backupSelection:CreateBackupSelection' :: CreateBackupSelection -> BackupSelection
$sel:backupPlanId:CreateBackupSelection' :: CreateBackupSelection -> Text
$sel:creatorRequestId:CreateBackupSelection' :: CreateBackupSelection -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup/plans/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupPlanId,
        ByteString
"/selections/"
      ]

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

-- | /See:/ 'newCreateBackupSelectionResponse' smart constructor.
data CreateBackupSelectionResponse = CreateBackupSelectionResponse'
  { -- | Uniquely identifies a backup plan.
    CreateBackupSelectionResponse -> Maybe Text
backupPlanId :: Prelude.Maybe Prelude.Text,
    -- | The date and time a backup selection is created, in Unix format and
    -- Coordinated Universal Time (UTC). The value of @CreationDate@ is
    -- accurate to milliseconds. For example, the value 1516925490.087
    -- represents Friday, January 26, 2018 12:11:30.087 AM.
    CreateBackupSelectionResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | Uniquely identifies the body of a request to assign a set of resources
    -- to a backup plan.
    CreateBackupSelectionResponse -> Maybe Text
selectionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateBackupSelectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateBackupSelectionResponse
-> CreateBackupSelectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBackupSelectionResponse
-> CreateBackupSelectionResponse -> Bool
$c/= :: CreateBackupSelectionResponse
-> CreateBackupSelectionResponse -> Bool
== :: CreateBackupSelectionResponse
-> CreateBackupSelectionResponse -> Bool
$c== :: CreateBackupSelectionResponse
-> CreateBackupSelectionResponse -> Bool
Prelude.Eq, ReadPrec [CreateBackupSelectionResponse]
ReadPrec CreateBackupSelectionResponse
Int -> ReadS CreateBackupSelectionResponse
ReadS [CreateBackupSelectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBackupSelectionResponse]
$creadListPrec :: ReadPrec [CreateBackupSelectionResponse]
readPrec :: ReadPrec CreateBackupSelectionResponse
$creadPrec :: ReadPrec CreateBackupSelectionResponse
readList :: ReadS [CreateBackupSelectionResponse]
$creadList :: ReadS [CreateBackupSelectionResponse]
readsPrec :: Int -> ReadS CreateBackupSelectionResponse
$creadsPrec :: Int -> ReadS CreateBackupSelectionResponse
Prelude.Read, Int -> CreateBackupSelectionResponse -> ShowS
[CreateBackupSelectionResponse] -> ShowS
CreateBackupSelectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBackupSelectionResponse] -> ShowS
$cshowList :: [CreateBackupSelectionResponse] -> ShowS
show :: CreateBackupSelectionResponse -> String
$cshow :: CreateBackupSelectionResponse -> String
showsPrec :: Int -> CreateBackupSelectionResponse -> ShowS
$cshowsPrec :: Int -> CreateBackupSelectionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateBackupSelectionResponse x
-> CreateBackupSelectionResponse
forall x.
CreateBackupSelectionResponse
-> Rep CreateBackupSelectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateBackupSelectionResponse x
-> CreateBackupSelectionResponse
$cfrom :: forall x.
CreateBackupSelectionResponse
-> Rep CreateBackupSelectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBackupSelectionResponse' 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:
--
-- 'backupPlanId', 'createBackupSelectionResponse_backupPlanId' - Uniquely identifies a backup plan.
--
-- 'creationDate', 'createBackupSelectionResponse_creationDate' - The date and time a backup selection is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'selectionId', 'createBackupSelectionResponse_selectionId' - Uniquely identifies the body of a request to assign a set of resources
-- to a backup plan.
--
-- 'httpStatus', 'createBackupSelectionResponse_httpStatus' - The response's http status code.
newCreateBackupSelectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBackupSelectionResponse
newCreateBackupSelectionResponse :: Int -> CreateBackupSelectionResponse
newCreateBackupSelectionResponse Int
pHttpStatus_ =
  CreateBackupSelectionResponse'
    { $sel:backupPlanId:CreateBackupSelectionResponse' :: Maybe Text
backupPlanId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:CreateBackupSelectionResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:selectionId:CreateBackupSelectionResponse' :: Maybe Text
selectionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBackupSelectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Uniquely identifies a backup plan.
createBackupSelectionResponse_backupPlanId :: Lens.Lens' CreateBackupSelectionResponse (Prelude.Maybe Prelude.Text)
createBackupSelectionResponse_backupPlanId :: Lens' CreateBackupSelectionResponse (Maybe Text)
createBackupSelectionResponse_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupSelectionResponse' {Maybe Text
backupPlanId :: Maybe Text
$sel:backupPlanId:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Maybe Text
backupPlanId} -> Maybe Text
backupPlanId) (\s :: CreateBackupSelectionResponse
s@CreateBackupSelectionResponse' {} Maybe Text
a -> CreateBackupSelectionResponse
s {$sel:backupPlanId:CreateBackupSelectionResponse' :: Maybe Text
backupPlanId = Maybe Text
a} :: CreateBackupSelectionResponse)

-- | The date and time a backup selection is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
createBackupSelectionResponse_creationDate :: Lens.Lens' CreateBackupSelectionResponse (Prelude.Maybe Prelude.UTCTime)
createBackupSelectionResponse_creationDate :: Lens' CreateBackupSelectionResponse (Maybe UTCTime)
createBackupSelectionResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupSelectionResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: CreateBackupSelectionResponse
s@CreateBackupSelectionResponse' {} Maybe POSIX
a -> CreateBackupSelectionResponse
s {$sel:creationDate:CreateBackupSelectionResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: CreateBackupSelectionResponse) 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

-- | Uniquely identifies the body of a request to assign a set of resources
-- to a backup plan.
createBackupSelectionResponse_selectionId :: Lens.Lens' CreateBackupSelectionResponse (Prelude.Maybe Prelude.Text)
createBackupSelectionResponse_selectionId :: Lens' CreateBackupSelectionResponse (Maybe Text)
createBackupSelectionResponse_selectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupSelectionResponse' {Maybe Text
selectionId :: Maybe Text
$sel:selectionId:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Maybe Text
selectionId} -> Maybe Text
selectionId) (\s :: CreateBackupSelectionResponse
s@CreateBackupSelectionResponse' {} Maybe Text
a -> CreateBackupSelectionResponse
s {$sel:selectionId:CreateBackupSelectionResponse' :: Maybe Text
selectionId = Maybe Text
a} :: CreateBackupSelectionResponse)

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

instance Prelude.NFData CreateBackupSelectionResponse where
  rnf :: CreateBackupSelectionResponse -> ()
rnf CreateBackupSelectionResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
selectionId :: Maybe Text
creationDate :: Maybe POSIX
backupPlanId :: Maybe Text
$sel:httpStatus:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Int
$sel:selectionId:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Maybe Text
$sel:creationDate:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Maybe POSIX
$sel:backupPlanId:CreateBackupSelectionResponse' :: CreateBackupSelectionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupPlanId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
selectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus