{-# 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.CodeStarConnections.CreateHost
-- 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 resource that represents the infrastructure where a
-- third-party provider is installed. The host is used when you create
-- connections to an installed third-party provider type, such as GitHub
-- Enterprise Server. You create one host for all connections to that
-- provider.
--
-- A host created through the CLI or the SDK is in \`PENDING\` status by
-- default. You can make its status \`AVAILABLE\` by setting up the host in
-- the console.
module Amazonka.CodeStarConnections.CreateHost
  ( -- * Creating a Request
    CreateHost (..),
    newCreateHost,

    -- * Request Lenses
    createHost_tags,
    createHost_vpcConfiguration,
    createHost_name,
    createHost_providerType,
    createHost_providerEndpoint,

    -- * Destructuring the Response
    CreateHostResponse (..),
    newCreateHostResponse,

    -- * Response Lenses
    createHostResponse_hostArn,
    createHostResponse_tags,
    createHostResponse_httpStatus,
  )
where

import Amazonka.CodeStarConnections.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:/ 'newCreateHost' smart constructor.
data CreateHost = CreateHost'
  { CreateHost -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The VPC configuration to be provisioned for the host. A VPC must be
    -- configured and the infrastructure to be represented by the host must
    -- already be connected to the VPC.
    CreateHost -> Maybe VpcConfiguration
vpcConfiguration :: Prelude.Maybe VpcConfiguration,
    -- | The name of the host to be created. The name must be unique in the
    -- calling AWS account.
    CreateHost -> Text
name :: Prelude.Text,
    -- | The name of the installed provider to be associated with your
    -- connection. The host resource represents the infrastructure where your
    -- provider type is installed. The valid provider type is GitHub Enterprise
    -- Server.
    CreateHost -> ProviderType
providerType :: ProviderType,
    -- | The endpoint of the infrastructure to be represented by the host after
    -- it is created.
    CreateHost -> Text
providerEndpoint :: Prelude.Text
  }
  deriving (CreateHost -> CreateHost -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHost -> CreateHost -> Bool
$c/= :: CreateHost -> CreateHost -> Bool
== :: CreateHost -> CreateHost -> Bool
$c== :: CreateHost -> CreateHost -> Bool
Prelude.Eq, ReadPrec [CreateHost]
ReadPrec CreateHost
Int -> ReadS CreateHost
ReadS [CreateHost]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHost]
$creadListPrec :: ReadPrec [CreateHost]
readPrec :: ReadPrec CreateHost
$creadPrec :: ReadPrec CreateHost
readList :: ReadS [CreateHost]
$creadList :: ReadS [CreateHost]
readsPrec :: Int -> ReadS CreateHost
$creadsPrec :: Int -> ReadS CreateHost
Prelude.Read, Int -> CreateHost -> ShowS
[CreateHost] -> ShowS
CreateHost -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHost] -> ShowS
$cshowList :: [CreateHost] -> ShowS
show :: CreateHost -> String
$cshow :: CreateHost -> String
showsPrec :: Int -> CreateHost -> ShowS
$cshowsPrec :: Int -> CreateHost -> ShowS
Prelude.Show, forall x. Rep CreateHost x -> CreateHost
forall x. CreateHost -> Rep CreateHost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHost x -> CreateHost
$cfrom :: forall x. CreateHost -> Rep CreateHost x
Prelude.Generic)

-- |
-- Create a value of 'CreateHost' 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:
--
-- 'tags', 'createHost_tags' - Undocumented member.
--
-- 'vpcConfiguration', 'createHost_vpcConfiguration' - The VPC configuration to be provisioned for the host. A VPC must be
-- configured and the infrastructure to be represented by the host must
-- already be connected to the VPC.
--
-- 'name', 'createHost_name' - The name of the host to be created. The name must be unique in the
-- calling AWS account.
--
-- 'providerType', 'createHost_providerType' - The name of the installed provider to be associated with your
-- connection. The host resource represents the infrastructure where your
-- provider type is installed. The valid provider type is GitHub Enterprise
-- Server.
--
-- 'providerEndpoint', 'createHost_providerEndpoint' - The endpoint of the infrastructure to be represented by the host after
-- it is created.
newCreateHost ::
  -- | 'name'
  Prelude.Text ->
  -- | 'providerType'
  ProviderType ->
  -- | 'providerEndpoint'
  Prelude.Text ->
  CreateHost
newCreateHost :: Text -> ProviderType -> Text -> CreateHost
newCreateHost
  Text
pName_
  ProviderType
pProviderType_
  Text
pProviderEndpoint_ =
    CreateHost'
      { $sel:tags:CreateHost' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfiguration:CreateHost' :: Maybe VpcConfiguration
vpcConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateHost' :: Text
name = Text
pName_,
        $sel:providerType:CreateHost' :: ProviderType
providerType = ProviderType
pProviderType_,
        $sel:providerEndpoint:CreateHost' :: Text
providerEndpoint = Text
pProviderEndpoint_
      }

-- | Undocumented member.
createHost_tags :: Lens.Lens' CreateHost (Prelude.Maybe [Tag])
createHost_tags :: Lens' CreateHost (Maybe [Tag])
createHost_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHost' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHost' :: CreateHost -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHost
s@CreateHost' {} Maybe [Tag]
a -> CreateHost
s {$sel:tags:CreateHost' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHost) 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 VPC configuration to be provisioned for the host. A VPC must be
-- configured and the infrastructure to be represented by the host must
-- already be connected to the VPC.
createHost_vpcConfiguration :: Lens.Lens' CreateHost (Prelude.Maybe VpcConfiguration)
createHost_vpcConfiguration :: Lens' CreateHost (Maybe VpcConfiguration)
createHost_vpcConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHost' {Maybe VpcConfiguration
vpcConfiguration :: Maybe VpcConfiguration
$sel:vpcConfiguration:CreateHost' :: CreateHost -> Maybe VpcConfiguration
vpcConfiguration} -> Maybe VpcConfiguration
vpcConfiguration) (\s :: CreateHost
s@CreateHost' {} Maybe VpcConfiguration
a -> CreateHost
s {$sel:vpcConfiguration:CreateHost' :: Maybe VpcConfiguration
vpcConfiguration = Maybe VpcConfiguration
a} :: CreateHost)

-- | The name of the host to be created. The name must be unique in the
-- calling AWS account.
createHost_name :: Lens.Lens' CreateHost Prelude.Text
createHost_name :: Lens' CreateHost Text
createHost_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHost' {Text
name :: Text
$sel:name:CreateHost' :: CreateHost -> Text
name} -> Text
name) (\s :: CreateHost
s@CreateHost' {} Text
a -> CreateHost
s {$sel:name:CreateHost' :: Text
name = Text
a} :: CreateHost)

-- | The name of the installed provider to be associated with your
-- connection. The host resource represents the infrastructure where your
-- provider type is installed. The valid provider type is GitHub Enterprise
-- Server.
createHost_providerType :: Lens.Lens' CreateHost ProviderType
createHost_providerType :: Lens' CreateHost ProviderType
createHost_providerType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHost' {ProviderType
providerType :: ProviderType
$sel:providerType:CreateHost' :: CreateHost -> ProviderType
providerType} -> ProviderType
providerType) (\s :: CreateHost
s@CreateHost' {} ProviderType
a -> CreateHost
s {$sel:providerType:CreateHost' :: ProviderType
providerType = ProviderType
a} :: CreateHost)

-- | The endpoint of the infrastructure to be represented by the host after
-- it is created.
createHost_providerEndpoint :: Lens.Lens' CreateHost Prelude.Text
createHost_providerEndpoint :: Lens' CreateHost Text
createHost_providerEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHost' {Text
providerEndpoint :: Text
$sel:providerEndpoint:CreateHost' :: CreateHost -> Text
providerEndpoint} -> Text
providerEndpoint) (\s :: CreateHost
s@CreateHost' {} Text
a -> CreateHost
s {$sel:providerEndpoint:CreateHost' :: Text
providerEndpoint = Text
a} :: CreateHost)

instance Core.AWSRequest CreateHost where
  type AWSResponse CreateHost = CreateHostResponse
  request :: (Service -> Service) -> CreateHost -> Request CreateHost
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 CreateHost
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateHost)))
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 [Tag] -> Int -> CreateHostResponse
CreateHostResponse'
            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
"HostArn")
            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 CreateHost where
  hashWithSalt :: Int -> CreateHost -> Int
hashWithSalt Int
_salt CreateHost' {Maybe [Tag]
Maybe VpcConfiguration
Text
ProviderType
providerEndpoint :: Text
providerType :: ProviderType
name :: Text
vpcConfiguration :: Maybe VpcConfiguration
tags :: Maybe [Tag]
$sel:providerEndpoint:CreateHost' :: CreateHost -> Text
$sel:providerType:CreateHost' :: CreateHost -> ProviderType
$sel:name:CreateHost' :: CreateHost -> Text
$sel:vpcConfiguration:CreateHost' :: CreateHost -> Maybe VpcConfiguration
$sel:tags:CreateHost' :: CreateHost -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfiguration
vpcConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProviderType
providerType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
providerEndpoint

instance Prelude.NFData CreateHost where
  rnf :: CreateHost -> ()
rnf CreateHost' {Maybe [Tag]
Maybe VpcConfiguration
Text
ProviderType
providerEndpoint :: Text
providerType :: ProviderType
name :: Text
vpcConfiguration :: Maybe VpcConfiguration
tags :: Maybe [Tag]
$sel:providerEndpoint:CreateHost' :: CreateHost -> Text
$sel:providerType:CreateHost' :: CreateHost -> ProviderType
$sel:name:CreateHost' :: CreateHost -> Text
$sel:vpcConfiguration:CreateHost' :: CreateHost -> Maybe VpcConfiguration
$sel:tags:CreateHost' :: CreateHost -> Maybe [Tag]
..} =
    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 Maybe VpcConfiguration
vpcConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProviderType
providerType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
providerEndpoint

instance Data.ToHeaders CreateHost where
  toHeaders :: CreateHost -> 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
"com.amazonaws.codestar.connections.CodeStar_connections_20191201.CreateHost" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateHost where
  toJSON :: CreateHost -> Value
toJSON CreateHost' {Maybe [Tag]
Maybe VpcConfiguration
Text
ProviderType
providerEndpoint :: Text
providerType :: ProviderType
name :: Text
vpcConfiguration :: Maybe VpcConfiguration
tags :: Maybe [Tag]
$sel:providerEndpoint:CreateHost' :: CreateHost -> Text
$sel:providerType:CreateHost' :: CreateHost -> ProviderType
$sel:name:CreateHost' :: CreateHost -> Text
$sel:vpcConfiguration:CreateHost' :: CreateHost -> Maybe VpcConfiguration
$sel:tags:CreateHost' :: CreateHost -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            (Key
"VpcConfiguration" 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 VpcConfiguration
vpcConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"ProviderType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ProviderType
providerType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ProviderEndpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
providerEndpoint)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateHostResponse' 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:
--
-- 'hostArn', 'createHostResponse_hostArn' - The Amazon Resource Name (ARN) of the host to be created.
--
-- 'tags', 'createHostResponse_tags' - Undocumented member.
--
-- 'httpStatus', 'createHostResponse_httpStatus' - The response's http status code.
newCreateHostResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateHostResponse
newCreateHostResponse :: Int -> CreateHostResponse
newCreateHostResponse Int
pHttpStatus_ =
  CreateHostResponse'
    { $sel:hostArn:CreateHostResponse' :: Maybe Text
hostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateHostResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateHostResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the host to be created.
createHostResponse_hostArn :: Lens.Lens' CreateHostResponse (Prelude.Maybe Prelude.Text)
createHostResponse_hostArn :: Lens' CreateHostResponse (Maybe Text)
createHostResponse_hostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostResponse' {Maybe Text
hostArn :: Maybe Text
$sel:hostArn:CreateHostResponse' :: CreateHostResponse -> Maybe Text
hostArn} -> Maybe Text
hostArn) (\s :: CreateHostResponse
s@CreateHostResponse' {} Maybe Text
a -> CreateHostResponse
s {$sel:hostArn:CreateHostResponse' :: Maybe Text
hostArn = Maybe Text
a} :: CreateHostResponse)

-- | Undocumented member.
createHostResponse_tags :: Lens.Lens' CreateHostResponse (Prelude.Maybe [Tag])
createHostResponse_tags :: Lens' CreateHostResponse (Maybe [Tag])
createHostResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHostResponse' :: CreateHostResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHostResponse
s@CreateHostResponse' {} Maybe [Tag]
a -> CreateHostResponse
s {$sel:tags:CreateHostResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHostResponse) 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.
createHostResponse_httpStatus :: Lens.Lens' CreateHostResponse Prelude.Int
createHostResponse_httpStatus :: Lens' CreateHostResponse Int
createHostResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHostResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateHostResponse' :: CreateHostResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateHostResponse
s@CreateHostResponse' {} Int
a -> CreateHostResponse
s {$sel:httpStatus:CreateHostResponse' :: Int
httpStatus = Int
a} :: CreateHostResponse)

instance Prelude.NFData CreateHostResponse where
  rnf :: CreateHostResponse -> ()
rnf CreateHostResponse' {Int
Maybe [Tag]
Maybe Text
httpStatus :: Int
tags :: Maybe [Tag]
hostArn :: Maybe Text
$sel:httpStatus:CreateHostResponse' :: CreateHostResponse -> Int
$sel:tags:CreateHostResponse' :: CreateHostResponse -> Maybe [Tag]
$sel:hostArn:CreateHostResponse' :: CreateHostResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostArn
      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 Int
httpStatus