{-# 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.Route53AutoNaming.CreateHttpNamespace
-- 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 HTTP namespace. Service instances registered using an HTTP
-- namespace can be discovered using a @DiscoverInstances@ request but
-- can\'t be discovered using DNS.
--
-- For the current quota on the number of namespaces that you can create
-- using the same Amazon Web Services account, see
-- <https://docs.aws.amazon.com/cloud-map/latest/dg/cloud-map-limits.html Cloud Map quotas>
-- in the /Cloud Map Developer Guide/.
module Amazonka.Route53AutoNaming.CreateHttpNamespace
  ( -- * Creating a Request
    CreateHttpNamespace (..),
    newCreateHttpNamespace,

    -- * Request Lenses
    createHttpNamespace_creatorRequestId,
    createHttpNamespace_description,
    createHttpNamespace_tags,
    createHttpNamespace_name,

    -- * Destructuring the Response
    CreateHttpNamespaceResponse (..),
    newCreateHttpNamespaceResponse,

    -- * Response Lenses
    createHttpNamespaceResponse_operationId,
    createHttpNamespaceResponse_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.Route53AutoNaming.Types

-- | /See:/ 'newCreateHttpNamespace' smart constructor.
data CreateHttpNamespace = CreateHttpNamespace'
  { -- | A unique string that identifies the request and that allows failed
    -- @CreateHttpNamespace@ requests to be retried without the risk of running
    -- the operation twice. @CreatorRequestId@ can be any unique string (for
    -- example, a date\/time stamp).
    CreateHttpNamespace -> Maybe Text
creatorRequestId :: Prelude.Maybe Prelude.Text,
    -- | A description for the namespace.
    CreateHttpNamespace -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags to add to the namespace. Each tag consists of a key and an
    -- optional value that you define. Tags keys can be up to 128 characters in
    -- length, and tag values can be up to 256 characters in length.
    CreateHttpNamespace -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name that you want to assign to this namespace.
    CreateHttpNamespace -> Text
name :: Prelude.Text
  }
  deriving (CreateHttpNamespace -> CreateHttpNamespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHttpNamespace -> CreateHttpNamespace -> Bool
$c/= :: CreateHttpNamespace -> CreateHttpNamespace -> Bool
== :: CreateHttpNamespace -> CreateHttpNamespace -> Bool
$c== :: CreateHttpNamespace -> CreateHttpNamespace -> Bool
Prelude.Eq, ReadPrec [CreateHttpNamespace]
ReadPrec CreateHttpNamespace
Int -> ReadS CreateHttpNamespace
ReadS [CreateHttpNamespace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHttpNamespace]
$creadListPrec :: ReadPrec [CreateHttpNamespace]
readPrec :: ReadPrec CreateHttpNamespace
$creadPrec :: ReadPrec CreateHttpNamespace
readList :: ReadS [CreateHttpNamespace]
$creadList :: ReadS [CreateHttpNamespace]
readsPrec :: Int -> ReadS CreateHttpNamespace
$creadsPrec :: Int -> ReadS CreateHttpNamespace
Prelude.Read, Int -> CreateHttpNamespace -> ShowS
[CreateHttpNamespace] -> ShowS
CreateHttpNamespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHttpNamespace] -> ShowS
$cshowList :: [CreateHttpNamespace] -> ShowS
show :: CreateHttpNamespace -> String
$cshow :: CreateHttpNamespace -> String
showsPrec :: Int -> CreateHttpNamespace -> ShowS
$cshowsPrec :: Int -> CreateHttpNamespace -> ShowS
Prelude.Show, forall x. Rep CreateHttpNamespace x -> CreateHttpNamespace
forall x. CreateHttpNamespace -> Rep CreateHttpNamespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHttpNamespace x -> CreateHttpNamespace
$cfrom :: forall x. CreateHttpNamespace -> Rep CreateHttpNamespace x
Prelude.Generic)

-- |
-- Create a value of 'CreateHttpNamespace' 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', 'createHttpNamespace_creatorRequestId' - A unique string that identifies the request and that allows failed
-- @CreateHttpNamespace@ requests to be retried without the risk of running
-- the operation twice. @CreatorRequestId@ can be any unique string (for
-- example, a date\/time stamp).
--
-- 'description', 'createHttpNamespace_description' - A description for the namespace.
--
-- 'tags', 'createHttpNamespace_tags' - The tags to add to the namespace. Each tag consists of a key and an
-- optional value that you define. Tags keys can be up to 128 characters in
-- length, and tag values can be up to 256 characters in length.
--
-- 'name', 'createHttpNamespace_name' - The name that you want to assign to this namespace.
newCreateHttpNamespace ::
  -- | 'name'
  Prelude.Text ->
  CreateHttpNamespace
newCreateHttpNamespace :: Text -> CreateHttpNamespace
newCreateHttpNamespace Text
pName_ =
  CreateHttpNamespace'
    { $sel:creatorRequestId:CreateHttpNamespace' :: Maybe Text
creatorRequestId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateHttpNamespace' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateHttpNamespace' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateHttpNamespace' :: Text
name = Text
pName_
    }

-- | A unique string that identifies the request and that allows failed
-- @CreateHttpNamespace@ requests to be retried without the risk of running
-- the operation twice. @CreatorRequestId@ can be any unique string (for
-- example, a date\/time stamp).
createHttpNamespace_creatorRequestId :: Lens.Lens' CreateHttpNamespace (Prelude.Maybe Prelude.Text)
createHttpNamespace_creatorRequestId :: Lens' CreateHttpNamespace (Maybe Text)
createHttpNamespace_creatorRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHttpNamespace' {Maybe Text
creatorRequestId :: Maybe Text
$sel:creatorRequestId:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe Text
creatorRequestId} -> Maybe Text
creatorRequestId) (\s :: CreateHttpNamespace
s@CreateHttpNamespace' {} Maybe Text
a -> CreateHttpNamespace
s {$sel:creatorRequestId:CreateHttpNamespace' :: Maybe Text
creatorRequestId = Maybe Text
a} :: CreateHttpNamespace)

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

-- | The tags to add to the namespace. Each tag consists of a key and an
-- optional value that you define. Tags keys can be up to 128 characters in
-- length, and tag values can be up to 256 characters in length.
createHttpNamespace_tags :: Lens.Lens' CreateHttpNamespace (Prelude.Maybe [Tag])
createHttpNamespace_tags :: Lens' CreateHttpNamespace (Maybe [Tag])
createHttpNamespace_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHttpNamespace' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHttpNamespace
s@CreateHttpNamespace' {} Maybe [Tag]
a -> CreateHttpNamespace
s {$sel:tags:CreateHttpNamespace' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHttpNamespace) 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 that you want to assign to this namespace.
createHttpNamespace_name :: Lens.Lens' CreateHttpNamespace Prelude.Text
createHttpNamespace_name :: Lens' CreateHttpNamespace Text
createHttpNamespace_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHttpNamespace' {Text
name :: Text
$sel:name:CreateHttpNamespace' :: CreateHttpNamespace -> Text
name} -> Text
name) (\s :: CreateHttpNamespace
s@CreateHttpNamespace' {} Text
a -> CreateHttpNamespace
s {$sel:name:CreateHttpNamespace' :: Text
name = Text
a} :: CreateHttpNamespace)

instance Core.AWSRequest CreateHttpNamespace where
  type
    AWSResponse CreateHttpNamespace =
      CreateHttpNamespaceResponse
  request :: (Service -> Service)
-> CreateHttpNamespace -> Request CreateHttpNamespace
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 CreateHttpNamespace
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateHttpNamespace)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateHttpNamespaceResponse
CreateHttpNamespaceResponse'
            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
"OperationId")
            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 CreateHttpNamespace where
  hashWithSalt :: Int -> CreateHttpNamespace -> Int
hashWithSalt Int
_salt CreateHttpNamespace' {Maybe [Tag]
Maybe Text
Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
creatorRequestId :: Maybe Text
$sel:name:CreateHttpNamespace' :: CreateHttpNamespace -> Text
$sel:tags:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe [Tag]
$sel:description:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe Text
$sel:creatorRequestId:CreateHttpNamespace' :: CreateHttpNamespace -> 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` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateHttpNamespace where
  rnf :: CreateHttpNamespace -> ()
rnf CreateHttpNamespace' {Maybe [Tag]
Maybe Text
Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
creatorRequestId :: Maybe Text
$sel:name:CreateHttpNamespace' :: CreateHttpNamespace -> Text
$sel:tags:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe [Tag]
$sel:description:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe Text
$sel:creatorRequestId:CreateHttpNamespace' :: CreateHttpNamespace -> 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 Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateHttpNamespace where
  toHeaders :: CreateHttpNamespace -> 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
"Route53AutoNaming_v20170314.CreateHttpNamespace" ::
                          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 CreateHttpNamespace where
  toJSON :: CreateHttpNamespace -> Value
toJSON CreateHttpNamespace' {Maybe [Tag]
Maybe Text
Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
creatorRequestId :: Maybe Text
$sel:name:CreateHttpNamespace' :: CreateHttpNamespace -> Text
$sel:tags:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe [Tag]
$sel:description:CreateHttpNamespace' :: CreateHttpNamespace -> Maybe Text
$sel:creatorRequestId:CreateHttpNamespace' :: CreateHttpNamespace -> 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,
            (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
"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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateHttpNamespaceResponse' smart constructor.
data CreateHttpNamespaceResponse = CreateHttpNamespaceResponse'
  { -- | A value that you can use to determine whether the request completed
    -- successfully. To get the status of the operation, see
    -- <https://docs.aws.amazon.com/cloud-map/latest/api/API_GetOperation.html GetOperation>.
    CreateHttpNamespaceResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateHttpNamespaceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateHttpNamespaceResponse -> CreateHttpNamespaceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHttpNamespaceResponse -> CreateHttpNamespaceResponse -> Bool
$c/= :: CreateHttpNamespaceResponse -> CreateHttpNamespaceResponse -> Bool
== :: CreateHttpNamespaceResponse -> CreateHttpNamespaceResponse -> Bool
$c== :: CreateHttpNamespaceResponse -> CreateHttpNamespaceResponse -> Bool
Prelude.Eq, ReadPrec [CreateHttpNamespaceResponse]
ReadPrec CreateHttpNamespaceResponse
Int -> ReadS CreateHttpNamespaceResponse
ReadS [CreateHttpNamespaceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHttpNamespaceResponse]
$creadListPrec :: ReadPrec [CreateHttpNamespaceResponse]
readPrec :: ReadPrec CreateHttpNamespaceResponse
$creadPrec :: ReadPrec CreateHttpNamespaceResponse
readList :: ReadS [CreateHttpNamespaceResponse]
$creadList :: ReadS [CreateHttpNamespaceResponse]
readsPrec :: Int -> ReadS CreateHttpNamespaceResponse
$creadsPrec :: Int -> ReadS CreateHttpNamespaceResponse
Prelude.Read, Int -> CreateHttpNamespaceResponse -> ShowS
[CreateHttpNamespaceResponse] -> ShowS
CreateHttpNamespaceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHttpNamespaceResponse] -> ShowS
$cshowList :: [CreateHttpNamespaceResponse] -> ShowS
show :: CreateHttpNamespaceResponse -> String
$cshow :: CreateHttpNamespaceResponse -> String
showsPrec :: Int -> CreateHttpNamespaceResponse -> ShowS
$cshowsPrec :: Int -> CreateHttpNamespaceResponse -> ShowS
Prelude.Show, forall x.
Rep CreateHttpNamespaceResponse x -> CreateHttpNamespaceResponse
forall x.
CreateHttpNamespaceResponse -> Rep CreateHttpNamespaceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateHttpNamespaceResponse x -> CreateHttpNamespaceResponse
$cfrom :: forall x.
CreateHttpNamespaceResponse -> Rep CreateHttpNamespaceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateHttpNamespaceResponse' 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:
--
-- 'operationId', 'createHttpNamespaceResponse_operationId' - A value that you can use to determine whether the request completed
-- successfully. To get the status of the operation, see
-- <https://docs.aws.amazon.com/cloud-map/latest/api/API_GetOperation.html GetOperation>.
--
-- 'httpStatus', 'createHttpNamespaceResponse_httpStatus' - The response's http status code.
newCreateHttpNamespaceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateHttpNamespaceResponse
newCreateHttpNamespaceResponse :: Int -> CreateHttpNamespaceResponse
newCreateHttpNamespaceResponse Int
pHttpStatus_ =
  CreateHttpNamespaceResponse'
    { $sel:operationId:CreateHttpNamespaceResponse' :: Maybe Text
operationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateHttpNamespaceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A value that you can use to determine whether the request completed
-- successfully. To get the status of the operation, see
-- <https://docs.aws.amazon.com/cloud-map/latest/api/API_GetOperation.html GetOperation>.
createHttpNamespaceResponse_operationId :: Lens.Lens' CreateHttpNamespaceResponse (Prelude.Maybe Prelude.Text)
createHttpNamespaceResponse_operationId :: Lens' CreateHttpNamespaceResponse (Maybe Text)
createHttpNamespaceResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHttpNamespaceResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:CreateHttpNamespaceResponse' :: CreateHttpNamespaceResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: CreateHttpNamespaceResponse
s@CreateHttpNamespaceResponse' {} Maybe Text
a -> CreateHttpNamespaceResponse
s {$sel:operationId:CreateHttpNamespaceResponse' :: Maybe Text
operationId = Maybe Text
a} :: CreateHttpNamespaceResponse)

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

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