{-# 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.CloudFront.CreatePublicKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uploads a public key to CloudFront that you can use with
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/PrivateContent.html signed URLs and signed cookies>,
-- or with
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/field-level-encryption.html field-level encryption>.
module Amazonka.CloudFront.CreatePublicKey
  ( -- * Creating a Request
    CreatePublicKey (..),
    newCreatePublicKey,

    -- * Request Lenses
    createPublicKey_publicKeyConfig,

    -- * Destructuring the Response
    CreatePublicKeyResponse (..),
    newCreatePublicKeyResponse,

    -- * Response Lenses
    createPublicKeyResponse_eTag,
    createPublicKeyResponse_location,
    createPublicKeyResponse_publicKey,
    createPublicKeyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreatePublicKey' smart constructor.
data CreatePublicKey = CreatePublicKey'
  { -- | A CloudFront public key configuration.
    CreatePublicKey -> PublicKeyConfig
publicKeyConfig :: PublicKeyConfig
  }
  deriving (CreatePublicKey -> CreatePublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePublicKey -> CreatePublicKey -> Bool
$c/= :: CreatePublicKey -> CreatePublicKey -> Bool
== :: CreatePublicKey -> CreatePublicKey -> Bool
$c== :: CreatePublicKey -> CreatePublicKey -> Bool
Prelude.Eq, ReadPrec [CreatePublicKey]
ReadPrec CreatePublicKey
Int -> ReadS CreatePublicKey
ReadS [CreatePublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePublicKey]
$creadListPrec :: ReadPrec [CreatePublicKey]
readPrec :: ReadPrec CreatePublicKey
$creadPrec :: ReadPrec CreatePublicKey
readList :: ReadS [CreatePublicKey]
$creadList :: ReadS [CreatePublicKey]
readsPrec :: Int -> ReadS CreatePublicKey
$creadsPrec :: Int -> ReadS CreatePublicKey
Prelude.Read, Int -> CreatePublicKey -> ShowS
[CreatePublicKey] -> ShowS
CreatePublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePublicKey] -> ShowS
$cshowList :: [CreatePublicKey] -> ShowS
show :: CreatePublicKey -> String
$cshow :: CreatePublicKey -> String
showsPrec :: Int -> CreatePublicKey -> ShowS
$cshowsPrec :: Int -> CreatePublicKey -> ShowS
Prelude.Show, forall x. Rep CreatePublicKey x -> CreatePublicKey
forall x. CreatePublicKey -> Rep CreatePublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePublicKey x -> CreatePublicKey
$cfrom :: forall x. CreatePublicKey -> Rep CreatePublicKey x
Prelude.Generic)

-- |
-- Create a value of 'CreatePublicKey' 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:
--
-- 'publicKeyConfig', 'createPublicKey_publicKeyConfig' - A CloudFront public key configuration.
newCreatePublicKey ::
  -- | 'publicKeyConfig'
  PublicKeyConfig ->
  CreatePublicKey
newCreatePublicKey :: PublicKeyConfig -> CreatePublicKey
newCreatePublicKey PublicKeyConfig
pPublicKeyConfig_ =
  CreatePublicKey'
    { $sel:publicKeyConfig:CreatePublicKey' :: PublicKeyConfig
publicKeyConfig =
        PublicKeyConfig
pPublicKeyConfig_
    }

-- | A CloudFront public key configuration.
createPublicKey_publicKeyConfig :: Lens.Lens' CreatePublicKey PublicKeyConfig
createPublicKey_publicKeyConfig :: Lens' CreatePublicKey PublicKeyConfig
createPublicKey_publicKeyConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePublicKey' {PublicKeyConfig
publicKeyConfig :: PublicKeyConfig
$sel:publicKeyConfig:CreatePublicKey' :: CreatePublicKey -> PublicKeyConfig
publicKeyConfig} -> PublicKeyConfig
publicKeyConfig) (\s :: CreatePublicKey
s@CreatePublicKey' {} PublicKeyConfig
a -> CreatePublicKey
s {$sel:publicKeyConfig:CreatePublicKey' :: PublicKeyConfig
publicKeyConfig = PublicKeyConfig
a} :: CreatePublicKey)

instance Core.AWSRequest CreatePublicKey where
  type
    AWSResponse CreatePublicKey =
      CreatePublicKeyResponse
  request :: (Service -> Service) -> CreatePublicKey -> Request CreatePublicKey
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreatePublicKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreatePublicKey)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe Text -> Maybe PublicKey -> Int -> CreatePublicKeyResponse
CreatePublicKeyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"ETag")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Location")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            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 CreatePublicKey where
  hashWithSalt :: Int -> CreatePublicKey -> Int
hashWithSalt Int
_salt CreatePublicKey' {PublicKeyConfig
publicKeyConfig :: PublicKeyConfig
$sel:publicKeyConfig:CreatePublicKey' :: CreatePublicKey -> PublicKeyConfig
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PublicKeyConfig
publicKeyConfig

instance Prelude.NFData CreatePublicKey where
  rnf :: CreatePublicKey -> ()
rnf CreatePublicKey' {PublicKeyConfig
publicKeyConfig :: PublicKeyConfig
$sel:publicKeyConfig:CreatePublicKey' :: CreatePublicKey -> PublicKeyConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf PublicKeyConfig
publicKeyConfig

instance Data.ToElement CreatePublicKey where
  toElement :: CreatePublicKey -> Element
toElement CreatePublicKey' {PublicKeyConfig
publicKeyConfig :: PublicKeyConfig
$sel:publicKeyConfig:CreatePublicKey' :: CreatePublicKey -> PublicKeyConfig
..} =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://cloudfront.amazonaws.com/doc/2020-05-31/}PublicKeyConfig"
      PublicKeyConfig
publicKeyConfig

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

instance Data.ToPath CreatePublicKey where
  toPath :: CreatePublicKey -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2020-05-31/public-key"

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

-- | /See:/ 'newCreatePublicKeyResponse' smart constructor.
data CreatePublicKeyResponse = CreatePublicKeyResponse'
  { -- | The identifier for this version of the public key.
    CreatePublicKeyResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | The URL of the public key.
    CreatePublicKeyResponse -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The public key.
    CreatePublicKeyResponse -> Maybe PublicKey
publicKey :: Prelude.Maybe PublicKey,
    -- | The response's http status code.
    CreatePublicKeyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePublicKeyResponse -> CreatePublicKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePublicKeyResponse -> CreatePublicKeyResponse -> Bool
$c/= :: CreatePublicKeyResponse -> CreatePublicKeyResponse -> Bool
== :: CreatePublicKeyResponse -> CreatePublicKeyResponse -> Bool
$c== :: CreatePublicKeyResponse -> CreatePublicKeyResponse -> Bool
Prelude.Eq, ReadPrec [CreatePublicKeyResponse]
ReadPrec CreatePublicKeyResponse
Int -> ReadS CreatePublicKeyResponse
ReadS [CreatePublicKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePublicKeyResponse]
$creadListPrec :: ReadPrec [CreatePublicKeyResponse]
readPrec :: ReadPrec CreatePublicKeyResponse
$creadPrec :: ReadPrec CreatePublicKeyResponse
readList :: ReadS [CreatePublicKeyResponse]
$creadList :: ReadS [CreatePublicKeyResponse]
readsPrec :: Int -> ReadS CreatePublicKeyResponse
$creadsPrec :: Int -> ReadS CreatePublicKeyResponse
Prelude.Read, Int -> CreatePublicKeyResponse -> ShowS
[CreatePublicKeyResponse] -> ShowS
CreatePublicKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePublicKeyResponse] -> ShowS
$cshowList :: [CreatePublicKeyResponse] -> ShowS
show :: CreatePublicKeyResponse -> String
$cshow :: CreatePublicKeyResponse -> String
showsPrec :: Int -> CreatePublicKeyResponse -> ShowS
$cshowsPrec :: Int -> CreatePublicKeyResponse -> ShowS
Prelude.Show, forall x. Rep CreatePublicKeyResponse x -> CreatePublicKeyResponse
forall x. CreatePublicKeyResponse -> Rep CreatePublicKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePublicKeyResponse x -> CreatePublicKeyResponse
$cfrom :: forall x. CreatePublicKeyResponse -> Rep CreatePublicKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePublicKeyResponse' 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:
--
-- 'eTag', 'createPublicKeyResponse_eTag' - The identifier for this version of the public key.
--
-- 'location', 'createPublicKeyResponse_location' - The URL of the public key.
--
-- 'publicKey', 'createPublicKeyResponse_publicKey' - The public key.
--
-- 'httpStatus', 'createPublicKeyResponse_httpStatus' - The response's http status code.
newCreatePublicKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePublicKeyResponse
newCreatePublicKeyResponse :: Int -> CreatePublicKeyResponse
newCreatePublicKeyResponse Int
pHttpStatus_ =
  CreatePublicKeyResponse'
    { $sel:eTag:CreatePublicKeyResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:location:CreatePublicKeyResponse' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:publicKey:CreatePublicKeyResponse' :: Maybe PublicKey
publicKey = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePublicKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier for this version of the public key.
createPublicKeyResponse_eTag :: Lens.Lens' CreatePublicKeyResponse (Prelude.Maybe Prelude.Text)
createPublicKeyResponse_eTag :: Lens' CreatePublicKeyResponse (Maybe Text)
createPublicKeyResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePublicKeyResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: CreatePublicKeyResponse
s@CreatePublicKeyResponse' {} Maybe Text
a -> CreatePublicKeyResponse
s {$sel:eTag:CreatePublicKeyResponse' :: Maybe Text
eTag = Maybe Text
a} :: CreatePublicKeyResponse)

-- | The URL of the public key.
createPublicKeyResponse_location :: Lens.Lens' CreatePublicKeyResponse (Prelude.Maybe Prelude.Text)
createPublicKeyResponse_location :: Lens' CreatePublicKeyResponse (Maybe Text)
createPublicKeyResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePublicKeyResponse' {Maybe Text
location :: Maybe Text
$sel:location:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Maybe Text
location} -> Maybe Text
location) (\s :: CreatePublicKeyResponse
s@CreatePublicKeyResponse' {} Maybe Text
a -> CreatePublicKeyResponse
s {$sel:location:CreatePublicKeyResponse' :: Maybe Text
location = Maybe Text
a} :: CreatePublicKeyResponse)

-- | The public key.
createPublicKeyResponse_publicKey :: Lens.Lens' CreatePublicKeyResponse (Prelude.Maybe PublicKey)
createPublicKeyResponse_publicKey :: Lens' CreatePublicKeyResponse (Maybe PublicKey)
createPublicKeyResponse_publicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePublicKeyResponse' {Maybe PublicKey
publicKey :: Maybe PublicKey
$sel:publicKey:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Maybe PublicKey
publicKey} -> Maybe PublicKey
publicKey) (\s :: CreatePublicKeyResponse
s@CreatePublicKeyResponse' {} Maybe PublicKey
a -> CreatePublicKeyResponse
s {$sel:publicKey:CreatePublicKeyResponse' :: Maybe PublicKey
publicKey = Maybe PublicKey
a} :: CreatePublicKeyResponse)

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

instance Prelude.NFData CreatePublicKeyResponse where
  rnf :: CreatePublicKeyResponse -> ()
rnf CreatePublicKeyResponse' {Int
Maybe Text
Maybe PublicKey
httpStatus :: Int
publicKey :: Maybe PublicKey
location :: Maybe Text
eTag :: Maybe Text
$sel:httpStatus:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Int
$sel:publicKey:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Maybe PublicKey
$sel:location:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Maybe Text
$sel:eTag:CreatePublicKeyResponse' :: CreatePublicKeyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PublicKey
publicKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus