{-# 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.Panorama.ProvisionDevice
-- 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 device and returns a configuration archive. The configuration
-- archive is a ZIP file that contains a provisioning certificate that is
-- valid for 5 minutes. Name the configuration archive
-- @certificates-omni_@/@device-name@/@.zip@ and transfer it to the device
-- within 5 minutes. Use the included USB storage device and connect it to
-- the USB 3.0 port next to the HDMI output.
module Amazonka.Panorama.ProvisionDevice
  ( -- * Creating a Request
    ProvisionDevice (..),
    newProvisionDevice,

    -- * Request Lenses
    provisionDevice_description,
    provisionDevice_networkingConfiguration,
    provisionDevice_tags,
    provisionDevice_name,

    -- * Destructuring the Response
    ProvisionDeviceResponse (..),
    newProvisionDeviceResponse,

    -- * Response Lenses
    provisionDeviceResponse_certificates,
    provisionDeviceResponse_deviceId,
    provisionDeviceResponse_iotThingName,
    provisionDeviceResponse_httpStatus,
    provisionDeviceResponse_arn,
    provisionDeviceResponse_status,
  )
where

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

-- | /See:/ 'newProvisionDevice' smart constructor.
data ProvisionDevice = ProvisionDevice'
  { -- | A description for the device.
    ProvisionDevice -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A networking configuration for the device.
    ProvisionDevice -> Maybe NetworkPayload
networkingConfiguration :: Prelude.Maybe NetworkPayload,
    -- | Tags for the device.
    ProvisionDevice -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the device.
    ProvisionDevice -> Text
name :: Prelude.Text
  }
  deriving (ProvisionDevice -> ProvisionDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProvisionDevice -> ProvisionDevice -> Bool
$c/= :: ProvisionDevice -> ProvisionDevice -> Bool
== :: ProvisionDevice -> ProvisionDevice -> Bool
$c== :: ProvisionDevice -> ProvisionDevice -> Bool
Prelude.Eq, ReadPrec [ProvisionDevice]
ReadPrec ProvisionDevice
Int -> ReadS ProvisionDevice
ReadS [ProvisionDevice]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProvisionDevice]
$creadListPrec :: ReadPrec [ProvisionDevice]
readPrec :: ReadPrec ProvisionDevice
$creadPrec :: ReadPrec ProvisionDevice
readList :: ReadS [ProvisionDevice]
$creadList :: ReadS [ProvisionDevice]
readsPrec :: Int -> ReadS ProvisionDevice
$creadsPrec :: Int -> ReadS ProvisionDevice
Prelude.Read, Int -> ProvisionDevice -> ShowS
[ProvisionDevice] -> ShowS
ProvisionDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProvisionDevice] -> ShowS
$cshowList :: [ProvisionDevice] -> ShowS
show :: ProvisionDevice -> String
$cshow :: ProvisionDevice -> String
showsPrec :: Int -> ProvisionDevice -> ShowS
$cshowsPrec :: Int -> ProvisionDevice -> ShowS
Prelude.Show, forall x. Rep ProvisionDevice x -> ProvisionDevice
forall x. ProvisionDevice -> Rep ProvisionDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProvisionDevice x -> ProvisionDevice
$cfrom :: forall x. ProvisionDevice -> Rep ProvisionDevice x
Prelude.Generic)

-- |
-- Create a value of 'ProvisionDevice' 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:
--
-- 'description', 'provisionDevice_description' - A description for the device.
--
-- 'networkingConfiguration', 'provisionDevice_networkingConfiguration' - A networking configuration for the device.
--
-- 'tags', 'provisionDevice_tags' - Tags for the device.
--
-- 'name', 'provisionDevice_name' - A name for the device.
newProvisionDevice ::
  -- | 'name'
  Prelude.Text ->
  ProvisionDevice
newProvisionDevice :: Text -> ProvisionDevice
newProvisionDevice Text
pName_ =
  ProvisionDevice'
    { $sel:description:ProvisionDevice' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:networkingConfiguration:ProvisionDevice' :: Maybe NetworkPayload
networkingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ProvisionDevice' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:ProvisionDevice' :: Text
name = Text
pName_
    }

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

-- | A networking configuration for the device.
provisionDevice_networkingConfiguration :: Lens.Lens' ProvisionDevice (Prelude.Maybe NetworkPayload)
provisionDevice_networkingConfiguration :: Lens' ProvisionDevice (Maybe NetworkPayload)
provisionDevice_networkingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDevice' {Maybe NetworkPayload
networkingConfiguration :: Maybe NetworkPayload
$sel:networkingConfiguration:ProvisionDevice' :: ProvisionDevice -> Maybe NetworkPayload
networkingConfiguration} -> Maybe NetworkPayload
networkingConfiguration) (\s :: ProvisionDevice
s@ProvisionDevice' {} Maybe NetworkPayload
a -> ProvisionDevice
s {$sel:networkingConfiguration:ProvisionDevice' :: Maybe NetworkPayload
networkingConfiguration = Maybe NetworkPayload
a} :: ProvisionDevice)

-- | Tags for the device.
provisionDevice_tags :: Lens.Lens' ProvisionDevice (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
provisionDevice_tags :: Lens' ProvisionDevice (Maybe (HashMap Text Text))
provisionDevice_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDevice' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:ProvisionDevice' :: ProvisionDevice -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: ProvisionDevice
s@ProvisionDevice' {} Maybe (HashMap Text Text)
a -> ProvisionDevice
s {$sel:tags:ProvisionDevice' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: ProvisionDevice) 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

-- | A name for the device.
provisionDevice_name :: Lens.Lens' ProvisionDevice Prelude.Text
provisionDevice_name :: Lens' ProvisionDevice Text
provisionDevice_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDevice' {Text
name :: Text
$sel:name:ProvisionDevice' :: ProvisionDevice -> Text
name} -> Text
name) (\s :: ProvisionDevice
s@ProvisionDevice' {} Text
a -> ProvisionDevice
s {$sel:name:ProvisionDevice' :: Text
name = Text
a} :: ProvisionDevice)

instance Core.AWSRequest ProvisionDevice where
  type
    AWSResponse ProvisionDevice =
      ProvisionDeviceResponse
  request :: (Service -> Service) -> ProvisionDevice -> Request ProvisionDevice
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 ProvisionDevice
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ProvisionDevice)))
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 Base64
-> Maybe Text
-> Maybe Text
-> Int
-> Text
-> DeviceStatus
-> ProvisionDeviceResponse
ProvisionDeviceResponse'
            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
"Certificates")
            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
"DeviceId")
            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
"IotThingName")
            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))
            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
"Arn")
            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
"Status")
      )

instance Prelude.Hashable ProvisionDevice where
  hashWithSalt :: Int -> ProvisionDevice -> Int
hashWithSalt Int
_salt ProvisionDevice' {Maybe Text
Maybe (HashMap Text Text)
Maybe NetworkPayload
Text
name :: Text
tags :: Maybe (HashMap Text Text)
networkingConfiguration :: Maybe NetworkPayload
description :: Maybe Text
$sel:name:ProvisionDevice' :: ProvisionDevice -> Text
$sel:tags:ProvisionDevice' :: ProvisionDevice -> Maybe (HashMap Text Text)
$sel:networkingConfiguration:ProvisionDevice' :: ProvisionDevice -> Maybe NetworkPayload
$sel:description:ProvisionDevice' :: ProvisionDevice -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkPayload
networkingConfiguration
      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

instance Prelude.NFData ProvisionDevice where
  rnf :: ProvisionDevice -> ()
rnf ProvisionDevice' {Maybe Text
Maybe (HashMap Text Text)
Maybe NetworkPayload
Text
name :: Text
tags :: Maybe (HashMap Text Text)
networkingConfiguration :: Maybe NetworkPayload
description :: Maybe Text
$sel:name:ProvisionDevice' :: ProvisionDevice -> Text
$sel:tags:ProvisionDevice' :: ProvisionDevice -> Maybe (HashMap Text Text)
$sel:networkingConfiguration:ProvisionDevice' :: ProvisionDevice -> Maybe NetworkPayload
$sel:description:ProvisionDevice' :: ProvisionDevice -> Maybe Text
..} =
    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 NetworkPayload
networkingConfiguration
      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

instance Data.ToHeaders ProvisionDevice where
  toHeaders :: ProvisionDevice -> 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 ProvisionDevice where
  toJSON :: ProvisionDevice -> Value
toJSON ProvisionDevice' {Maybe Text
Maybe (HashMap Text Text)
Maybe NetworkPayload
Text
name :: Text
tags :: Maybe (HashMap Text Text)
networkingConfiguration :: Maybe NetworkPayload
description :: Maybe Text
$sel:name:ProvisionDevice' :: ProvisionDevice -> Text
$sel:tags:ProvisionDevice' :: ProvisionDevice -> Maybe (HashMap Text Text)
$sel:networkingConfiguration:ProvisionDevice' :: ProvisionDevice -> Maybe NetworkPayload
$sel:description:ProvisionDevice' :: ProvisionDevice -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"NetworkingConfiguration" 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 NetworkPayload
networkingConfiguration,
            (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)
          ]
      )

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

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

-- | /See:/ 'newProvisionDeviceResponse' smart constructor.
data ProvisionDeviceResponse = ProvisionDeviceResponse'
  { -- | The device\'s configuration bundle.
    ProvisionDeviceResponse -> Maybe Base64
certificates :: Prelude.Maybe Data.Base64,
    -- | The device\'s ID.
    ProvisionDeviceResponse -> Maybe Text
deviceId :: Prelude.Maybe Prelude.Text,
    -- | The device\'s IoT thing name.
    ProvisionDeviceResponse -> Maybe Text
iotThingName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ProvisionDeviceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The device\'s ARN.
    ProvisionDeviceResponse -> Text
arn :: Prelude.Text,
    -- | The device\'s status.
    ProvisionDeviceResponse -> DeviceStatus
status :: DeviceStatus
  }
  deriving (ProvisionDeviceResponse -> ProvisionDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProvisionDeviceResponse -> ProvisionDeviceResponse -> Bool
$c/= :: ProvisionDeviceResponse -> ProvisionDeviceResponse -> Bool
== :: ProvisionDeviceResponse -> ProvisionDeviceResponse -> Bool
$c== :: ProvisionDeviceResponse -> ProvisionDeviceResponse -> Bool
Prelude.Eq, ReadPrec [ProvisionDeviceResponse]
ReadPrec ProvisionDeviceResponse
Int -> ReadS ProvisionDeviceResponse
ReadS [ProvisionDeviceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProvisionDeviceResponse]
$creadListPrec :: ReadPrec [ProvisionDeviceResponse]
readPrec :: ReadPrec ProvisionDeviceResponse
$creadPrec :: ReadPrec ProvisionDeviceResponse
readList :: ReadS [ProvisionDeviceResponse]
$creadList :: ReadS [ProvisionDeviceResponse]
readsPrec :: Int -> ReadS ProvisionDeviceResponse
$creadsPrec :: Int -> ReadS ProvisionDeviceResponse
Prelude.Read, Int -> ProvisionDeviceResponse -> ShowS
[ProvisionDeviceResponse] -> ShowS
ProvisionDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProvisionDeviceResponse] -> ShowS
$cshowList :: [ProvisionDeviceResponse] -> ShowS
show :: ProvisionDeviceResponse -> String
$cshow :: ProvisionDeviceResponse -> String
showsPrec :: Int -> ProvisionDeviceResponse -> ShowS
$cshowsPrec :: Int -> ProvisionDeviceResponse -> ShowS
Prelude.Show, forall x. Rep ProvisionDeviceResponse x -> ProvisionDeviceResponse
forall x. ProvisionDeviceResponse -> Rep ProvisionDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProvisionDeviceResponse x -> ProvisionDeviceResponse
$cfrom :: forall x. ProvisionDeviceResponse -> Rep ProvisionDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'ProvisionDeviceResponse' 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:
--
-- 'certificates', 'provisionDeviceResponse_certificates' - The device\'s configuration bundle.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'deviceId', 'provisionDeviceResponse_deviceId' - The device\'s ID.
--
-- 'iotThingName', 'provisionDeviceResponse_iotThingName' - The device\'s IoT thing name.
--
-- 'httpStatus', 'provisionDeviceResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'provisionDeviceResponse_arn' - The device\'s ARN.
--
-- 'status', 'provisionDeviceResponse_status' - The device\'s status.
newProvisionDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'status'
  DeviceStatus ->
  ProvisionDeviceResponse
newProvisionDeviceResponse :: Int -> Text -> DeviceStatus -> ProvisionDeviceResponse
newProvisionDeviceResponse
  Int
pHttpStatus_
  Text
pArn_
  DeviceStatus
pStatus_ =
    ProvisionDeviceResponse'
      { $sel:certificates:ProvisionDeviceResponse' :: Maybe Base64
certificates =
          forall a. Maybe a
Prelude.Nothing,
        $sel:deviceId:ProvisionDeviceResponse' :: Maybe Text
deviceId = forall a. Maybe a
Prelude.Nothing,
        $sel:iotThingName:ProvisionDeviceResponse' :: Maybe Text
iotThingName = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ProvisionDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:arn:ProvisionDeviceResponse' :: Text
arn = Text
pArn_,
        $sel:status:ProvisionDeviceResponse' :: DeviceStatus
status = DeviceStatus
pStatus_
      }

-- | The device\'s configuration bundle.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
provisionDeviceResponse_certificates :: Lens.Lens' ProvisionDeviceResponse (Prelude.Maybe Prelude.ByteString)
provisionDeviceResponse_certificates :: Lens' ProvisionDeviceResponse (Maybe ByteString)
provisionDeviceResponse_certificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDeviceResponse' {Maybe Base64
certificates :: Maybe Base64
$sel:certificates:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Maybe Base64
certificates} -> Maybe Base64
certificates) (\s :: ProvisionDeviceResponse
s@ProvisionDeviceResponse' {} Maybe Base64
a -> ProvisionDeviceResponse
s {$sel:certificates:ProvisionDeviceResponse' :: Maybe Base64
certificates = Maybe Base64
a} :: ProvisionDeviceResponse) 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 Iso' Base64 ByteString
Data._Base64

-- | The device\'s ID.
provisionDeviceResponse_deviceId :: Lens.Lens' ProvisionDeviceResponse (Prelude.Maybe Prelude.Text)
provisionDeviceResponse_deviceId :: Lens' ProvisionDeviceResponse (Maybe Text)
provisionDeviceResponse_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDeviceResponse' {Maybe Text
deviceId :: Maybe Text
$sel:deviceId:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Maybe Text
deviceId} -> Maybe Text
deviceId) (\s :: ProvisionDeviceResponse
s@ProvisionDeviceResponse' {} Maybe Text
a -> ProvisionDeviceResponse
s {$sel:deviceId:ProvisionDeviceResponse' :: Maybe Text
deviceId = Maybe Text
a} :: ProvisionDeviceResponse)

-- | The device\'s IoT thing name.
provisionDeviceResponse_iotThingName :: Lens.Lens' ProvisionDeviceResponse (Prelude.Maybe Prelude.Text)
provisionDeviceResponse_iotThingName :: Lens' ProvisionDeviceResponse (Maybe Text)
provisionDeviceResponse_iotThingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDeviceResponse' {Maybe Text
iotThingName :: Maybe Text
$sel:iotThingName:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Maybe Text
iotThingName} -> Maybe Text
iotThingName) (\s :: ProvisionDeviceResponse
s@ProvisionDeviceResponse' {} Maybe Text
a -> ProvisionDeviceResponse
s {$sel:iotThingName:ProvisionDeviceResponse' :: Maybe Text
iotThingName = Maybe Text
a} :: ProvisionDeviceResponse)

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

-- | The device\'s ARN.
provisionDeviceResponse_arn :: Lens.Lens' ProvisionDeviceResponse Prelude.Text
provisionDeviceResponse_arn :: Lens' ProvisionDeviceResponse Text
provisionDeviceResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDeviceResponse' {Text
arn :: Text
$sel:arn:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Text
arn} -> Text
arn) (\s :: ProvisionDeviceResponse
s@ProvisionDeviceResponse' {} Text
a -> ProvisionDeviceResponse
s {$sel:arn:ProvisionDeviceResponse' :: Text
arn = Text
a} :: ProvisionDeviceResponse)

-- | The device\'s status.
provisionDeviceResponse_status :: Lens.Lens' ProvisionDeviceResponse DeviceStatus
provisionDeviceResponse_status :: Lens' ProvisionDeviceResponse DeviceStatus
provisionDeviceResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionDeviceResponse' {DeviceStatus
status :: DeviceStatus
$sel:status:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> DeviceStatus
status} -> DeviceStatus
status) (\s :: ProvisionDeviceResponse
s@ProvisionDeviceResponse' {} DeviceStatus
a -> ProvisionDeviceResponse
s {$sel:status:ProvisionDeviceResponse' :: DeviceStatus
status = DeviceStatus
a} :: ProvisionDeviceResponse)

instance Prelude.NFData ProvisionDeviceResponse where
  rnf :: ProvisionDeviceResponse -> ()
rnf ProvisionDeviceResponse' {Int
Maybe Text
Maybe Base64
Text
DeviceStatus
status :: DeviceStatus
arn :: Text
httpStatus :: Int
iotThingName :: Maybe Text
deviceId :: Maybe Text
certificates :: Maybe Base64
$sel:status:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> DeviceStatus
$sel:arn:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Text
$sel:httpStatus:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Int
$sel:iotThingName:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Maybe Text
$sel:deviceId:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Maybe Text
$sel:certificates:ProvisionDeviceResponse' :: ProvisionDeviceResponse -> Maybe Base64
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
certificates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iotThingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeviceStatus
status