{-# 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.SageMaker.CreateHub
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a hub.
module Amazonka.SageMaker.CreateHub
  ( -- * Creating a Request
    CreateHub (..),
    newCreateHub,

    -- * Request Lenses
    createHub_hubDisplayName,
    createHub_hubSearchKeywords,
    createHub_s3StorageConfig,
    createHub_tags,
    createHub_hubName,
    createHub_hubDescription,

    -- * Destructuring the Response
    CreateHubResponse (..),
    newCreateHubResponse,

    -- * Response Lenses
    createHubResponse_httpStatus,
    createHubResponse_hubArn,
  )
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.SageMaker.Types

-- | /See:/ 'newCreateHub' smart constructor.
data CreateHub = CreateHub'
  { -- | The display name of the hub.
    CreateHub -> Maybe Text
hubDisplayName :: Prelude.Maybe Prelude.Text,
    -- | The searchable keywords for the hub.
    CreateHub -> Maybe [Text]
hubSearchKeywords :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon S3 storage configuration for the hub.
    CreateHub -> Maybe HubS3StorageConfig
s3StorageConfig :: Prelude.Maybe HubS3StorageConfig,
    -- | Any tags to associate with the hub.
    CreateHub -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the hub to create.
    CreateHub -> Text
hubName :: Prelude.Text,
    -- | A description of the hub.
    CreateHub -> Text
hubDescription :: Prelude.Text
  }
  deriving (CreateHub -> CreateHub -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHub -> CreateHub -> Bool
$c/= :: CreateHub -> CreateHub -> Bool
== :: CreateHub -> CreateHub -> Bool
$c== :: CreateHub -> CreateHub -> Bool
Prelude.Eq, ReadPrec [CreateHub]
ReadPrec CreateHub
Int -> ReadS CreateHub
ReadS [CreateHub]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHub]
$creadListPrec :: ReadPrec [CreateHub]
readPrec :: ReadPrec CreateHub
$creadPrec :: ReadPrec CreateHub
readList :: ReadS [CreateHub]
$creadList :: ReadS [CreateHub]
readsPrec :: Int -> ReadS CreateHub
$creadsPrec :: Int -> ReadS CreateHub
Prelude.Read, Int -> CreateHub -> ShowS
[CreateHub] -> ShowS
CreateHub -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHub] -> ShowS
$cshowList :: [CreateHub] -> ShowS
show :: CreateHub -> String
$cshow :: CreateHub -> String
showsPrec :: Int -> CreateHub -> ShowS
$cshowsPrec :: Int -> CreateHub -> ShowS
Prelude.Show, forall x. Rep CreateHub x -> CreateHub
forall x. CreateHub -> Rep CreateHub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHub x -> CreateHub
$cfrom :: forall x. CreateHub -> Rep CreateHub x
Prelude.Generic)

-- |
-- Create a value of 'CreateHub' 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:
--
-- 'hubDisplayName', 'createHub_hubDisplayName' - The display name of the hub.
--
-- 'hubSearchKeywords', 'createHub_hubSearchKeywords' - The searchable keywords for the hub.
--
-- 's3StorageConfig', 'createHub_s3StorageConfig' - The Amazon S3 storage configuration for the hub.
--
-- 'tags', 'createHub_tags' - Any tags to associate with the hub.
--
-- 'hubName', 'createHub_hubName' - The name of the hub to create.
--
-- 'hubDescription', 'createHub_hubDescription' - A description of the hub.
newCreateHub ::
  -- | 'hubName'
  Prelude.Text ->
  -- | 'hubDescription'
  Prelude.Text ->
  CreateHub
newCreateHub :: Text -> Text -> CreateHub
newCreateHub Text
pHubName_ Text
pHubDescription_ =
  CreateHub'
    { $sel:hubDisplayName:CreateHub' :: Maybe Text
hubDisplayName = forall a. Maybe a
Prelude.Nothing,
      $sel:hubSearchKeywords:CreateHub' :: Maybe [Text]
hubSearchKeywords = forall a. Maybe a
Prelude.Nothing,
      $sel:s3StorageConfig:CreateHub' :: Maybe HubS3StorageConfig
s3StorageConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateHub' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:hubName:CreateHub' :: Text
hubName = Text
pHubName_,
      $sel:hubDescription:CreateHub' :: Text
hubDescription = Text
pHubDescription_
    }

-- | The display name of the hub.
createHub_hubDisplayName :: Lens.Lens' CreateHub (Prelude.Maybe Prelude.Text)
createHub_hubDisplayName :: Lens' CreateHub (Maybe Text)
createHub_hubDisplayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHub' {Maybe Text
hubDisplayName :: Maybe Text
$sel:hubDisplayName:CreateHub' :: CreateHub -> Maybe Text
hubDisplayName} -> Maybe Text
hubDisplayName) (\s :: CreateHub
s@CreateHub' {} Maybe Text
a -> CreateHub
s {$sel:hubDisplayName:CreateHub' :: Maybe Text
hubDisplayName = Maybe Text
a} :: CreateHub)

-- | The searchable keywords for the hub.
createHub_hubSearchKeywords :: Lens.Lens' CreateHub (Prelude.Maybe [Prelude.Text])
createHub_hubSearchKeywords :: Lens' CreateHub (Maybe [Text])
createHub_hubSearchKeywords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHub' {Maybe [Text]
hubSearchKeywords :: Maybe [Text]
$sel:hubSearchKeywords:CreateHub' :: CreateHub -> Maybe [Text]
hubSearchKeywords} -> Maybe [Text]
hubSearchKeywords) (\s :: CreateHub
s@CreateHub' {} Maybe [Text]
a -> CreateHub
s {$sel:hubSearchKeywords:CreateHub' :: Maybe [Text]
hubSearchKeywords = Maybe [Text]
a} :: CreateHub) 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 Amazon S3 storage configuration for the hub.
createHub_s3StorageConfig :: Lens.Lens' CreateHub (Prelude.Maybe HubS3StorageConfig)
createHub_s3StorageConfig :: Lens' CreateHub (Maybe HubS3StorageConfig)
createHub_s3StorageConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHub' {Maybe HubS3StorageConfig
s3StorageConfig :: Maybe HubS3StorageConfig
$sel:s3StorageConfig:CreateHub' :: CreateHub -> Maybe HubS3StorageConfig
s3StorageConfig} -> Maybe HubS3StorageConfig
s3StorageConfig) (\s :: CreateHub
s@CreateHub' {} Maybe HubS3StorageConfig
a -> CreateHub
s {$sel:s3StorageConfig:CreateHub' :: Maybe HubS3StorageConfig
s3StorageConfig = Maybe HubS3StorageConfig
a} :: CreateHub)

-- | Any tags to associate with the hub.
createHub_tags :: Lens.Lens' CreateHub (Prelude.Maybe [Tag])
createHub_tags :: Lens' CreateHub (Maybe [Tag])
createHub_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHub' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHub' :: CreateHub -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHub
s@CreateHub' {} Maybe [Tag]
a -> CreateHub
s {$sel:tags:CreateHub' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHub) 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 hub to create.
createHub_hubName :: Lens.Lens' CreateHub Prelude.Text
createHub_hubName :: Lens' CreateHub Text
createHub_hubName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHub' {Text
hubName :: Text
$sel:hubName:CreateHub' :: CreateHub -> Text
hubName} -> Text
hubName) (\s :: CreateHub
s@CreateHub' {} Text
a -> CreateHub
s {$sel:hubName:CreateHub' :: Text
hubName = Text
a} :: CreateHub)

-- | A description of the hub.
createHub_hubDescription :: Lens.Lens' CreateHub Prelude.Text
createHub_hubDescription :: Lens' CreateHub Text
createHub_hubDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHub' {Text
hubDescription :: Text
$sel:hubDescription:CreateHub' :: CreateHub -> Text
hubDescription} -> Text
hubDescription) (\s :: CreateHub
s@CreateHub' {} Text
a -> CreateHub
s {$sel:hubDescription:CreateHub' :: Text
hubDescription = Text
a} :: CreateHub)

instance Core.AWSRequest CreateHub where
  type AWSResponse CreateHub = CreateHubResponse
  request :: (Service -> Service) -> CreateHub -> Request CreateHub
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 CreateHub
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateHub)))
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 ->
          Int -> Text -> CreateHubResponse
CreateHubResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"HubArn")
      )

instance Prelude.Hashable CreateHub where
  hashWithSalt :: Int -> CreateHub -> Int
hashWithSalt Int
_salt CreateHub' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe HubS3StorageConfig
Text
hubDescription :: Text
hubName :: Text
tags :: Maybe [Tag]
s3StorageConfig :: Maybe HubS3StorageConfig
hubSearchKeywords :: Maybe [Text]
hubDisplayName :: Maybe Text
$sel:hubDescription:CreateHub' :: CreateHub -> Text
$sel:hubName:CreateHub' :: CreateHub -> Text
$sel:tags:CreateHub' :: CreateHub -> Maybe [Tag]
$sel:s3StorageConfig:CreateHub' :: CreateHub -> Maybe HubS3StorageConfig
$sel:hubSearchKeywords:CreateHub' :: CreateHub -> Maybe [Text]
$sel:hubDisplayName:CreateHub' :: CreateHub -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hubDisplayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
hubSearchKeywords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HubS3StorageConfig
s3StorageConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hubName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hubDescription

instance Prelude.NFData CreateHub where
  rnf :: CreateHub -> ()
rnf CreateHub' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe HubS3StorageConfig
Text
hubDescription :: Text
hubName :: Text
tags :: Maybe [Tag]
s3StorageConfig :: Maybe HubS3StorageConfig
hubSearchKeywords :: Maybe [Text]
hubDisplayName :: Maybe Text
$sel:hubDescription:CreateHub' :: CreateHub -> Text
$sel:hubName:CreateHub' :: CreateHub -> Text
$sel:tags:CreateHub' :: CreateHub -> Maybe [Tag]
$sel:s3StorageConfig:CreateHub' :: CreateHub -> Maybe HubS3StorageConfig
$sel:hubSearchKeywords:CreateHub' :: CreateHub -> Maybe [Text]
$sel:hubDisplayName:CreateHub' :: CreateHub -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hubDisplayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
hubSearchKeywords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HubS3StorageConfig
s3StorageConfig
      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
hubName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hubDescription

instance Data.ToHeaders CreateHub where
  toHeaders :: CreateHub -> 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
"SageMaker.CreateHub" :: 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 CreateHub where
  toJSON :: CreateHub -> Value
toJSON CreateHub' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe HubS3StorageConfig
Text
hubDescription :: Text
hubName :: Text
tags :: Maybe [Tag]
s3StorageConfig :: Maybe HubS3StorageConfig
hubSearchKeywords :: Maybe [Text]
hubDisplayName :: Maybe Text
$sel:hubDescription:CreateHub' :: CreateHub -> Text
$sel:hubName:CreateHub' :: CreateHub -> Text
$sel:tags:CreateHub' :: CreateHub -> Maybe [Tag]
$sel:s3StorageConfig:CreateHub' :: CreateHub -> Maybe HubS3StorageConfig
$sel:hubSearchKeywords:CreateHub' :: CreateHub -> Maybe [Text]
$sel:hubDisplayName:CreateHub' :: CreateHub -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"HubDisplayName" 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
hubDisplayName,
            (Key
"HubSearchKeywords" 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]
hubSearchKeywords,
            (Key
"S3StorageConfig" 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 HubS3StorageConfig
s3StorageConfig,
            (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
"HubName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hubName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HubDescription" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hubDescription)
          ]
      )

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

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

-- | /See:/ 'newCreateHubResponse' smart constructor.
data CreateHubResponse = CreateHubResponse'
  { -- | The response's http status code.
    CreateHubResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the hub.
    CreateHubResponse -> Text
hubArn :: Prelude.Text
  }
  deriving (CreateHubResponse -> CreateHubResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHubResponse -> CreateHubResponse -> Bool
$c/= :: CreateHubResponse -> CreateHubResponse -> Bool
== :: CreateHubResponse -> CreateHubResponse -> Bool
$c== :: CreateHubResponse -> CreateHubResponse -> Bool
Prelude.Eq, ReadPrec [CreateHubResponse]
ReadPrec CreateHubResponse
Int -> ReadS CreateHubResponse
ReadS [CreateHubResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHubResponse]
$creadListPrec :: ReadPrec [CreateHubResponse]
readPrec :: ReadPrec CreateHubResponse
$creadPrec :: ReadPrec CreateHubResponse
readList :: ReadS [CreateHubResponse]
$creadList :: ReadS [CreateHubResponse]
readsPrec :: Int -> ReadS CreateHubResponse
$creadsPrec :: Int -> ReadS CreateHubResponse
Prelude.Read, Int -> CreateHubResponse -> ShowS
[CreateHubResponse] -> ShowS
CreateHubResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHubResponse] -> ShowS
$cshowList :: [CreateHubResponse] -> ShowS
show :: CreateHubResponse -> String
$cshow :: CreateHubResponse -> String
showsPrec :: Int -> CreateHubResponse -> ShowS
$cshowsPrec :: Int -> CreateHubResponse -> ShowS
Prelude.Show, forall x. Rep CreateHubResponse x -> CreateHubResponse
forall x. CreateHubResponse -> Rep CreateHubResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHubResponse x -> CreateHubResponse
$cfrom :: forall x. CreateHubResponse -> Rep CreateHubResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateHubResponse' 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:
--
-- 'httpStatus', 'createHubResponse_httpStatus' - The response's http status code.
--
-- 'hubArn', 'createHubResponse_hubArn' - The Amazon Resource Name (ARN) of the hub.
newCreateHubResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'hubArn'
  Prelude.Text ->
  CreateHubResponse
newCreateHubResponse :: Int -> Text -> CreateHubResponse
newCreateHubResponse Int
pHttpStatus_ Text
pHubArn_ =
  CreateHubResponse'
    { $sel:httpStatus:CreateHubResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:hubArn:CreateHubResponse' :: Text
hubArn = Text
pHubArn_
    }

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

-- | The Amazon Resource Name (ARN) of the hub.
createHubResponse_hubArn :: Lens.Lens' CreateHubResponse Prelude.Text
createHubResponse_hubArn :: Lens' CreateHubResponse Text
createHubResponse_hubArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHubResponse' {Text
hubArn :: Text
$sel:hubArn:CreateHubResponse' :: CreateHubResponse -> Text
hubArn} -> Text
hubArn) (\s :: CreateHubResponse
s@CreateHubResponse' {} Text
a -> CreateHubResponse
s {$sel:hubArn:CreateHubResponse' :: Text
hubArn = Text
a} :: CreateHubResponse)

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