{-# 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.Route53RecoveryReadiness.CreateCell
-- 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 cell in an account.
module Amazonka.Route53RecoveryReadiness.CreateCell
  ( -- * Creating a Request
    CreateCell (..),
    newCreateCell,

    -- * Request Lenses
    createCell_cells,
    createCell_tags,
    createCell_cellName,

    -- * Destructuring the Response
    CreateCellResponse (..),
    newCreateCellResponse,

    -- * Response Lenses
    createCellResponse_cellArn,
    createCellResponse_cellName,
    createCellResponse_cells,
    createCellResponse_parentReadinessScopes,
    createCellResponse_tags,
    createCellResponse_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.Route53RecoveryReadiness.Types

-- | /See:/ 'newCreateCell' smart constructor.
data CreateCell = CreateCell'
  { -- | A list of cell Amazon Resource Names (ARNs) contained within this cell,
    -- for use in nested cells. For example, Availability Zones within specific
    -- Amazon Web Services Regions.
    CreateCell -> Maybe [Text]
cells :: Prelude.Maybe [Prelude.Text],
    CreateCell -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the cell to create.
    CreateCell -> Text
cellName :: Prelude.Text
  }
  deriving (CreateCell -> CreateCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCell -> CreateCell -> Bool
$c/= :: CreateCell -> CreateCell -> Bool
== :: CreateCell -> CreateCell -> Bool
$c== :: CreateCell -> CreateCell -> Bool
Prelude.Eq, ReadPrec [CreateCell]
ReadPrec CreateCell
Int -> ReadS CreateCell
ReadS [CreateCell]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCell]
$creadListPrec :: ReadPrec [CreateCell]
readPrec :: ReadPrec CreateCell
$creadPrec :: ReadPrec CreateCell
readList :: ReadS [CreateCell]
$creadList :: ReadS [CreateCell]
readsPrec :: Int -> ReadS CreateCell
$creadsPrec :: Int -> ReadS CreateCell
Prelude.Read, Int -> CreateCell -> ShowS
[CreateCell] -> ShowS
CreateCell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCell] -> ShowS
$cshowList :: [CreateCell] -> ShowS
show :: CreateCell -> String
$cshow :: CreateCell -> String
showsPrec :: Int -> CreateCell -> ShowS
$cshowsPrec :: Int -> CreateCell -> ShowS
Prelude.Show, forall x. Rep CreateCell x -> CreateCell
forall x. CreateCell -> Rep CreateCell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCell x -> CreateCell
$cfrom :: forall x. CreateCell -> Rep CreateCell x
Prelude.Generic)

-- |
-- Create a value of 'CreateCell' 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:
--
-- 'cells', 'createCell_cells' - A list of cell Amazon Resource Names (ARNs) contained within this cell,
-- for use in nested cells. For example, Availability Zones within specific
-- Amazon Web Services Regions.
--
-- 'tags', 'createCell_tags' - Undocumented member.
--
-- 'cellName', 'createCell_cellName' - The name of the cell to create.
newCreateCell ::
  -- | 'cellName'
  Prelude.Text ->
  CreateCell
newCreateCell :: Text -> CreateCell
newCreateCell Text
pCellName_ =
  CreateCell'
    { $sel:cells:CreateCell' :: Maybe [Text]
cells = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateCell' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:cellName:CreateCell' :: Text
cellName = Text
pCellName_
    }

-- | A list of cell Amazon Resource Names (ARNs) contained within this cell,
-- for use in nested cells. For example, Availability Zones within specific
-- Amazon Web Services Regions.
createCell_cells :: Lens.Lens' CreateCell (Prelude.Maybe [Prelude.Text])
createCell_cells :: Lens' CreateCell (Maybe [Text])
createCell_cells = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCell' {Maybe [Text]
cells :: Maybe [Text]
$sel:cells:CreateCell' :: CreateCell -> Maybe [Text]
cells} -> Maybe [Text]
cells) (\s :: CreateCell
s@CreateCell' {} Maybe [Text]
a -> CreateCell
s {$sel:cells:CreateCell' :: Maybe [Text]
cells = Maybe [Text]
a} :: CreateCell) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
createCell_tags :: Lens.Lens' CreateCell (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createCell_tags :: Lens' CreateCell (Maybe (HashMap Text Text))
createCell_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCell' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateCell' :: CreateCell -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateCell
s@CreateCell' {} Maybe (HashMap Text Text)
a -> CreateCell
s {$sel:tags:CreateCell' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateCell) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the cell to create.
createCell_cellName :: Lens.Lens' CreateCell Prelude.Text
createCell_cellName :: Lens' CreateCell Text
createCell_cellName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCell' {Text
cellName :: Text
$sel:cellName:CreateCell' :: CreateCell -> Text
cellName} -> Text
cellName) (\s :: CreateCell
s@CreateCell' {} Text
a -> CreateCell
s {$sel:cellName:CreateCell' :: Text
cellName = Text
a} :: CreateCell)

instance Core.AWSRequest CreateCell where
  type AWSResponse CreateCell = CreateCellResponse
  request :: (Service -> Service) -> CreateCell -> Request CreateCell
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 CreateCell
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateCell)))
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 Text
-> Maybe [Text]
-> Maybe [Text]
-> Maybe (HashMap Text Text)
-> Int
-> CreateCellResponse
CreateCellResponse'
            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
"cellArn")
            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
"cellName")
            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
"cells" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"parentReadinessScopes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreateCell where
  hashWithSalt :: Int -> CreateCell -> Int
hashWithSalt Int
_salt CreateCell' {Maybe [Text]
Maybe (HashMap Text Text)
Text
cellName :: Text
tags :: Maybe (HashMap Text Text)
cells :: Maybe [Text]
$sel:cellName:CreateCell' :: CreateCell -> Text
$sel:tags:CreateCell' :: CreateCell -> Maybe (HashMap Text Text)
$sel:cells:CreateCell' :: CreateCell -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
cells
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cellName

instance Prelude.NFData CreateCell where
  rnf :: CreateCell -> ()
rnf CreateCell' {Maybe [Text]
Maybe (HashMap Text Text)
Text
cellName :: Text
tags :: Maybe (HashMap Text Text)
cells :: Maybe [Text]
$sel:cellName:CreateCell' :: CreateCell -> Text
$sel:tags:CreateCell' :: CreateCell -> Maybe (HashMap Text Text)
$sel:cells:CreateCell' :: CreateCell -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
cells
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cellName

instance Data.ToHeaders CreateCell where
  toHeaders :: CreateCell -> 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 CreateCell where
  toJSON :: CreateCell -> Value
toJSON CreateCell' {Maybe [Text]
Maybe (HashMap Text Text)
Text
cellName :: Text
tags :: Maybe (HashMap Text Text)
cells :: Maybe [Text]
$sel:cellName:CreateCell' :: CreateCell -> Text
$sel:tags:CreateCell' :: CreateCell -> Maybe (HashMap Text Text)
$sel:cells:CreateCell' :: CreateCell -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cells" 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]
cells,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"cellName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
cellName)
          ]
      )

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

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

-- | /See:/ 'newCreateCellResponse' smart constructor.
data CreateCellResponse = CreateCellResponse'
  { -- | The Amazon Resource Name (ARN) for the cell.
    CreateCellResponse -> Maybe Text
cellArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the cell.
    CreateCellResponse -> Maybe Text
cellName :: Prelude.Maybe Prelude.Text,
    -- | A list of cell ARNs.
    CreateCellResponse -> Maybe [Text]
cells :: Prelude.Maybe [Prelude.Text],
    -- | The readiness scope for the cell, which can be a cell Amazon Resource
    -- Name (ARN) or a recovery group ARN. This is a list but currently can
    -- have only one element.
    CreateCellResponse -> Maybe [Text]
parentReadinessScopes :: Prelude.Maybe [Prelude.Text],
    -- | Tags on the resources.
    CreateCellResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateCellResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCellResponse -> CreateCellResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCellResponse -> CreateCellResponse -> Bool
$c/= :: CreateCellResponse -> CreateCellResponse -> Bool
== :: CreateCellResponse -> CreateCellResponse -> Bool
$c== :: CreateCellResponse -> CreateCellResponse -> Bool
Prelude.Eq, ReadPrec [CreateCellResponse]
ReadPrec CreateCellResponse
Int -> ReadS CreateCellResponse
ReadS [CreateCellResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCellResponse]
$creadListPrec :: ReadPrec [CreateCellResponse]
readPrec :: ReadPrec CreateCellResponse
$creadPrec :: ReadPrec CreateCellResponse
readList :: ReadS [CreateCellResponse]
$creadList :: ReadS [CreateCellResponse]
readsPrec :: Int -> ReadS CreateCellResponse
$creadsPrec :: Int -> ReadS CreateCellResponse
Prelude.Read, Int -> CreateCellResponse -> ShowS
[CreateCellResponse] -> ShowS
CreateCellResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCellResponse] -> ShowS
$cshowList :: [CreateCellResponse] -> ShowS
show :: CreateCellResponse -> String
$cshow :: CreateCellResponse -> String
showsPrec :: Int -> CreateCellResponse -> ShowS
$cshowsPrec :: Int -> CreateCellResponse -> ShowS
Prelude.Show, forall x. Rep CreateCellResponse x -> CreateCellResponse
forall x. CreateCellResponse -> Rep CreateCellResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCellResponse x -> CreateCellResponse
$cfrom :: forall x. CreateCellResponse -> Rep CreateCellResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCellResponse' 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:
--
-- 'cellArn', 'createCellResponse_cellArn' - The Amazon Resource Name (ARN) for the cell.
--
-- 'cellName', 'createCellResponse_cellName' - The name of the cell.
--
-- 'cells', 'createCellResponse_cells' - A list of cell ARNs.
--
-- 'parentReadinessScopes', 'createCellResponse_parentReadinessScopes' - The readiness scope for the cell, which can be a cell Amazon Resource
-- Name (ARN) or a recovery group ARN. This is a list but currently can
-- have only one element.
--
-- 'tags', 'createCellResponse_tags' - Tags on the resources.
--
-- 'httpStatus', 'createCellResponse_httpStatus' - The response's http status code.
newCreateCellResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCellResponse
newCreateCellResponse :: Int -> CreateCellResponse
newCreateCellResponse Int
pHttpStatus_ =
  CreateCellResponse'
    { $sel:cellArn:CreateCellResponse' :: Maybe Text
cellArn = forall a. Maybe a
Prelude.Nothing,
      $sel:cellName:CreateCellResponse' :: Maybe Text
cellName = forall a. Maybe a
Prelude.Nothing,
      $sel:cells:CreateCellResponse' :: Maybe [Text]
cells = forall a. Maybe a
Prelude.Nothing,
      $sel:parentReadinessScopes:CreateCellResponse' :: Maybe [Text]
parentReadinessScopes = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateCellResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCellResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) for the cell.
createCellResponse_cellArn :: Lens.Lens' CreateCellResponse (Prelude.Maybe Prelude.Text)
createCellResponse_cellArn :: Lens' CreateCellResponse (Maybe Text)
createCellResponse_cellArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCellResponse' {Maybe Text
cellArn :: Maybe Text
$sel:cellArn:CreateCellResponse' :: CreateCellResponse -> Maybe Text
cellArn} -> Maybe Text
cellArn) (\s :: CreateCellResponse
s@CreateCellResponse' {} Maybe Text
a -> CreateCellResponse
s {$sel:cellArn:CreateCellResponse' :: Maybe Text
cellArn = Maybe Text
a} :: CreateCellResponse)

-- | The name of the cell.
createCellResponse_cellName :: Lens.Lens' CreateCellResponse (Prelude.Maybe Prelude.Text)
createCellResponse_cellName :: Lens' CreateCellResponse (Maybe Text)
createCellResponse_cellName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCellResponse' {Maybe Text
cellName :: Maybe Text
$sel:cellName:CreateCellResponse' :: CreateCellResponse -> Maybe Text
cellName} -> Maybe Text
cellName) (\s :: CreateCellResponse
s@CreateCellResponse' {} Maybe Text
a -> CreateCellResponse
s {$sel:cellName:CreateCellResponse' :: Maybe Text
cellName = Maybe Text
a} :: CreateCellResponse)

-- | A list of cell ARNs.
createCellResponse_cells :: Lens.Lens' CreateCellResponse (Prelude.Maybe [Prelude.Text])
createCellResponse_cells :: Lens' CreateCellResponse (Maybe [Text])
createCellResponse_cells = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCellResponse' {Maybe [Text]
cells :: Maybe [Text]
$sel:cells:CreateCellResponse' :: CreateCellResponse -> Maybe [Text]
cells} -> Maybe [Text]
cells) (\s :: CreateCellResponse
s@CreateCellResponse' {} Maybe [Text]
a -> CreateCellResponse
s {$sel:cells:CreateCellResponse' :: Maybe [Text]
cells = Maybe [Text]
a} :: CreateCellResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The readiness scope for the cell, which can be a cell Amazon Resource
-- Name (ARN) or a recovery group ARN. This is a list but currently can
-- have only one element.
createCellResponse_parentReadinessScopes :: Lens.Lens' CreateCellResponse (Prelude.Maybe [Prelude.Text])
createCellResponse_parentReadinessScopes :: Lens' CreateCellResponse (Maybe [Text])
createCellResponse_parentReadinessScopes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCellResponse' {Maybe [Text]
parentReadinessScopes :: Maybe [Text]
$sel:parentReadinessScopes:CreateCellResponse' :: CreateCellResponse -> Maybe [Text]
parentReadinessScopes} -> Maybe [Text]
parentReadinessScopes) (\s :: CreateCellResponse
s@CreateCellResponse' {} Maybe [Text]
a -> CreateCellResponse
s {$sel:parentReadinessScopes:CreateCellResponse' :: Maybe [Text]
parentReadinessScopes = Maybe [Text]
a} :: CreateCellResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Tags on the resources.
createCellResponse_tags :: Lens.Lens' CreateCellResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createCellResponse_tags :: Lens' CreateCellResponse (Maybe (HashMap Text Text))
createCellResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCellResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateCellResponse' :: CreateCellResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateCellResponse
s@CreateCellResponse' {} Maybe (HashMap Text Text)
a -> CreateCellResponse
s {$sel:tags:CreateCellResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateCellResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData CreateCellResponse where
  rnf :: CreateCellResponse -> ()
rnf CreateCellResponse' {Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
parentReadinessScopes :: Maybe [Text]
cells :: Maybe [Text]
cellName :: Maybe Text
cellArn :: Maybe Text
$sel:httpStatus:CreateCellResponse' :: CreateCellResponse -> Int
$sel:tags:CreateCellResponse' :: CreateCellResponse -> Maybe (HashMap Text Text)
$sel:parentReadinessScopes:CreateCellResponse' :: CreateCellResponse -> Maybe [Text]
$sel:cells:CreateCellResponse' :: CreateCellResponse -> Maybe [Text]
$sel:cellName:CreateCellResponse' :: CreateCellResponse -> Maybe Text
$sel:cellArn:CreateCellResponse' :: CreateCellResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cellArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cellName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
cells
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
parentReadinessScopes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus