{-# 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.Outposts.CreateOutpost
-- 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 Outpost.
--
-- You can specify either an Availability one or an AZ ID.
module Amazonka.Outposts.CreateOutpost
  ( -- * Creating a Request
    CreateOutpost (..),
    newCreateOutpost,

    -- * Request Lenses
    createOutpost_availabilityZone,
    createOutpost_availabilityZoneId,
    createOutpost_description,
    createOutpost_supportedHardwareType,
    createOutpost_tags,
    createOutpost_name,
    createOutpost_siteId,

    -- * Destructuring the Response
    CreateOutpostResponse (..),
    newCreateOutpostResponse,

    -- * Response Lenses
    createOutpostResponse_outpost,
    createOutpostResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Outposts.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateOutpost' smart constructor.
data CreateOutpost = CreateOutpost'
  { CreateOutpost -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    CreateOutpost -> Maybe Text
availabilityZoneId :: Prelude.Maybe Prelude.Text,
    CreateOutpost -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The type of hardware for this Outpost.
    CreateOutpost -> Maybe SupportedHardwareType
supportedHardwareType :: Prelude.Maybe SupportedHardwareType,
    -- | The tags to apply to the Outpost.
    CreateOutpost -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    CreateOutpost -> Text
name :: Prelude.Text,
    -- | The ID or the Amazon Resource Name (ARN) of the site.
    CreateOutpost -> Text
siteId :: Prelude.Text
  }
  deriving (CreateOutpost -> CreateOutpost -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOutpost -> CreateOutpost -> Bool
$c/= :: CreateOutpost -> CreateOutpost -> Bool
== :: CreateOutpost -> CreateOutpost -> Bool
$c== :: CreateOutpost -> CreateOutpost -> Bool
Prelude.Eq, ReadPrec [CreateOutpost]
ReadPrec CreateOutpost
Int -> ReadS CreateOutpost
ReadS [CreateOutpost]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOutpost]
$creadListPrec :: ReadPrec [CreateOutpost]
readPrec :: ReadPrec CreateOutpost
$creadPrec :: ReadPrec CreateOutpost
readList :: ReadS [CreateOutpost]
$creadList :: ReadS [CreateOutpost]
readsPrec :: Int -> ReadS CreateOutpost
$creadsPrec :: Int -> ReadS CreateOutpost
Prelude.Read, Int -> CreateOutpost -> ShowS
[CreateOutpost] -> ShowS
CreateOutpost -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOutpost] -> ShowS
$cshowList :: [CreateOutpost] -> ShowS
show :: CreateOutpost -> String
$cshow :: CreateOutpost -> String
showsPrec :: Int -> CreateOutpost -> ShowS
$cshowsPrec :: Int -> CreateOutpost -> ShowS
Prelude.Show, forall x. Rep CreateOutpost x -> CreateOutpost
forall x. CreateOutpost -> Rep CreateOutpost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOutpost x -> CreateOutpost
$cfrom :: forall x. CreateOutpost -> Rep CreateOutpost x
Prelude.Generic)

-- |
-- Create a value of 'CreateOutpost' 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:
--
-- 'availabilityZone', 'createOutpost_availabilityZone' - Undocumented member.
--
-- 'availabilityZoneId', 'createOutpost_availabilityZoneId' - Undocumented member.
--
-- 'description', 'createOutpost_description' - Undocumented member.
--
-- 'supportedHardwareType', 'createOutpost_supportedHardwareType' - The type of hardware for this Outpost.
--
-- 'tags', 'createOutpost_tags' - The tags to apply to the Outpost.
--
-- 'name', 'createOutpost_name' - Undocumented member.
--
-- 'siteId', 'createOutpost_siteId' - The ID or the Amazon Resource Name (ARN) of the site.
newCreateOutpost ::
  -- | 'name'
  Prelude.Text ->
  -- | 'siteId'
  Prelude.Text ->
  CreateOutpost
newCreateOutpost :: Text -> Text -> CreateOutpost
newCreateOutpost Text
pName_ Text
pSiteId_ =
  CreateOutpost'
    { $sel:availabilityZone:CreateOutpost' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneId:CreateOutpost' :: Maybe Text
availabilityZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateOutpost' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:supportedHardwareType:CreateOutpost' :: Maybe SupportedHardwareType
supportedHardwareType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateOutpost' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateOutpost' :: Text
name = Text
pName_,
      $sel:siteId:CreateOutpost' :: Text
siteId = Text
pSiteId_
    }

-- | Undocumented member.
createOutpost_availabilityZone :: Lens.Lens' CreateOutpost (Prelude.Maybe Prelude.Text)
createOutpost_availabilityZone :: Lens' CreateOutpost (Maybe Text)
createOutpost_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:CreateOutpost' :: CreateOutpost -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: CreateOutpost
s@CreateOutpost' {} Maybe Text
a -> CreateOutpost
s {$sel:availabilityZone:CreateOutpost' :: Maybe Text
availabilityZone = Maybe Text
a} :: CreateOutpost)

-- | Undocumented member.
createOutpost_availabilityZoneId :: Lens.Lens' CreateOutpost (Prelude.Maybe Prelude.Text)
createOutpost_availabilityZoneId :: Lens' CreateOutpost (Maybe Text)
createOutpost_availabilityZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Maybe Text
availabilityZoneId :: Maybe Text
$sel:availabilityZoneId:CreateOutpost' :: CreateOutpost -> Maybe Text
availabilityZoneId} -> Maybe Text
availabilityZoneId) (\s :: CreateOutpost
s@CreateOutpost' {} Maybe Text
a -> CreateOutpost
s {$sel:availabilityZoneId:CreateOutpost' :: Maybe Text
availabilityZoneId = Maybe Text
a} :: CreateOutpost)

-- | Undocumented member.
createOutpost_description :: Lens.Lens' CreateOutpost (Prelude.Maybe Prelude.Text)
createOutpost_description :: Lens' CreateOutpost (Maybe Text)
createOutpost_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Maybe Text
description :: Maybe Text
$sel:description:CreateOutpost' :: CreateOutpost -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateOutpost
s@CreateOutpost' {} Maybe Text
a -> CreateOutpost
s {$sel:description:CreateOutpost' :: Maybe Text
description = Maybe Text
a} :: CreateOutpost)

-- | The type of hardware for this Outpost.
createOutpost_supportedHardwareType :: Lens.Lens' CreateOutpost (Prelude.Maybe SupportedHardwareType)
createOutpost_supportedHardwareType :: Lens' CreateOutpost (Maybe SupportedHardwareType)
createOutpost_supportedHardwareType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Maybe SupportedHardwareType
supportedHardwareType :: Maybe SupportedHardwareType
$sel:supportedHardwareType:CreateOutpost' :: CreateOutpost -> Maybe SupportedHardwareType
supportedHardwareType} -> Maybe SupportedHardwareType
supportedHardwareType) (\s :: CreateOutpost
s@CreateOutpost' {} Maybe SupportedHardwareType
a -> CreateOutpost
s {$sel:supportedHardwareType:CreateOutpost' :: Maybe SupportedHardwareType
supportedHardwareType = Maybe SupportedHardwareType
a} :: CreateOutpost)

-- | The tags to apply to the Outpost.
createOutpost_tags :: Lens.Lens' CreateOutpost (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createOutpost_tags :: Lens' CreateOutpost (Maybe (HashMap Text Text))
createOutpost_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateOutpost' :: CreateOutpost -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateOutpost
s@CreateOutpost' {} Maybe (HashMap Text Text)
a -> CreateOutpost
s {$sel:tags:CreateOutpost' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateOutpost) 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.
createOutpost_name :: Lens.Lens' CreateOutpost Prelude.Text
createOutpost_name :: Lens' CreateOutpost Text
createOutpost_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Text
name :: Text
$sel:name:CreateOutpost' :: CreateOutpost -> Text
name} -> Text
name) (\s :: CreateOutpost
s@CreateOutpost' {} Text
a -> CreateOutpost
s {$sel:name:CreateOutpost' :: Text
name = Text
a} :: CreateOutpost)

-- | The ID or the Amazon Resource Name (ARN) of the site.
createOutpost_siteId :: Lens.Lens' CreateOutpost Prelude.Text
createOutpost_siteId :: Lens' CreateOutpost Text
createOutpost_siteId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpost' {Text
siteId :: Text
$sel:siteId:CreateOutpost' :: CreateOutpost -> Text
siteId} -> Text
siteId) (\s :: CreateOutpost
s@CreateOutpost' {} Text
a -> CreateOutpost
s {$sel:siteId:CreateOutpost' :: Text
siteId = Text
a} :: CreateOutpost)

instance Core.AWSRequest CreateOutpost where
  type
    AWSResponse CreateOutpost =
      CreateOutpostResponse
  request :: (Service -> Service) -> CreateOutpost -> Request CreateOutpost
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 CreateOutpost
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateOutpost)))
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 Outpost -> Int -> CreateOutpostResponse
CreateOutpostResponse'
            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
"Outpost")
            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 CreateOutpost where
  hashWithSalt :: Int -> CreateOutpost -> Int
hashWithSalt Int
_salt CreateOutpost' {Maybe Text
Maybe (HashMap Text Text)
Maybe SupportedHardwareType
Text
siteId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
supportedHardwareType :: Maybe SupportedHardwareType
description :: Maybe Text
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:siteId:CreateOutpost' :: CreateOutpost -> Text
$sel:name:CreateOutpost' :: CreateOutpost -> Text
$sel:tags:CreateOutpost' :: CreateOutpost -> Maybe (HashMap Text Text)
$sel:supportedHardwareType:CreateOutpost' :: CreateOutpost -> Maybe SupportedHardwareType
$sel:description:CreateOutpost' :: CreateOutpost -> Maybe Text
$sel:availabilityZoneId:CreateOutpost' :: CreateOutpost -> Maybe Text
$sel:availabilityZone:CreateOutpost' :: CreateOutpost -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SupportedHardwareType
supportedHardwareType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
siteId

instance Prelude.NFData CreateOutpost where
  rnf :: CreateOutpost -> ()
rnf CreateOutpost' {Maybe Text
Maybe (HashMap Text Text)
Maybe SupportedHardwareType
Text
siteId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
supportedHardwareType :: Maybe SupportedHardwareType
description :: Maybe Text
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:siteId:CreateOutpost' :: CreateOutpost -> Text
$sel:name:CreateOutpost' :: CreateOutpost -> Text
$sel:tags:CreateOutpost' :: CreateOutpost -> Maybe (HashMap Text Text)
$sel:supportedHardwareType:CreateOutpost' :: CreateOutpost -> Maybe SupportedHardwareType
$sel:description:CreateOutpost' :: CreateOutpost -> Maybe Text
$sel:availabilityZoneId:CreateOutpost' :: CreateOutpost -> Maybe Text
$sel:availabilityZone:CreateOutpost' :: CreateOutpost -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZoneId
      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 SupportedHardwareType
supportedHardwareType
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
siteId

instance Data.ToHeaders CreateOutpost where
  toHeaders :: CreateOutpost -> 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 CreateOutpost where
  toJSON :: CreateOutpost -> Value
toJSON CreateOutpost' {Maybe Text
Maybe (HashMap Text Text)
Maybe SupportedHardwareType
Text
siteId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
supportedHardwareType :: Maybe SupportedHardwareType
description :: Maybe Text
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:siteId:CreateOutpost' :: CreateOutpost -> Text
$sel:name:CreateOutpost' :: CreateOutpost -> Text
$sel:tags:CreateOutpost' :: CreateOutpost -> Maybe (HashMap Text Text)
$sel:supportedHardwareType:CreateOutpost' :: CreateOutpost -> Maybe SupportedHardwareType
$sel:description:CreateOutpost' :: CreateOutpost -> Maybe Text
$sel:availabilityZoneId:CreateOutpost' :: CreateOutpost -> Maybe Text
$sel:availabilityZone:CreateOutpost' :: CreateOutpost -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AvailabilityZone" 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
availabilityZone,
            (Key
"AvailabilityZoneId" 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
availabilityZoneId,
            (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
"SupportedHardwareType" 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 SupportedHardwareType
supportedHardwareType,
            (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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"SiteId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
siteId)
          ]
      )

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

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

-- | /See:/ 'newCreateOutpostResponse' smart constructor.
data CreateOutpostResponse = CreateOutpostResponse'
  { CreateOutpostResponse -> Maybe Outpost
outpost :: Prelude.Maybe Outpost,
    -- | The response's http status code.
    CreateOutpostResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateOutpostResponse -> CreateOutpostResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOutpostResponse -> CreateOutpostResponse -> Bool
$c/= :: CreateOutpostResponse -> CreateOutpostResponse -> Bool
== :: CreateOutpostResponse -> CreateOutpostResponse -> Bool
$c== :: CreateOutpostResponse -> CreateOutpostResponse -> Bool
Prelude.Eq, ReadPrec [CreateOutpostResponse]
ReadPrec CreateOutpostResponse
Int -> ReadS CreateOutpostResponse
ReadS [CreateOutpostResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOutpostResponse]
$creadListPrec :: ReadPrec [CreateOutpostResponse]
readPrec :: ReadPrec CreateOutpostResponse
$creadPrec :: ReadPrec CreateOutpostResponse
readList :: ReadS [CreateOutpostResponse]
$creadList :: ReadS [CreateOutpostResponse]
readsPrec :: Int -> ReadS CreateOutpostResponse
$creadsPrec :: Int -> ReadS CreateOutpostResponse
Prelude.Read, Int -> CreateOutpostResponse -> ShowS
[CreateOutpostResponse] -> ShowS
CreateOutpostResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOutpostResponse] -> ShowS
$cshowList :: [CreateOutpostResponse] -> ShowS
show :: CreateOutpostResponse -> String
$cshow :: CreateOutpostResponse -> String
showsPrec :: Int -> CreateOutpostResponse -> ShowS
$cshowsPrec :: Int -> CreateOutpostResponse -> ShowS
Prelude.Show, forall x. Rep CreateOutpostResponse x -> CreateOutpostResponse
forall x. CreateOutpostResponse -> Rep CreateOutpostResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOutpostResponse x -> CreateOutpostResponse
$cfrom :: forall x. CreateOutpostResponse -> Rep CreateOutpostResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateOutpostResponse' 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:
--
-- 'outpost', 'createOutpostResponse_outpost' - Undocumented member.
--
-- 'httpStatus', 'createOutpostResponse_httpStatus' - The response's http status code.
newCreateOutpostResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOutpostResponse
newCreateOutpostResponse :: Int -> CreateOutpostResponse
newCreateOutpostResponse Int
pHttpStatus_ =
  CreateOutpostResponse'
    { $sel:outpost:CreateOutpostResponse' :: Maybe Outpost
outpost = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOutpostResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createOutpostResponse_outpost :: Lens.Lens' CreateOutpostResponse (Prelude.Maybe Outpost)
createOutpostResponse_outpost :: Lens' CreateOutpostResponse (Maybe Outpost)
createOutpostResponse_outpost = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOutpostResponse' {Maybe Outpost
outpost :: Maybe Outpost
$sel:outpost:CreateOutpostResponse' :: CreateOutpostResponse -> Maybe Outpost
outpost} -> Maybe Outpost
outpost) (\s :: CreateOutpostResponse
s@CreateOutpostResponse' {} Maybe Outpost
a -> CreateOutpostResponse
s {$sel:outpost:CreateOutpostResponse' :: Maybe Outpost
outpost = Maybe Outpost
a} :: CreateOutpostResponse)

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

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