{-# 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.NetworkManager.CreateDevice
-- 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 new device in a global network. If you specify both a site ID
-- and a location, the location of the site is used for visualization in
-- the Network Manager console.
module Amazonka.NetworkManager.CreateDevice
  ( -- * Creating a Request
    CreateDevice (..),
    newCreateDevice,

    -- * Request Lenses
    createDevice_aWSLocation,
    createDevice_description,
    createDevice_location,
    createDevice_model,
    createDevice_serialNumber,
    createDevice_siteId,
    createDevice_tags,
    createDevice_type,
    createDevice_vendor,
    createDevice_globalNetworkId,

    -- * Destructuring the Response
    CreateDeviceResponse (..),
    newCreateDeviceResponse,

    -- * Response Lenses
    createDeviceResponse_device,
    createDeviceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateDevice' smart constructor.
data CreateDevice = CreateDevice'
  { -- | The Amazon Web Services location of the device, if applicable. For an
    -- on-premises device, you can omit this parameter.
    CreateDevice -> Maybe AWSLocation
aWSLocation :: Prelude.Maybe AWSLocation,
    -- | A description of the device.
    --
    -- Constraints: Maximum length of 256 characters.
    CreateDevice -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The location of the device.
    CreateDevice -> Maybe (Sensitive Location)
location :: Prelude.Maybe (Data.Sensitive Location),
    -- | The model of the device.
    --
    -- Constraints: Maximum length of 128 characters.
    CreateDevice -> Maybe Text
model :: Prelude.Maybe Prelude.Text,
    -- | The serial number of the device.
    --
    -- Constraints: Maximum length of 128 characters.
    CreateDevice -> Maybe Text
serialNumber :: Prelude.Maybe Prelude.Text,
    -- | The ID of the site.
    CreateDevice -> Maybe Text
siteId :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the resource during creation.
    CreateDevice -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The type of the device.
    CreateDevice -> Maybe Text
type' :: Prelude.Maybe Prelude.Text,
    -- | The vendor of the device.
    --
    -- Constraints: Maximum length of 128 characters.
    CreateDevice -> Maybe Text
vendor :: Prelude.Maybe Prelude.Text,
    -- | The ID of the global network.
    CreateDevice -> Text
globalNetworkId :: Prelude.Text
  }
  deriving (CreateDevice -> CreateDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDevice -> CreateDevice -> Bool
$c/= :: CreateDevice -> CreateDevice -> Bool
== :: CreateDevice -> CreateDevice -> Bool
$c== :: CreateDevice -> CreateDevice -> Bool
Prelude.Eq, Int -> CreateDevice -> ShowS
[CreateDevice] -> ShowS
CreateDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDevice] -> ShowS
$cshowList :: [CreateDevice] -> ShowS
show :: CreateDevice -> String
$cshow :: CreateDevice -> String
showsPrec :: Int -> CreateDevice -> ShowS
$cshowsPrec :: Int -> CreateDevice -> ShowS
Prelude.Show, forall x. Rep CreateDevice x -> CreateDevice
forall x. CreateDevice -> Rep CreateDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDevice x -> CreateDevice
$cfrom :: forall x. CreateDevice -> Rep CreateDevice x
Prelude.Generic)

-- |
-- Create a value of 'CreateDevice' 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:
--
-- 'aWSLocation', 'createDevice_aWSLocation' - The Amazon Web Services location of the device, if applicable. For an
-- on-premises device, you can omit this parameter.
--
-- 'description', 'createDevice_description' - A description of the device.
--
-- Constraints: Maximum length of 256 characters.
--
-- 'location', 'createDevice_location' - The location of the device.
--
-- 'model', 'createDevice_model' - The model of the device.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'serialNumber', 'createDevice_serialNumber' - The serial number of the device.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'siteId', 'createDevice_siteId' - The ID of the site.
--
-- 'tags', 'createDevice_tags' - The tags to apply to the resource during creation.
--
-- 'type'', 'createDevice_type' - The type of the device.
--
-- 'vendor', 'createDevice_vendor' - The vendor of the device.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'globalNetworkId', 'createDevice_globalNetworkId' - The ID of the global network.
newCreateDevice ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  CreateDevice
newCreateDevice :: Text -> CreateDevice
newCreateDevice Text
pGlobalNetworkId_ =
  CreateDevice'
    { $sel:aWSLocation:CreateDevice' :: Maybe AWSLocation
aWSLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateDevice' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:location:CreateDevice' :: Maybe (Sensitive Location)
location = forall a. Maybe a
Prelude.Nothing,
      $sel:model:CreateDevice' :: Maybe Text
model = forall a. Maybe a
Prelude.Nothing,
      $sel:serialNumber:CreateDevice' :: Maybe Text
serialNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:siteId:CreateDevice' :: Maybe Text
siteId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDevice' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':CreateDevice' :: Maybe Text
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:vendor:CreateDevice' :: Maybe Text
vendor = forall a. Maybe a
Prelude.Nothing,
      $sel:globalNetworkId:CreateDevice' :: Text
globalNetworkId = Text
pGlobalNetworkId_
    }

-- | The Amazon Web Services location of the device, if applicable. For an
-- on-premises device, you can omit this parameter.
createDevice_aWSLocation :: Lens.Lens' CreateDevice (Prelude.Maybe AWSLocation)
createDevice_aWSLocation :: Lens' CreateDevice (Maybe AWSLocation)
createDevice_aWSLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe AWSLocation
aWSLocation :: Maybe AWSLocation
$sel:aWSLocation:CreateDevice' :: CreateDevice -> Maybe AWSLocation
aWSLocation} -> Maybe AWSLocation
aWSLocation) (\s :: CreateDevice
s@CreateDevice' {} Maybe AWSLocation
a -> CreateDevice
s {$sel:aWSLocation:CreateDevice' :: Maybe AWSLocation
aWSLocation = Maybe AWSLocation
a} :: CreateDevice)

-- | A description of the device.
--
-- Constraints: Maximum length of 256 characters.
createDevice_description :: Lens.Lens' CreateDevice (Prelude.Maybe Prelude.Text)
createDevice_description :: Lens' CreateDevice (Maybe Text)
createDevice_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe Text
description :: Maybe Text
$sel:description:CreateDevice' :: CreateDevice -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateDevice
s@CreateDevice' {} Maybe Text
a -> CreateDevice
s {$sel:description:CreateDevice' :: Maybe Text
description = Maybe Text
a} :: CreateDevice)

-- | The location of the device.
createDevice_location :: Lens.Lens' CreateDevice (Prelude.Maybe Location)
createDevice_location :: Lens' CreateDevice (Maybe Location)
createDevice_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe (Sensitive Location)
location :: Maybe (Sensitive Location)
$sel:location:CreateDevice' :: CreateDevice -> Maybe (Sensitive Location)
location} -> Maybe (Sensitive Location)
location) (\s :: CreateDevice
s@CreateDevice' {} Maybe (Sensitive Location)
a -> CreateDevice
s {$sel:location:CreateDevice' :: Maybe (Sensitive Location)
location = Maybe (Sensitive Location)
a} :: CreateDevice) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The model of the device.
--
-- Constraints: Maximum length of 128 characters.
createDevice_model :: Lens.Lens' CreateDevice (Prelude.Maybe Prelude.Text)
createDevice_model :: Lens' CreateDevice (Maybe Text)
createDevice_model = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe Text
model :: Maybe Text
$sel:model:CreateDevice' :: CreateDevice -> Maybe Text
model} -> Maybe Text
model) (\s :: CreateDevice
s@CreateDevice' {} Maybe Text
a -> CreateDevice
s {$sel:model:CreateDevice' :: Maybe Text
model = Maybe Text
a} :: CreateDevice)

-- | The serial number of the device.
--
-- Constraints: Maximum length of 128 characters.
createDevice_serialNumber :: Lens.Lens' CreateDevice (Prelude.Maybe Prelude.Text)
createDevice_serialNumber :: Lens' CreateDevice (Maybe Text)
createDevice_serialNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe Text
serialNumber :: Maybe Text
$sel:serialNumber:CreateDevice' :: CreateDevice -> Maybe Text
serialNumber} -> Maybe Text
serialNumber) (\s :: CreateDevice
s@CreateDevice' {} Maybe Text
a -> CreateDevice
s {$sel:serialNumber:CreateDevice' :: Maybe Text
serialNumber = Maybe Text
a} :: CreateDevice)

-- | The ID of the site.
createDevice_siteId :: Lens.Lens' CreateDevice (Prelude.Maybe Prelude.Text)
createDevice_siteId :: Lens' CreateDevice (Maybe Text)
createDevice_siteId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe Text
siteId :: Maybe Text
$sel:siteId:CreateDevice' :: CreateDevice -> Maybe Text
siteId} -> Maybe Text
siteId) (\s :: CreateDevice
s@CreateDevice' {} Maybe Text
a -> CreateDevice
s {$sel:siteId:CreateDevice' :: Maybe Text
siteId = Maybe Text
a} :: CreateDevice)

-- | The tags to apply to the resource during creation.
createDevice_tags :: Lens.Lens' CreateDevice (Prelude.Maybe [Tag])
createDevice_tags :: Lens' CreateDevice (Maybe [Tag])
createDevice_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDevice' :: CreateDevice -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDevice
s@CreateDevice' {} Maybe [Tag]
a -> CreateDevice
s {$sel:tags:CreateDevice' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDevice) 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 type of the device.
createDevice_type :: Lens.Lens' CreateDevice (Prelude.Maybe Prelude.Text)
createDevice_type :: Lens' CreateDevice (Maybe Text)
createDevice_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe Text
type' :: Maybe Text
$sel:type':CreateDevice' :: CreateDevice -> Maybe Text
type'} -> Maybe Text
type') (\s :: CreateDevice
s@CreateDevice' {} Maybe Text
a -> CreateDevice
s {$sel:type':CreateDevice' :: Maybe Text
type' = Maybe Text
a} :: CreateDevice)

-- | The vendor of the device.
--
-- Constraints: Maximum length of 128 characters.
createDevice_vendor :: Lens.Lens' CreateDevice (Prelude.Maybe Prelude.Text)
createDevice_vendor :: Lens' CreateDevice (Maybe Text)
createDevice_vendor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Maybe Text
vendor :: Maybe Text
$sel:vendor:CreateDevice' :: CreateDevice -> Maybe Text
vendor} -> Maybe Text
vendor) (\s :: CreateDevice
s@CreateDevice' {} Maybe Text
a -> CreateDevice
s {$sel:vendor:CreateDevice' :: Maybe Text
vendor = Maybe Text
a} :: CreateDevice)

-- | The ID of the global network.
createDevice_globalNetworkId :: Lens.Lens' CreateDevice Prelude.Text
createDevice_globalNetworkId :: Lens' CreateDevice Text
createDevice_globalNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDevice' {Text
globalNetworkId :: Text
$sel:globalNetworkId:CreateDevice' :: CreateDevice -> Text
globalNetworkId} -> Text
globalNetworkId) (\s :: CreateDevice
s@CreateDevice' {} Text
a -> CreateDevice
s {$sel:globalNetworkId:CreateDevice' :: Text
globalNetworkId = Text
a} :: CreateDevice)

instance Core.AWSRequest CreateDevice where
  type AWSResponse CreateDevice = CreateDeviceResponse
  request :: (Service -> Service) -> CreateDevice -> Request CreateDevice
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 CreateDevice
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDevice)))
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 Device -> Int -> CreateDeviceResponse
CreateDeviceResponse'
            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
"Device")
            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 CreateDevice where
  hashWithSalt :: Int -> CreateDevice -> Int
hashWithSalt Int
_salt CreateDevice' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
tags :: Maybe [Tag]
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:globalNetworkId:CreateDevice' :: CreateDevice -> Text
$sel:vendor:CreateDevice' :: CreateDevice -> Maybe Text
$sel:type':CreateDevice' :: CreateDevice -> Maybe Text
$sel:tags:CreateDevice' :: CreateDevice -> Maybe [Tag]
$sel:siteId:CreateDevice' :: CreateDevice -> Maybe Text
$sel:serialNumber:CreateDevice' :: CreateDevice -> Maybe Text
$sel:model:CreateDevice' :: CreateDevice -> Maybe Text
$sel:location:CreateDevice' :: CreateDevice -> Maybe (Sensitive Location)
$sel:description:CreateDevice' :: CreateDevice -> Maybe Text
$sel:aWSLocation:CreateDevice' :: CreateDevice -> Maybe AWSLocation
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AWSLocation
aWSLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Location)
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
model
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serialNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
siteId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vendor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalNetworkId

instance Prelude.NFData CreateDevice where
  rnf :: CreateDevice -> ()
rnf CreateDevice' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
tags :: Maybe [Tag]
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:globalNetworkId:CreateDevice' :: CreateDevice -> Text
$sel:vendor:CreateDevice' :: CreateDevice -> Maybe Text
$sel:type':CreateDevice' :: CreateDevice -> Maybe Text
$sel:tags:CreateDevice' :: CreateDevice -> Maybe [Tag]
$sel:siteId:CreateDevice' :: CreateDevice -> Maybe Text
$sel:serialNumber:CreateDevice' :: CreateDevice -> Maybe Text
$sel:model:CreateDevice' :: CreateDevice -> Maybe Text
$sel:location:CreateDevice' :: CreateDevice -> Maybe (Sensitive Location)
$sel:description:CreateDevice' :: CreateDevice -> Maybe Text
$sel:aWSLocation:CreateDevice' :: CreateDevice -> Maybe AWSLocation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AWSLocation
aWSLocation
      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 (Sensitive Location)
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
model
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serialNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
siteId
      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 Maybe Text
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vendor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
globalNetworkId

instance Data.ToHeaders CreateDevice where
  toHeaders :: CreateDevice -> 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 CreateDevice where
  toJSON :: CreateDevice -> Value
toJSON CreateDevice' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
tags :: Maybe [Tag]
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:globalNetworkId:CreateDevice' :: CreateDevice -> Text
$sel:vendor:CreateDevice' :: CreateDevice -> Maybe Text
$sel:type':CreateDevice' :: CreateDevice -> Maybe Text
$sel:tags:CreateDevice' :: CreateDevice -> Maybe [Tag]
$sel:siteId:CreateDevice' :: CreateDevice -> Maybe Text
$sel:serialNumber:CreateDevice' :: CreateDevice -> Maybe Text
$sel:model:CreateDevice' :: CreateDevice -> Maybe Text
$sel:location:CreateDevice' :: CreateDevice -> Maybe (Sensitive Location)
$sel:description:CreateDevice' :: CreateDevice -> Maybe Text
$sel:aWSLocation:CreateDevice' :: CreateDevice -> Maybe AWSLocation
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AWSLocation" 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 AWSLocation
aWSLocation,
            (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
"Location" 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 (Sensitive Location)
location,
            (Key
"Model" 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
model,
            (Key
"SerialNumber" 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
serialNumber,
            (Key
"SiteId" 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
siteId,
            (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
"Type" 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
type',
            (Key
"Vendor" 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
vendor
          ]
      )

instance Data.ToPath CreateDevice where
  toPath :: CreateDevice -> ByteString
toPath CreateDevice' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
tags :: Maybe [Tag]
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:globalNetworkId:CreateDevice' :: CreateDevice -> Text
$sel:vendor:CreateDevice' :: CreateDevice -> Maybe Text
$sel:type':CreateDevice' :: CreateDevice -> Maybe Text
$sel:tags:CreateDevice' :: CreateDevice -> Maybe [Tag]
$sel:siteId:CreateDevice' :: CreateDevice -> Maybe Text
$sel:serialNumber:CreateDevice' :: CreateDevice -> Maybe Text
$sel:model:CreateDevice' :: CreateDevice -> Maybe Text
$sel:location:CreateDevice' :: CreateDevice -> Maybe (Sensitive Location)
$sel:description:CreateDevice' :: CreateDevice -> Maybe Text
$sel:aWSLocation:CreateDevice' :: CreateDevice -> Maybe AWSLocation
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/devices"
      ]

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

-- | /See:/ 'newCreateDeviceResponse' smart constructor.
data CreateDeviceResponse = CreateDeviceResponse'
  { -- | Information about the device.
    CreateDeviceResponse -> Maybe Device
device :: Prelude.Maybe Device,
    -- | The response's http status code.
    CreateDeviceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDeviceResponse -> CreateDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeviceResponse -> CreateDeviceResponse -> Bool
$c/= :: CreateDeviceResponse -> CreateDeviceResponse -> Bool
== :: CreateDeviceResponse -> CreateDeviceResponse -> Bool
$c== :: CreateDeviceResponse -> CreateDeviceResponse -> Bool
Prelude.Eq, Int -> CreateDeviceResponse -> ShowS
[CreateDeviceResponse] -> ShowS
CreateDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeviceResponse] -> ShowS
$cshowList :: [CreateDeviceResponse] -> ShowS
show :: CreateDeviceResponse -> String
$cshow :: CreateDeviceResponse -> String
showsPrec :: Int -> CreateDeviceResponse -> ShowS
$cshowsPrec :: Int -> CreateDeviceResponse -> ShowS
Prelude.Show, forall x. Rep CreateDeviceResponse x -> CreateDeviceResponse
forall x. CreateDeviceResponse -> Rep CreateDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeviceResponse x -> CreateDeviceResponse
$cfrom :: forall x. CreateDeviceResponse -> Rep CreateDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeviceResponse' 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:
--
-- 'device', 'createDeviceResponse_device' - Information about the device.
--
-- 'httpStatus', 'createDeviceResponse_httpStatus' - The response's http status code.
newCreateDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDeviceResponse
newCreateDeviceResponse :: Int -> CreateDeviceResponse
newCreateDeviceResponse Int
pHttpStatus_ =
  CreateDeviceResponse'
    { $sel:device:CreateDeviceResponse' :: Maybe Device
device = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the device.
createDeviceResponse_device :: Lens.Lens' CreateDeviceResponse (Prelude.Maybe Device)
createDeviceResponse_device :: Lens' CreateDeviceResponse (Maybe Device)
createDeviceResponse_device = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeviceResponse' {Maybe Device
device :: Maybe Device
$sel:device:CreateDeviceResponse' :: CreateDeviceResponse -> Maybe Device
device} -> Maybe Device
device) (\s :: CreateDeviceResponse
s@CreateDeviceResponse' {} Maybe Device
a -> CreateDeviceResponse
s {$sel:device:CreateDeviceResponse' :: Maybe Device
device = Maybe Device
a} :: CreateDeviceResponse)

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

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