{-# 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.CreateKeysAndCertificate
-- 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 2048-bit RSA key pair and issues an X.509 certificate using
-- the issued public key. You can also call @CreateKeysAndCertificate@ over
-- MQTT from a device, for more information, see
-- <https://docs.aws.amazon.com/iot/latest/developerguide/provision-wo-cert.html#provision-mqtt-api Provisioning MQTT API>.
--
-- __Note__ This is the only time IoT issues the private key for this
-- certificate, so it is important to keep it in a secure location.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateKeysAndCertificate>
-- action.
module Amazonka.IoT.CreateKeysAndCertificate
  ( -- * Creating a Request
    CreateKeysAndCertificate (..),
    newCreateKeysAndCertificate,

    -- * Request Lenses
    createKeysAndCertificate_setAsActive,

    -- * Destructuring the Response
    CreateKeysAndCertificateResponse (..),
    newCreateKeysAndCertificateResponse,

    -- * Response Lenses
    createKeysAndCertificateResponse_certificateArn,
    createKeysAndCertificateResponse_certificateId,
    createKeysAndCertificateResponse_certificatePem,
    createKeysAndCertificateResponse_keyPair,
    createKeysAndCertificateResponse_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

-- | The input for the CreateKeysAndCertificate operation.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateKeysAndCertificateRequest>
-- action.
--
-- /See:/ 'newCreateKeysAndCertificate' smart constructor.
data CreateKeysAndCertificate = CreateKeysAndCertificate'
  { -- | Specifies whether the certificate is active.
    CreateKeysAndCertificate -> Maybe Bool
setAsActive :: Prelude.Maybe Prelude.Bool
  }
  deriving (CreateKeysAndCertificate -> CreateKeysAndCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKeysAndCertificate -> CreateKeysAndCertificate -> Bool
$c/= :: CreateKeysAndCertificate -> CreateKeysAndCertificate -> Bool
== :: CreateKeysAndCertificate -> CreateKeysAndCertificate -> Bool
$c== :: CreateKeysAndCertificate -> CreateKeysAndCertificate -> Bool
Prelude.Eq, ReadPrec [CreateKeysAndCertificate]
ReadPrec CreateKeysAndCertificate
Int -> ReadS CreateKeysAndCertificate
ReadS [CreateKeysAndCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKeysAndCertificate]
$creadListPrec :: ReadPrec [CreateKeysAndCertificate]
readPrec :: ReadPrec CreateKeysAndCertificate
$creadPrec :: ReadPrec CreateKeysAndCertificate
readList :: ReadS [CreateKeysAndCertificate]
$creadList :: ReadS [CreateKeysAndCertificate]
readsPrec :: Int -> ReadS CreateKeysAndCertificate
$creadsPrec :: Int -> ReadS CreateKeysAndCertificate
Prelude.Read, Int -> CreateKeysAndCertificate -> ShowS
[CreateKeysAndCertificate] -> ShowS
CreateKeysAndCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKeysAndCertificate] -> ShowS
$cshowList :: [CreateKeysAndCertificate] -> ShowS
show :: CreateKeysAndCertificate -> String
$cshow :: CreateKeysAndCertificate -> String
showsPrec :: Int -> CreateKeysAndCertificate -> ShowS
$cshowsPrec :: Int -> CreateKeysAndCertificate -> ShowS
Prelude.Show, forall x.
Rep CreateKeysAndCertificate x -> CreateKeysAndCertificate
forall x.
CreateKeysAndCertificate -> Rep CreateKeysAndCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateKeysAndCertificate x -> CreateKeysAndCertificate
$cfrom :: forall x.
CreateKeysAndCertificate -> Rep CreateKeysAndCertificate x
Prelude.Generic)

-- |
-- Create a value of 'CreateKeysAndCertificate' 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:
--
-- 'setAsActive', 'createKeysAndCertificate_setAsActive' - Specifies whether the certificate is active.
newCreateKeysAndCertificate ::
  CreateKeysAndCertificate
newCreateKeysAndCertificate :: CreateKeysAndCertificate
newCreateKeysAndCertificate =
  CreateKeysAndCertificate'
    { $sel:setAsActive:CreateKeysAndCertificate' :: Maybe Bool
setAsActive =
        forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies whether the certificate is active.
createKeysAndCertificate_setAsActive :: Lens.Lens' CreateKeysAndCertificate (Prelude.Maybe Prelude.Bool)
createKeysAndCertificate_setAsActive :: Lens' CreateKeysAndCertificate (Maybe Bool)
createKeysAndCertificate_setAsActive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeysAndCertificate' {Maybe Bool
setAsActive :: Maybe Bool
$sel:setAsActive:CreateKeysAndCertificate' :: CreateKeysAndCertificate -> Maybe Bool
setAsActive} -> Maybe Bool
setAsActive) (\s :: CreateKeysAndCertificate
s@CreateKeysAndCertificate' {} Maybe Bool
a -> CreateKeysAndCertificate
s {$sel:setAsActive:CreateKeysAndCertificate' :: Maybe Bool
setAsActive = Maybe Bool
a} :: CreateKeysAndCertificate)

instance Core.AWSRequest CreateKeysAndCertificate where
  type
    AWSResponse CreateKeysAndCertificate =
      CreateKeysAndCertificateResponse
  request :: (Service -> Service)
-> CreateKeysAndCertificate -> Request CreateKeysAndCertificate
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 CreateKeysAndCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateKeysAndCertificate)))
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 Text
-> Maybe Text
-> Maybe KeyPair
-> Int
-> CreateKeysAndCertificateResponse
CreateKeysAndCertificateResponse'
            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
"certificateArn")
            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
"certificateId")
            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
"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
"keyPair")
            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 CreateKeysAndCertificate where
  hashWithSalt :: Int -> CreateKeysAndCertificate -> Int
hashWithSalt Int
_salt CreateKeysAndCertificate' {Maybe Bool
setAsActive :: Maybe Bool
$sel:setAsActive:CreateKeysAndCertificate' :: CreateKeysAndCertificate -> Maybe Bool
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
setAsActive

instance Prelude.NFData CreateKeysAndCertificate where
  rnf :: CreateKeysAndCertificate -> ()
rnf CreateKeysAndCertificate' {Maybe Bool
setAsActive :: Maybe Bool
$sel:setAsActive:CreateKeysAndCertificate' :: CreateKeysAndCertificate -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
setAsActive

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

instance Data.ToJSON CreateKeysAndCertificate where
  toJSON :: CreateKeysAndCertificate -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CreateKeysAndCertificate where
  toPath :: CreateKeysAndCertificate -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/keys-and-certificate"

instance Data.ToQuery CreateKeysAndCertificate where
  toQuery :: CreateKeysAndCertificate -> QueryString
toQuery CreateKeysAndCertificate' {Maybe Bool
setAsActive :: Maybe Bool
$sel:setAsActive:CreateKeysAndCertificate' :: CreateKeysAndCertificate -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"setAsActive" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
setAsActive]

-- | The output of the CreateKeysAndCertificate operation.
--
-- /See:/ 'newCreateKeysAndCertificateResponse' smart constructor.
data CreateKeysAndCertificateResponse = CreateKeysAndCertificateResponse'
  { -- | The ARN of the certificate.
    CreateKeysAndCertificateResponse -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the certificate. IoT issues a default subject name for the
    -- certificate (for example, IoT Certificate).
    CreateKeysAndCertificateResponse -> Maybe Text
certificateId :: Prelude.Maybe Prelude.Text,
    -- | The certificate data, in PEM format.
    CreateKeysAndCertificateResponse -> Maybe Text
certificatePem :: Prelude.Maybe Prelude.Text,
    -- | The generated key pair.
    CreateKeysAndCertificateResponse -> Maybe KeyPair
keyPair :: Prelude.Maybe KeyPair,
    -- | The response's http status code.
    CreateKeysAndCertificateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateKeysAndCertificateResponse
-> CreateKeysAndCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKeysAndCertificateResponse
-> CreateKeysAndCertificateResponse -> Bool
$c/= :: CreateKeysAndCertificateResponse
-> CreateKeysAndCertificateResponse -> Bool
== :: CreateKeysAndCertificateResponse
-> CreateKeysAndCertificateResponse -> Bool
$c== :: CreateKeysAndCertificateResponse
-> CreateKeysAndCertificateResponse -> Bool
Prelude.Eq, Int -> CreateKeysAndCertificateResponse -> ShowS
[CreateKeysAndCertificateResponse] -> ShowS
CreateKeysAndCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKeysAndCertificateResponse] -> ShowS
$cshowList :: [CreateKeysAndCertificateResponse] -> ShowS
show :: CreateKeysAndCertificateResponse -> String
$cshow :: CreateKeysAndCertificateResponse -> String
showsPrec :: Int -> CreateKeysAndCertificateResponse -> ShowS
$cshowsPrec :: Int -> CreateKeysAndCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep CreateKeysAndCertificateResponse x
-> CreateKeysAndCertificateResponse
forall x.
CreateKeysAndCertificateResponse
-> Rep CreateKeysAndCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateKeysAndCertificateResponse x
-> CreateKeysAndCertificateResponse
$cfrom :: forall x.
CreateKeysAndCertificateResponse
-> Rep CreateKeysAndCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateKeysAndCertificateResponse' 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:
--
-- 'certificateArn', 'createKeysAndCertificateResponse_certificateArn' - The ARN of the certificate.
--
-- 'certificateId', 'createKeysAndCertificateResponse_certificateId' - The ID of the certificate. IoT issues a default subject name for the
-- certificate (for example, IoT Certificate).
--
-- 'certificatePem', 'createKeysAndCertificateResponse_certificatePem' - The certificate data, in PEM format.
--
-- 'keyPair', 'createKeysAndCertificateResponse_keyPair' - The generated key pair.
--
-- 'httpStatus', 'createKeysAndCertificateResponse_httpStatus' - The response's http status code.
newCreateKeysAndCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateKeysAndCertificateResponse
newCreateKeysAndCertificateResponse :: Int -> CreateKeysAndCertificateResponse
newCreateKeysAndCertificateResponse Int
pHttpStatus_ =
  CreateKeysAndCertificateResponse'
    { $sel:certificateArn:CreateKeysAndCertificateResponse' :: Maybe Text
certificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:certificateId:CreateKeysAndCertificateResponse' :: Maybe Text
certificateId = forall a. Maybe a
Prelude.Nothing,
      $sel:certificatePem:CreateKeysAndCertificateResponse' :: Maybe Text
certificatePem = forall a. Maybe a
Prelude.Nothing,
      $sel:keyPair:CreateKeysAndCertificateResponse' :: Maybe KeyPair
keyPair = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateKeysAndCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the certificate.
createKeysAndCertificateResponse_certificateArn :: Lens.Lens' CreateKeysAndCertificateResponse (Prelude.Maybe Prelude.Text)
createKeysAndCertificateResponse_certificateArn :: Lens' CreateKeysAndCertificateResponse (Maybe Text)
createKeysAndCertificateResponse_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeysAndCertificateResponse' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: CreateKeysAndCertificateResponse
s@CreateKeysAndCertificateResponse' {} Maybe Text
a -> CreateKeysAndCertificateResponse
s {$sel:certificateArn:CreateKeysAndCertificateResponse' :: Maybe Text
certificateArn = Maybe Text
a} :: CreateKeysAndCertificateResponse)

-- | The ID of the certificate. IoT issues a default subject name for the
-- certificate (for example, IoT Certificate).
createKeysAndCertificateResponse_certificateId :: Lens.Lens' CreateKeysAndCertificateResponse (Prelude.Maybe Prelude.Text)
createKeysAndCertificateResponse_certificateId :: Lens' CreateKeysAndCertificateResponse (Maybe Text)
createKeysAndCertificateResponse_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeysAndCertificateResponse' {Maybe Text
certificateId :: Maybe Text
$sel:certificateId:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe Text
certificateId} -> Maybe Text
certificateId) (\s :: CreateKeysAndCertificateResponse
s@CreateKeysAndCertificateResponse' {} Maybe Text
a -> CreateKeysAndCertificateResponse
s {$sel:certificateId:CreateKeysAndCertificateResponse' :: Maybe Text
certificateId = Maybe Text
a} :: CreateKeysAndCertificateResponse)

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

-- | The generated key pair.
createKeysAndCertificateResponse_keyPair :: Lens.Lens' CreateKeysAndCertificateResponse (Prelude.Maybe KeyPair)
createKeysAndCertificateResponse_keyPair :: Lens' CreateKeysAndCertificateResponse (Maybe KeyPair)
createKeysAndCertificateResponse_keyPair = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeysAndCertificateResponse' {Maybe KeyPair
keyPair :: Maybe KeyPair
$sel:keyPair:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe KeyPair
keyPair} -> Maybe KeyPair
keyPair) (\s :: CreateKeysAndCertificateResponse
s@CreateKeysAndCertificateResponse' {} Maybe KeyPair
a -> CreateKeysAndCertificateResponse
s {$sel:keyPair:CreateKeysAndCertificateResponse' :: Maybe KeyPair
keyPair = Maybe KeyPair
a} :: CreateKeysAndCertificateResponse)

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

instance
  Prelude.NFData
    CreateKeysAndCertificateResponse
  where
  rnf :: CreateKeysAndCertificateResponse -> ()
rnf CreateKeysAndCertificateResponse' {Int
Maybe Text
Maybe KeyPair
httpStatus :: Int
keyPair :: Maybe KeyPair
certificatePem :: Maybe Text
certificateId :: Maybe Text
certificateArn :: Maybe Text
$sel:httpStatus:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Int
$sel:keyPair:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe KeyPair
$sel:certificatePem:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe Text
$sel:certificateId:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe Text
$sel:certificateArn:CreateKeysAndCertificateResponse' :: CreateKeysAndCertificateResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 KeyPair
keyPair
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus