{-# 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.RegisterCertificateWithoutCA
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Register a certificate that does not have a certificate authority (CA).
-- For supported certificates, consult
-- <https://docs.aws.amazon.com/iot/latest/developerguide/x509-client-certs.html#x509-cert-algorithms Certificate signing algorithms supported by IoT>.
module Amazonka.IoT.RegisterCertificateWithoutCA
  ( -- * Creating a Request
    RegisterCertificateWithoutCA (..),
    newRegisterCertificateWithoutCA,

    -- * Request Lenses
    registerCertificateWithoutCA_status,
    registerCertificateWithoutCA_certificatePem,

    -- * Destructuring the Response
    RegisterCertificateWithoutCAResponse (..),
    newRegisterCertificateWithoutCAResponse,

    -- * Response Lenses
    registerCertificateWithoutCAResponse_certificateArn,
    registerCertificateWithoutCAResponse_certificateId,
    registerCertificateWithoutCAResponse_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:/ 'newRegisterCertificateWithoutCA' smart constructor.
data RegisterCertificateWithoutCA = RegisterCertificateWithoutCA'
  { -- | The status of the register certificate request.
    RegisterCertificateWithoutCA -> Maybe CertificateStatus
status :: Prelude.Maybe CertificateStatus,
    -- | The certificate data, in PEM format.
    RegisterCertificateWithoutCA -> Text
certificatePem :: Prelude.Text
  }
  deriving (RegisterCertificateWithoutCA
-> RegisterCertificateWithoutCA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterCertificateWithoutCA
-> RegisterCertificateWithoutCA -> Bool
$c/= :: RegisterCertificateWithoutCA
-> RegisterCertificateWithoutCA -> Bool
== :: RegisterCertificateWithoutCA
-> RegisterCertificateWithoutCA -> Bool
$c== :: RegisterCertificateWithoutCA
-> RegisterCertificateWithoutCA -> Bool
Prelude.Eq, ReadPrec [RegisterCertificateWithoutCA]
ReadPrec RegisterCertificateWithoutCA
Int -> ReadS RegisterCertificateWithoutCA
ReadS [RegisterCertificateWithoutCA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterCertificateWithoutCA]
$creadListPrec :: ReadPrec [RegisterCertificateWithoutCA]
readPrec :: ReadPrec RegisterCertificateWithoutCA
$creadPrec :: ReadPrec RegisterCertificateWithoutCA
readList :: ReadS [RegisterCertificateWithoutCA]
$creadList :: ReadS [RegisterCertificateWithoutCA]
readsPrec :: Int -> ReadS RegisterCertificateWithoutCA
$creadsPrec :: Int -> ReadS RegisterCertificateWithoutCA
Prelude.Read, Int -> RegisterCertificateWithoutCA -> ShowS
[RegisterCertificateWithoutCA] -> ShowS
RegisterCertificateWithoutCA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterCertificateWithoutCA] -> ShowS
$cshowList :: [RegisterCertificateWithoutCA] -> ShowS
show :: RegisterCertificateWithoutCA -> String
$cshow :: RegisterCertificateWithoutCA -> String
showsPrec :: Int -> RegisterCertificateWithoutCA -> ShowS
$cshowsPrec :: Int -> RegisterCertificateWithoutCA -> ShowS
Prelude.Show, forall x.
Rep RegisterCertificateWithoutCA x -> RegisterCertificateWithoutCA
forall x.
RegisterCertificateWithoutCA -> Rep RegisterCertificateWithoutCA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterCertificateWithoutCA x -> RegisterCertificateWithoutCA
$cfrom :: forall x.
RegisterCertificateWithoutCA -> Rep RegisterCertificateWithoutCA x
Prelude.Generic)

-- |
-- Create a value of 'RegisterCertificateWithoutCA' 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:
--
-- 'status', 'registerCertificateWithoutCA_status' - The status of the register certificate request.
--
-- 'certificatePem', 'registerCertificateWithoutCA_certificatePem' - The certificate data, in PEM format.
newRegisterCertificateWithoutCA ::
  -- | 'certificatePem'
  Prelude.Text ->
  RegisterCertificateWithoutCA
newRegisterCertificateWithoutCA :: Text -> RegisterCertificateWithoutCA
newRegisterCertificateWithoutCA Text
pCertificatePem_ =
  RegisterCertificateWithoutCA'
    { $sel:status:RegisterCertificateWithoutCA' :: Maybe CertificateStatus
status =
        forall a. Maybe a
Prelude.Nothing,
      $sel:certificatePem:RegisterCertificateWithoutCA' :: Text
certificatePem = Text
pCertificatePem_
    }

-- | The status of the register certificate request.
registerCertificateWithoutCA_status :: Lens.Lens' RegisterCertificateWithoutCA (Prelude.Maybe CertificateStatus)
registerCertificateWithoutCA_status :: Lens' RegisterCertificateWithoutCA (Maybe CertificateStatus)
registerCertificateWithoutCA_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterCertificateWithoutCA' {Maybe CertificateStatus
status :: Maybe CertificateStatus
$sel:status:RegisterCertificateWithoutCA' :: RegisterCertificateWithoutCA -> Maybe CertificateStatus
status} -> Maybe CertificateStatus
status) (\s :: RegisterCertificateWithoutCA
s@RegisterCertificateWithoutCA' {} Maybe CertificateStatus
a -> RegisterCertificateWithoutCA
s {$sel:status:RegisterCertificateWithoutCA' :: Maybe CertificateStatus
status = Maybe CertificateStatus
a} :: RegisterCertificateWithoutCA)

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

instance Core.AWSRequest RegisterCertificateWithoutCA where
  type
    AWSResponse RegisterCertificateWithoutCA =
      RegisterCertificateWithoutCAResponse
  request :: (Service -> Service)
-> RegisterCertificateWithoutCA
-> Request RegisterCertificateWithoutCA
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 RegisterCertificateWithoutCA
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterCertificateWithoutCA)))
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 -> Int -> RegisterCertificateWithoutCAResponse
RegisterCertificateWithoutCAResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    RegisterCertificateWithoutCA
  where
  hashWithSalt :: Int -> RegisterCertificateWithoutCA -> Int
hashWithSalt Int
_salt RegisterCertificateWithoutCA' {Maybe CertificateStatus
Text
certificatePem :: Text
status :: Maybe CertificateStatus
$sel:certificatePem:RegisterCertificateWithoutCA' :: RegisterCertificateWithoutCA -> Text
$sel:status:RegisterCertificateWithoutCA' :: RegisterCertificateWithoutCA -> Maybe CertificateStatus
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificatePem

instance Prelude.NFData RegisterCertificateWithoutCA where
  rnf :: RegisterCertificateWithoutCA -> ()
rnf RegisterCertificateWithoutCA' {Maybe CertificateStatus
Text
certificatePem :: Text
status :: Maybe CertificateStatus
$sel:certificatePem:RegisterCertificateWithoutCA' :: RegisterCertificateWithoutCA -> Text
$sel:status:RegisterCertificateWithoutCA' :: RegisterCertificateWithoutCA -> Maybe CertificateStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
certificatePem

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

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

instance Data.ToPath RegisterCertificateWithoutCA where
  toPath :: RegisterCertificateWithoutCA -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/certificate/register-no-ca"

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

-- | /See:/ 'newRegisterCertificateWithoutCAResponse' smart constructor.
data RegisterCertificateWithoutCAResponse = RegisterCertificateWithoutCAResponse'
  { -- | The Amazon Resource Name (ARN) of the registered certificate.
    RegisterCertificateWithoutCAResponse -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the registered certificate. (The last part of the certificate
    -- ARN contains the certificate ID.
    RegisterCertificateWithoutCAResponse -> Maybe Text
certificateId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterCertificateWithoutCAResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterCertificateWithoutCAResponse
-> RegisterCertificateWithoutCAResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterCertificateWithoutCAResponse
-> RegisterCertificateWithoutCAResponse -> Bool
$c/= :: RegisterCertificateWithoutCAResponse
-> RegisterCertificateWithoutCAResponse -> Bool
== :: RegisterCertificateWithoutCAResponse
-> RegisterCertificateWithoutCAResponse -> Bool
$c== :: RegisterCertificateWithoutCAResponse
-> RegisterCertificateWithoutCAResponse -> Bool
Prelude.Eq, ReadPrec [RegisterCertificateWithoutCAResponse]
ReadPrec RegisterCertificateWithoutCAResponse
Int -> ReadS RegisterCertificateWithoutCAResponse
ReadS [RegisterCertificateWithoutCAResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterCertificateWithoutCAResponse]
$creadListPrec :: ReadPrec [RegisterCertificateWithoutCAResponse]
readPrec :: ReadPrec RegisterCertificateWithoutCAResponse
$creadPrec :: ReadPrec RegisterCertificateWithoutCAResponse
readList :: ReadS [RegisterCertificateWithoutCAResponse]
$creadList :: ReadS [RegisterCertificateWithoutCAResponse]
readsPrec :: Int -> ReadS RegisterCertificateWithoutCAResponse
$creadsPrec :: Int -> ReadS RegisterCertificateWithoutCAResponse
Prelude.Read, Int -> RegisterCertificateWithoutCAResponse -> ShowS
[RegisterCertificateWithoutCAResponse] -> ShowS
RegisterCertificateWithoutCAResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterCertificateWithoutCAResponse] -> ShowS
$cshowList :: [RegisterCertificateWithoutCAResponse] -> ShowS
show :: RegisterCertificateWithoutCAResponse -> String
$cshow :: RegisterCertificateWithoutCAResponse -> String
showsPrec :: Int -> RegisterCertificateWithoutCAResponse -> ShowS
$cshowsPrec :: Int -> RegisterCertificateWithoutCAResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterCertificateWithoutCAResponse x
-> RegisterCertificateWithoutCAResponse
forall x.
RegisterCertificateWithoutCAResponse
-> Rep RegisterCertificateWithoutCAResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterCertificateWithoutCAResponse x
-> RegisterCertificateWithoutCAResponse
$cfrom :: forall x.
RegisterCertificateWithoutCAResponse
-> Rep RegisterCertificateWithoutCAResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterCertificateWithoutCAResponse' 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', 'registerCertificateWithoutCAResponse_certificateArn' - The Amazon Resource Name (ARN) of the registered certificate.
--
-- 'certificateId', 'registerCertificateWithoutCAResponse_certificateId' - The ID of the registered certificate. (The last part of the certificate
-- ARN contains the certificate ID.
--
-- 'httpStatus', 'registerCertificateWithoutCAResponse_httpStatus' - The response's http status code.
newRegisterCertificateWithoutCAResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterCertificateWithoutCAResponse
newRegisterCertificateWithoutCAResponse :: Int -> RegisterCertificateWithoutCAResponse
newRegisterCertificateWithoutCAResponse Int
pHttpStatus_ =
  RegisterCertificateWithoutCAResponse'
    { $sel:certificateArn:RegisterCertificateWithoutCAResponse' :: Maybe Text
certificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:certificateId:RegisterCertificateWithoutCAResponse' :: Maybe Text
certificateId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterCertificateWithoutCAResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the registered certificate.
registerCertificateWithoutCAResponse_certificateArn :: Lens.Lens' RegisterCertificateWithoutCAResponse (Prelude.Maybe Prelude.Text)
registerCertificateWithoutCAResponse_certificateArn :: Lens' RegisterCertificateWithoutCAResponse (Maybe Text)
registerCertificateWithoutCAResponse_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterCertificateWithoutCAResponse' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:RegisterCertificateWithoutCAResponse' :: RegisterCertificateWithoutCAResponse -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: RegisterCertificateWithoutCAResponse
s@RegisterCertificateWithoutCAResponse' {} Maybe Text
a -> RegisterCertificateWithoutCAResponse
s {$sel:certificateArn:RegisterCertificateWithoutCAResponse' :: Maybe Text
certificateArn = Maybe Text
a} :: RegisterCertificateWithoutCAResponse)

-- | The ID of the registered certificate. (The last part of the certificate
-- ARN contains the certificate ID.
registerCertificateWithoutCAResponse_certificateId :: Lens.Lens' RegisterCertificateWithoutCAResponse (Prelude.Maybe Prelude.Text)
registerCertificateWithoutCAResponse_certificateId :: Lens' RegisterCertificateWithoutCAResponse (Maybe Text)
registerCertificateWithoutCAResponse_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterCertificateWithoutCAResponse' {Maybe Text
certificateId :: Maybe Text
$sel:certificateId:RegisterCertificateWithoutCAResponse' :: RegisterCertificateWithoutCAResponse -> Maybe Text
certificateId} -> Maybe Text
certificateId) (\s :: RegisterCertificateWithoutCAResponse
s@RegisterCertificateWithoutCAResponse' {} Maybe Text
a -> RegisterCertificateWithoutCAResponse
s {$sel:certificateId:RegisterCertificateWithoutCAResponse' :: Maybe Text
certificateId = Maybe Text
a} :: RegisterCertificateWithoutCAResponse)

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

instance
  Prelude.NFData
    RegisterCertificateWithoutCAResponse
  where
  rnf :: RegisterCertificateWithoutCAResponse -> ()
rnf RegisterCertificateWithoutCAResponse' {Int
Maybe Text
httpStatus :: Int
certificateId :: Maybe Text
certificateArn :: Maybe Text
$sel:httpStatus:RegisterCertificateWithoutCAResponse' :: RegisterCertificateWithoutCAResponse -> Int
$sel:certificateId:RegisterCertificateWithoutCAResponse' :: RegisterCertificateWithoutCAResponse -> Maybe Text
$sel:certificateArn:RegisterCertificateWithoutCAResponse' :: RegisterCertificateWithoutCAResponse -> 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 Int
httpStatus