{-# 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.UpdateKeyGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a key group.
--
-- When you update a key group, all the fields are updated with the values
-- provided in the request. You cannot update some fields independent of
-- others. To update a key group:
--
-- 1.  Get the current key group with @GetKeyGroup@ or @GetKeyGroupConfig@.
--
-- 2.  Locally modify the fields in the key group that you want to update.
--     For example, add or remove public key IDs.
--
-- 3.  Call @UpdateKeyGroup@ with the entire key group object, including
--     the fields that you modified and those that you didn\'t.
module Amazonka.CloudFront.UpdateKeyGroup
  ( -- * Creating a Request
    UpdateKeyGroup (..),
    newUpdateKeyGroup,

    -- * Request Lenses
    updateKeyGroup_ifMatch,
    updateKeyGroup_keyGroupConfig,
    updateKeyGroup_id,

    -- * Destructuring the Response
    UpdateKeyGroupResponse (..),
    newUpdateKeyGroupResponse,

    -- * Response Lenses
    updateKeyGroupResponse_eTag,
    updateKeyGroupResponse_keyGroup,
    updateKeyGroupResponse_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:/ 'newUpdateKeyGroup' smart constructor.
data UpdateKeyGroup = UpdateKeyGroup'
  { -- | The version of the key group that you are updating. The version is the
    -- key group\'s @ETag@ value.
    UpdateKeyGroup -> Maybe Text
ifMatch :: Prelude.Maybe Prelude.Text,
    -- | The key group configuration.
    UpdateKeyGroup -> KeyGroupConfig
keyGroupConfig :: KeyGroupConfig,
    -- | The identifier of the key group that you are updating.
    UpdateKeyGroup -> Text
id :: Prelude.Text
  }
  deriving (UpdateKeyGroup -> UpdateKeyGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateKeyGroup -> UpdateKeyGroup -> Bool
$c/= :: UpdateKeyGroup -> UpdateKeyGroup -> Bool
== :: UpdateKeyGroup -> UpdateKeyGroup -> Bool
$c== :: UpdateKeyGroup -> UpdateKeyGroup -> Bool
Prelude.Eq, ReadPrec [UpdateKeyGroup]
ReadPrec UpdateKeyGroup
Int -> ReadS UpdateKeyGroup
ReadS [UpdateKeyGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateKeyGroup]
$creadListPrec :: ReadPrec [UpdateKeyGroup]
readPrec :: ReadPrec UpdateKeyGroup
$creadPrec :: ReadPrec UpdateKeyGroup
readList :: ReadS [UpdateKeyGroup]
$creadList :: ReadS [UpdateKeyGroup]
readsPrec :: Int -> ReadS UpdateKeyGroup
$creadsPrec :: Int -> ReadS UpdateKeyGroup
Prelude.Read, Int -> UpdateKeyGroup -> ShowS
[UpdateKeyGroup] -> ShowS
UpdateKeyGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateKeyGroup] -> ShowS
$cshowList :: [UpdateKeyGroup] -> ShowS
show :: UpdateKeyGroup -> String
$cshow :: UpdateKeyGroup -> String
showsPrec :: Int -> UpdateKeyGroup -> ShowS
$cshowsPrec :: Int -> UpdateKeyGroup -> ShowS
Prelude.Show, forall x. Rep UpdateKeyGroup x -> UpdateKeyGroup
forall x. UpdateKeyGroup -> Rep UpdateKeyGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateKeyGroup x -> UpdateKeyGroup
$cfrom :: forall x. UpdateKeyGroup -> Rep UpdateKeyGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateKeyGroup' 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:
--
-- 'ifMatch', 'updateKeyGroup_ifMatch' - The version of the key group that you are updating. The version is the
-- key group\'s @ETag@ value.
--
-- 'keyGroupConfig', 'updateKeyGroup_keyGroupConfig' - The key group configuration.
--
-- 'id', 'updateKeyGroup_id' - The identifier of the key group that you are updating.
newUpdateKeyGroup ::
  -- | 'keyGroupConfig'
  KeyGroupConfig ->
  -- | 'id'
  Prelude.Text ->
  UpdateKeyGroup
newUpdateKeyGroup :: KeyGroupConfig -> Text -> UpdateKeyGroup
newUpdateKeyGroup KeyGroupConfig
pKeyGroupConfig_ Text
pId_ =
  UpdateKeyGroup'
    { $sel:ifMatch:UpdateKeyGroup' :: Maybe Text
ifMatch = forall a. Maybe a
Prelude.Nothing,
      $sel:keyGroupConfig:UpdateKeyGroup' :: KeyGroupConfig
keyGroupConfig = KeyGroupConfig
pKeyGroupConfig_,
      $sel:id:UpdateKeyGroup' :: Text
id = Text
pId_
    }

-- | The version of the key group that you are updating. The version is the
-- key group\'s @ETag@ value.
updateKeyGroup_ifMatch :: Lens.Lens' UpdateKeyGroup (Prelude.Maybe Prelude.Text)
updateKeyGroup_ifMatch :: Lens' UpdateKeyGroup (Maybe Text)
updateKeyGroup_ifMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateKeyGroup' {Maybe Text
ifMatch :: Maybe Text
$sel:ifMatch:UpdateKeyGroup' :: UpdateKeyGroup -> Maybe Text
ifMatch} -> Maybe Text
ifMatch) (\s :: UpdateKeyGroup
s@UpdateKeyGroup' {} Maybe Text
a -> UpdateKeyGroup
s {$sel:ifMatch:UpdateKeyGroup' :: Maybe Text
ifMatch = Maybe Text
a} :: UpdateKeyGroup)

-- | The key group configuration.
updateKeyGroup_keyGroupConfig :: Lens.Lens' UpdateKeyGroup KeyGroupConfig
updateKeyGroup_keyGroupConfig :: Lens' UpdateKeyGroup KeyGroupConfig
updateKeyGroup_keyGroupConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateKeyGroup' {KeyGroupConfig
keyGroupConfig :: KeyGroupConfig
$sel:keyGroupConfig:UpdateKeyGroup' :: UpdateKeyGroup -> KeyGroupConfig
keyGroupConfig} -> KeyGroupConfig
keyGroupConfig) (\s :: UpdateKeyGroup
s@UpdateKeyGroup' {} KeyGroupConfig
a -> UpdateKeyGroup
s {$sel:keyGroupConfig:UpdateKeyGroup' :: KeyGroupConfig
keyGroupConfig = KeyGroupConfig
a} :: UpdateKeyGroup)

-- | The identifier of the key group that you are updating.
updateKeyGroup_id :: Lens.Lens' UpdateKeyGroup Prelude.Text
updateKeyGroup_id :: Lens' UpdateKeyGroup Text
updateKeyGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateKeyGroup' {Text
id :: Text
$sel:id:UpdateKeyGroup' :: UpdateKeyGroup -> Text
id} -> Text
id) (\s :: UpdateKeyGroup
s@UpdateKeyGroup' {} Text
a -> UpdateKeyGroup
s {$sel:id:UpdateKeyGroup' :: Text
id = Text
a} :: UpdateKeyGroup)

instance Core.AWSRequest UpdateKeyGroup where
  type
    AWSResponse UpdateKeyGroup =
      UpdateKeyGroupResponse
  request :: (Service -> Service) -> UpdateKeyGroup -> Request UpdateKeyGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.putXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateKeyGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateKeyGroup)))
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 KeyGroup -> Int -> UpdateKeyGroupResponse
UpdateKeyGroupResponse'
            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.<*> (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 UpdateKeyGroup where
  hashWithSalt :: Int -> UpdateKeyGroup -> Int
hashWithSalt Int
_salt UpdateKeyGroup' {Maybe Text
Text
KeyGroupConfig
id :: Text
keyGroupConfig :: KeyGroupConfig
ifMatch :: Maybe Text
$sel:id:UpdateKeyGroup' :: UpdateKeyGroup -> Text
$sel:keyGroupConfig:UpdateKeyGroup' :: UpdateKeyGroup -> KeyGroupConfig
$sel:ifMatch:UpdateKeyGroup' :: UpdateKeyGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ifMatch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KeyGroupConfig
keyGroupConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdateKeyGroup where
  rnf :: UpdateKeyGroup -> ()
rnf UpdateKeyGroup' {Maybe Text
Text
KeyGroupConfig
id :: Text
keyGroupConfig :: KeyGroupConfig
ifMatch :: Maybe Text
$sel:id:UpdateKeyGroup' :: UpdateKeyGroup -> Text
$sel:keyGroupConfig:UpdateKeyGroup' :: UpdateKeyGroup -> KeyGroupConfig
$sel:ifMatch:UpdateKeyGroup' :: UpdateKeyGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ifMatch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KeyGroupConfig
keyGroupConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToElement UpdateKeyGroup where
  toElement :: UpdateKeyGroup -> Element
toElement UpdateKeyGroup' {Maybe Text
Text
KeyGroupConfig
id :: Text
keyGroupConfig :: KeyGroupConfig
ifMatch :: Maybe Text
$sel:id:UpdateKeyGroup' :: UpdateKeyGroup -> Text
$sel:keyGroupConfig:UpdateKeyGroup' :: UpdateKeyGroup -> KeyGroupConfig
$sel:ifMatch:UpdateKeyGroup' :: UpdateKeyGroup -> Maybe Text
..} =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://cloudfront.amazonaws.com/doc/2020-05-31/}KeyGroupConfig"
      KeyGroupConfig
keyGroupConfig

instance Data.ToHeaders UpdateKeyGroup where
  toHeaders :: UpdateKeyGroup -> ResponseHeaders
toHeaders UpdateKeyGroup' {Maybe Text
Text
KeyGroupConfig
id :: Text
keyGroupConfig :: KeyGroupConfig
ifMatch :: Maybe Text
$sel:id:UpdateKeyGroup' :: UpdateKeyGroup -> Text
$sel:keyGroupConfig:UpdateKeyGroup' :: UpdateKeyGroup -> KeyGroupConfig
$sel:ifMatch:UpdateKeyGroup' :: UpdateKeyGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [HeaderName
"If-Match" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
ifMatch]

instance Data.ToPath UpdateKeyGroup where
  toPath :: UpdateKeyGroup -> ByteString
toPath UpdateKeyGroup' {Maybe Text
Text
KeyGroupConfig
id :: Text
keyGroupConfig :: KeyGroupConfig
ifMatch :: Maybe Text
$sel:id:UpdateKeyGroup' :: UpdateKeyGroup -> Text
$sel:keyGroupConfig:UpdateKeyGroup' :: UpdateKeyGroup -> KeyGroupConfig
$sel:ifMatch:UpdateKeyGroup' :: UpdateKeyGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2020-05-31/key-group/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

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

-- |
-- Create a value of 'UpdateKeyGroupResponse' 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', 'updateKeyGroupResponse_eTag' - The identifier for this version of the key group.
--
-- 'keyGroup', 'updateKeyGroupResponse_keyGroup' - The key group that was just updated.
--
-- 'httpStatus', 'updateKeyGroupResponse_httpStatus' - The response's http status code.
newUpdateKeyGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateKeyGroupResponse
newUpdateKeyGroupResponse :: Int -> UpdateKeyGroupResponse
newUpdateKeyGroupResponse Int
pHttpStatus_ =
  UpdateKeyGroupResponse'
    { $sel:eTag:UpdateKeyGroupResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:keyGroup:UpdateKeyGroupResponse' :: Maybe KeyGroup
keyGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateKeyGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The key group that was just updated.
updateKeyGroupResponse_keyGroup :: Lens.Lens' UpdateKeyGroupResponse (Prelude.Maybe KeyGroup)
updateKeyGroupResponse_keyGroup :: Lens' UpdateKeyGroupResponse (Maybe KeyGroup)
updateKeyGroupResponse_keyGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateKeyGroupResponse' {Maybe KeyGroup
keyGroup :: Maybe KeyGroup
$sel:keyGroup:UpdateKeyGroupResponse' :: UpdateKeyGroupResponse -> Maybe KeyGroup
keyGroup} -> Maybe KeyGroup
keyGroup) (\s :: UpdateKeyGroupResponse
s@UpdateKeyGroupResponse' {} Maybe KeyGroup
a -> UpdateKeyGroupResponse
s {$sel:keyGroup:UpdateKeyGroupResponse' :: Maybe KeyGroup
keyGroup = Maybe KeyGroup
a} :: UpdateKeyGroupResponse)

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

instance Prelude.NFData UpdateKeyGroupResponse where
  rnf :: UpdateKeyGroupResponse -> ()
rnf UpdateKeyGroupResponse' {Int
Maybe Text
Maybe KeyGroup
httpStatus :: Int
keyGroup :: Maybe KeyGroup
eTag :: Maybe Text
$sel:httpStatus:UpdateKeyGroupResponse' :: UpdateKeyGroupResponse -> Int
$sel:keyGroup:UpdateKeyGroupResponse' :: UpdateKeyGroupResponse -> Maybe KeyGroup
$sel:eTag:UpdateKeyGroupResponse' :: UpdateKeyGroupResponse -> 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 KeyGroup
keyGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus