{-# 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.IoT.RegisterThing
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provisions a thing in the device registry. RegisterThing calls other IoT
-- control plane APIs. These calls might exceed your account level
-- <https://docs.aws.amazon.com/general/latest/gr/aws_service_limits.html#limits_iot IoT Throttling Limits>
-- and cause throttle errors. Please contact
-- <https://console.aws.amazon.com/support/home Amazon Web Services Customer Support>
-- to raise your throttling limits if necessary.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions RegisterThing>
-- action.
module Amazonka.IoT.RegisterThing
  ( -- * Creating a Request
    RegisterThing (..),
    newRegisterThing,

    -- * Request Lenses
    registerThing_parameters,
    registerThing_templateBody,

    -- * Destructuring the Response
    RegisterThingResponse (..),
    newRegisterThingResponse,

    -- * Response Lenses
    registerThingResponse_certificatePem,
    registerThingResponse_resourceArns,
    registerThingResponse_httpStatus,
  )
where

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

-- | /See:/ 'newRegisterThing' smart constructor.
data RegisterThing = RegisterThing'
  { -- | The parameters for provisioning a thing. See
    -- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-template.html Provisioning Templates>
    -- for more information.
    RegisterThing -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The provisioning template. See
    -- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-w-cert.html Provisioning Devices That Have Device Certificates>
    -- for more information.
    RegisterThing -> Text
templateBody :: Prelude.Text
  }
  deriving (RegisterThing -> RegisterThing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterThing -> RegisterThing -> Bool
$c/= :: RegisterThing -> RegisterThing -> Bool
== :: RegisterThing -> RegisterThing -> Bool
$c== :: RegisterThing -> RegisterThing -> Bool
Prelude.Eq, ReadPrec [RegisterThing]
ReadPrec RegisterThing
Int -> ReadS RegisterThing
ReadS [RegisterThing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterThing]
$creadListPrec :: ReadPrec [RegisterThing]
readPrec :: ReadPrec RegisterThing
$creadPrec :: ReadPrec RegisterThing
readList :: ReadS [RegisterThing]
$creadList :: ReadS [RegisterThing]
readsPrec :: Int -> ReadS RegisterThing
$creadsPrec :: Int -> ReadS RegisterThing
Prelude.Read, Int -> RegisterThing -> ShowS
[RegisterThing] -> ShowS
RegisterThing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterThing] -> ShowS
$cshowList :: [RegisterThing] -> ShowS
show :: RegisterThing -> String
$cshow :: RegisterThing -> String
showsPrec :: Int -> RegisterThing -> ShowS
$cshowsPrec :: Int -> RegisterThing -> ShowS
Prelude.Show, forall x. Rep RegisterThing x -> RegisterThing
forall x. RegisterThing -> Rep RegisterThing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterThing x -> RegisterThing
$cfrom :: forall x. RegisterThing -> Rep RegisterThing x
Prelude.Generic)

-- |
-- Create a value of 'RegisterThing' 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:
--
-- 'parameters', 'registerThing_parameters' - The parameters for provisioning a thing. See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-template.html Provisioning Templates>
-- for more information.
--
-- 'templateBody', 'registerThing_templateBody' - The provisioning template. See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-w-cert.html Provisioning Devices That Have Device Certificates>
-- for more information.
newRegisterThing ::
  -- | 'templateBody'
  Prelude.Text ->
  RegisterThing
newRegisterThing :: Text -> RegisterThing
newRegisterThing Text
pTemplateBody_ =
  RegisterThing'
    { $sel:parameters:RegisterThing' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:templateBody:RegisterThing' :: Text
templateBody = Text
pTemplateBody_
    }

-- | The parameters for provisioning a thing. See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-template.html Provisioning Templates>
-- for more information.
registerThing_parameters :: Lens.Lens' RegisterThing (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
registerThing_parameters :: Lens' RegisterThing (Maybe (HashMap Text Text))
registerThing_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterThing' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:RegisterThing' :: RegisterThing -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: RegisterThing
s@RegisterThing' {} Maybe (HashMap Text Text)
a -> RegisterThing
s {$sel:parameters:RegisterThing' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: RegisterThing) 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 provisioning template. See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-w-cert.html Provisioning Devices That Have Device Certificates>
-- for more information.
registerThing_templateBody :: Lens.Lens' RegisterThing Prelude.Text
registerThing_templateBody :: Lens' RegisterThing Text
registerThing_templateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterThing' {Text
templateBody :: Text
$sel:templateBody:RegisterThing' :: RegisterThing -> Text
templateBody} -> Text
templateBody) (\s :: RegisterThing
s@RegisterThing' {} Text
a -> RegisterThing
s {$sel:templateBody:RegisterThing' :: Text
templateBody = Text
a} :: RegisterThing)

instance Core.AWSRequest RegisterThing where
  type
    AWSResponse RegisterThing =
      RegisterThingResponse
  request :: (Service -> Service) -> RegisterThing -> Request RegisterThing
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 RegisterThing
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterThing)))
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 (HashMap Text Text) -> Int -> RegisterThingResponse
RegisterThingResponse'
            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
"certificatePem")
            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
"resourceArns" 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 RegisterThing where
  hashWithSalt :: Int -> RegisterThing -> Int
hashWithSalt Int
_salt RegisterThing' {Maybe (HashMap Text Text)
Text
templateBody :: Text
parameters :: Maybe (HashMap Text Text)
$sel:templateBody:RegisterThing' :: RegisterThing -> Text
$sel:parameters:RegisterThing' :: RegisterThing -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateBody

instance Prelude.NFData RegisterThing where
  rnf :: RegisterThing -> ()
rnf RegisterThing' {Maybe (HashMap Text Text)
Text
templateBody :: Text
parameters :: Maybe (HashMap Text Text)
$sel:templateBody:RegisterThing' :: RegisterThing -> Text
$sel:parameters:RegisterThing' :: RegisterThing -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateBody

instance Data.ToHeaders RegisterThing where
  toHeaders :: RegisterThing -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON RegisterThing where
  toJSON :: RegisterThing -> Value
toJSON RegisterThing' {Maybe (HashMap Text Text)
Text
templateBody :: Text
parameters :: Maybe (HashMap Text Text)
$sel:templateBody:RegisterThing' :: RegisterThing -> Text
$sel:parameters:RegisterThing' :: RegisterThing -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"parameters" 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)
parameters,
            forall a. a -> Maybe a
Prelude.Just (Key
"templateBody" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
templateBody)
          ]
      )

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

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

-- | /See:/ 'newRegisterThingResponse' smart constructor.
data RegisterThingResponse = RegisterThingResponse'
  { -- | The certificate data, in PEM format.
    RegisterThingResponse -> Maybe Text
certificatePem :: Prelude.Maybe Prelude.Text,
    -- | ARNs for the generated resources.
    RegisterThingResponse -> Maybe (HashMap Text Text)
resourceArns :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    RegisterThingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterThingResponse -> RegisterThingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterThingResponse -> RegisterThingResponse -> Bool
$c/= :: RegisterThingResponse -> RegisterThingResponse -> Bool
== :: RegisterThingResponse -> RegisterThingResponse -> Bool
$c== :: RegisterThingResponse -> RegisterThingResponse -> Bool
Prelude.Eq, ReadPrec [RegisterThingResponse]
ReadPrec RegisterThingResponse
Int -> ReadS RegisterThingResponse
ReadS [RegisterThingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterThingResponse]
$creadListPrec :: ReadPrec [RegisterThingResponse]
readPrec :: ReadPrec RegisterThingResponse
$creadPrec :: ReadPrec RegisterThingResponse
readList :: ReadS [RegisterThingResponse]
$creadList :: ReadS [RegisterThingResponse]
readsPrec :: Int -> ReadS RegisterThingResponse
$creadsPrec :: Int -> ReadS RegisterThingResponse
Prelude.Read, Int -> RegisterThingResponse -> ShowS
[RegisterThingResponse] -> ShowS
RegisterThingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterThingResponse] -> ShowS
$cshowList :: [RegisterThingResponse] -> ShowS
show :: RegisterThingResponse -> String
$cshow :: RegisterThingResponse -> String
showsPrec :: Int -> RegisterThingResponse -> ShowS
$cshowsPrec :: Int -> RegisterThingResponse -> ShowS
Prelude.Show, forall x. Rep RegisterThingResponse x -> RegisterThingResponse
forall x. RegisterThingResponse -> Rep RegisterThingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterThingResponse x -> RegisterThingResponse
$cfrom :: forall x. RegisterThingResponse -> Rep RegisterThingResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterThingResponse' 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:
--
-- 'certificatePem', 'registerThingResponse_certificatePem' - The certificate data, in PEM format.
--
-- 'resourceArns', 'registerThingResponse_resourceArns' - ARNs for the generated resources.
--
-- 'httpStatus', 'registerThingResponse_httpStatus' - The response's http status code.
newRegisterThingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterThingResponse
newRegisterThingResponse :: Int -> RegisterThingResponse
newRegisterThingResponse Int
pHttpStatus_ =
  RegisterThingResponse'
    { $sel:certificatePem:RegisterThingResponse' :: Maybe Text
certificatePem =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArns:RegisterThingResponse' :: Maybe (HashMap Text Text)
resourceArns = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterThingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The certificate data, in PEM format.
registerThingResponse_certificatePem :: Lens.Lens' RegisterThingResponse (Prelude.Maybe Prelude.Text)
registerThingResponse_certificatePem :: Lens' RegisterThingResponse (Maybe Text)
registerThingResponse_certificatePem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterThingResponse' {Maybe Text
certificatePem :: Maybe Text
$sel:certificatePem:RegisterThingResponse' :: RegisterThingResponse -> Maybe Text
certificatePem} -> Maybe Text
certificatePem) (\s :: RegisterThingResponse
s@RegisterThingResponse' {} Maybe Text
a -> RegisterThingResponse
s {$sel:certificatePem:RegisterThingResponse' :: Maybe Text
certificatePem = Maybe Text
a} :: RegisterThingResponse)

-- | ARNs for the generated resources.
registerThingResponse_resourceArns :: Lens.Lens' RegisterThingResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
registerThingResponse_resourceArns :: Lens' RegisterThingResponse (Maybe (HashMap Text Text))
registerThingResponse_resourceArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterThingResponse' {Maybe (HashMap Text Text)
resourceArns :: Maybe (HashMap Text Text)
$sel:resourceArns:RegisterThingResponse' :: RegisterThingResponse -> Maybe (HashMap Text Text)
resourceArns} -> Maybe (HashMap Text Text)
resourceArns) (\s :: RegisterThingResponse
s@RegisterThingResponse' {} Maybe (HashMap Text Text)
a -> RegisterThingResponse
s {$sel:resourceArns:RegisterThingResponse' :: Maybe (HashMap Text Text)
resourceArns = Maybe (HashMap Text Text)
a} :: RegisterThingResponse) 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.
registerThingResponse_httpStatus :: Lens.Lens' RegisterThingResponse Prelude.Int
registerThingResponse_httpStatus :: Lens' RegisterThingResponse Int
registerThingResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterThingResponse' {Int
httpStatus :: Int
$sel:httpStatus:RegisterThingResponse' :: RegisterThingResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RegisterThingResponse
s@RegisterThingResponse' {} Int
a -> RegisterThingResponse
s {$sel:httpStatus:RegisterThingResponse' :: Int
httpStatus = Int
a} :: RegisterThingResponse)

instance Prelude.NFData RegisterThingResponse where
  rnf :: RegisterThingResponse -> ()
rnf RegisterThingResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
resourceArns :: Maybe (HashMap Text Text)
certificatePem :: Maybe Text
$sel:httpStatus:RegisterThingResponse' :: RegisterThingResponse -> Int
$sel:resourceArns:RegisterThingResponse' :: RegisterThingResponse -> Maybe (HashMap Text Text)
$sel:certificatePem:RegisterThingResponse' :: RegisterThingResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificatePem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
resourceArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus